256 |
256 |
257 |
257 |
258 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState Doc |
258 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState Doc |
259 tvar2C _ (FunctionDeclaration name returnType params Nothing) = do |
259 tvar2C _ (FunctionDeclaration name returnType params Nothing) = do |
260 t <- type2C returnType |
260 t <- type2C returnType |
261 p <- liftM hcat $ mapM (tvar2C False) params |
261 p <- withState' id $ liftM hcat $ mapM (tvar2C False) params |
262 n <- id2C IOInsert name |
262 n <- id2C IOInsert name |
263 return $ t <+> n <> parens p <> text ";" |
263 return $ t <+> n <> parens p <> text ";" |
264 |
264 |
265 tvar2C True (FunctionDeclaration (Identifier i _) returnType params (Just (tvars, phrase))) = do |
265 tvar2C True (FunctionDeclaration (Identifier i _) returnType params (Just (tvars, phrase))) = do |
266 t <- type2C returnType |
266 t <- type2C returnType |
323 initExpr2C (InitReference i) = id2C IOLookup i |
323 initExpr2C (InitReference i) = id2C IOLookup i |
324 initExpr2C _ = return $ text "<<expression>>" |
324 initExpr2C _ = return $ text "<<expression>>" |
325 |
325 |
326 |
326 |
327 type2C :: TypeDecl -> State RenderState Doc |
327 type2C :: TypeDecl -> State RenderState Doc |
328 type2C VoidType = return $ text "void" |
|
329 type2C (String l) = return $ text $ "string" ++ show l |
|
330 type2C (SimpleType i) = id2C IOLookup i |
328 type2C (SimpleType i) = id2C IOLookup i |
331 type2C (PointerTo (SimpleType i)) = liftM (<> text "*") $ id2C IODeferred i |
329 type2C t = do |
332 type2C (PointerTo t) = liftM (<> text "*") $ type2C t |
330 r <- type2C' t |
333 type2C (RecordType tvs union) = do |
331 rt <- resolveType t |
334 t <- mapM (tvar2C False) tvs |
332 modify (\st -> st{lastType = rt}) |
335 return $ text "{" $+$ (nest 4 . vcat $ t) $+$ text "}" |
333 return r |
336 type2C (RangeType r) = return $ text "<<range type>>" |
334 where |
337 type2C (Sequence ids) = do |
335 type2C' VoidType = return $ text "void" |
338 mapM_ (id2C IOInsert) ids |
336 type2C' (String l) = return $ text $ "string" ++ show l |
339 return $ text "<<sequence type>>" |
337 type2C' (PointerTo (SimpleType i)) = liftM (<> text "*") $ id2C IODeferred i |
340 type2C (ArrayDecl r t) = return $ text "<<array type>>" |
338 type2C' (PointerTo t) = liftM (<> text "*") $ type2C t |
341 type2C (Set t) = return $ text "<<set>>" |
339 type2C' (RecordType tvs union) = do |
342 type2C (FunctionType returnType params) = return $ text "<<function>>" |
340 t <- mapM (tvar2C False) tvs |
343 type2C (DeriveType _) = return $ text "<<type derived from constant literal>>" |
341 return $ text "{" $+$ (nest 4 . vcat $ t) $+$ text "}" |
|
342 type2C' (RangeType r) = return $ text "<<range type>>" |
|
343 type2C' (Sequence ids) = do |
|
344 mapM_ (id2C IOInsert) ids |
|
345 return $ text "<<sequence type>>" |
|
346 type2C' (ArrayDecl r t) = return $ text "<<array type>>" |
|
347 type2C' (Set t) = return $ text "<<set>>" |
|
348 type2C' (FunctionType returnType params) = return $ text "<<function>>" |
|
349 type2C' (DeriveType _) = return $ text "<<type derived from constant literal>>" |
344 |
350 |
345 phrase2C :: Phrase -> State RenderState Doc |
351 phrase2C :: Phrase -> State RenderState Doc |
346 phrase2C (Phrases p) = do |
352 phrase2C (Phrases p) = do |
347 ps <- mapM phrase2C p |
353 ps <- mapM phrase2C p |
348 return $ text "{" $+$ (nest 4 . vcat $ ps) $+$ text "}" |
354 return $ text "{" $+$ (nest 4 . vcat $ ps) $+$ text "}" |
430 ref2C :: Reference -> State RenderState Doc |
436 ref2C :: Reference -> State RenderState Doc |
431 ref2C ae@(ArrayElement exprs ref) = do |
437 ref2C ae@(ArrayElement exprs ref) = do |
432 es <- mapM expr2C exprs |
438 es <- mapM expr2C exprs |
433 r <- ref2C ref |
439 r <- ref2C ref |
434 t <- gets lastType |
440 t <- gets lastType |
|
441 ns <- gets currentScope |
435 case t of |
442 case t of |
|
443 (BTArray _ (BTArray _ t')) -> modify (\st -> st{lastType = t'}) |
436 (BTArray _ t') -> modify (\st -> st{lastType = t'}) |
444 (BTArray _ t') -> modify (\st -> st{lastType = t'}) |
437 (BTString) -> modify (\st -> st{lastType = BTChar}) |
445 (BTString) -> modify (\st -> st{lastType = BTChar}) |
438 a -> error $ show a ++ "\n" ++ show ae |
446 a -> error $ "Getting element of " ++ show a ++ "\nReference: " ++ show ae ++ "\n" ++ show (take 100 ns) |
439 return $ r <> (brackets . hcat) (punctuate comma es) |
447 return $ r <> (brackets . hcat) (punctuate comma es) |
440 ref2C (SimpleReference name) = id2C IOLookup name |
448 ref2C (SimpleReference name) = id2C IOLookup name |
441 ref2C (RecordField (Dereference ref1) ref2) = do |
449 ref2C (RecordField (Dereference ref1) ref2) = do |
442 r1 <- ref2C ref1 |
450 r1 <- ref2C ref1 |
443 r2 <- ref2C ref2 |
451 r2 <- ref2C ref2 |