308 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState [Doc] |
308 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState [Doc] |
309 tvar2C b f@(FunctionDeclaration (Identifier name _) _ _ _) = |
309 tvar2C b f@(FunctionDeclaration (Identifier name _) _ _ _) = |
310 fun2C b name f |
310 fun2C b name f |
311 tvar2C _ td@(TypeDeclaration i' t) = do |
311 tvar2C _ td@(TypeDeclaration i' t) = do |
312 i <- id2CTyped t i' |
312 i <- id2CTyped t i' |
313 tp <- type2C t |
313 tp <- case t of |
|
314 FunctionType {} -> type2C (PointerTo t) |
|
315 _ -> type2C t |
314 return [text "typedef" <+> tp i] |
316 return [text "typedef" <+> tp i] |
315 |
317 |
316 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do |
318 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do |
317 t' <- liftM (((if isConst then text "const" else empty) <+>) . ) $ type2C t |
319 t' <- liftM (((if isConst then text "const" else empty) <+>) . ) $ type2C t |
318 ie <- initExpr mInitExpr |
320 ie <- initExpr mInitExpr |
368 initExpr2C (InitRecord fields) = do |
370 initExpr2C (InitRecord fields) = do |
369 (fs :: [Doc]) <- mapM (\(Identifier a _, b) -> liftM (text "." <> text a <+> equals <+>) $ initExpr2C b) fields |
371 (fs :: [Doc]) <- mapM (\(Identifier a _, b) -> liftM (text "." <> text a <+> equals <+>) $ initExpr2C b) fields |
370 return $ lbrace $+$ (nest 4 . vcat . punctuate comma $ fs) $+$ rbrace |
372 return $ lbrace $+$ (nest 4 . vcat . punctuate comma $ fs) $+$ rbrace |
371 initExpr2C (InitArray [value]) = initExpr2C value |
373 initExpr2C (InitArray [value]) = initExpr2C value |
372 initExpr2C (InitArray values) = liftM (braces . vcat . punctuate comma) $ mapM initExpr2C values |
374 initExpr2C (InitArray values) = liftM (braces . vcat . punctuate comma) $ mapM initExpr2C values |
373 initExpr2C (InitRange (Range i)) = id2C IOLookup i |
375 initExpr2C r@(InitRange (Range i@(Identifier i' _))) = do |
374 initExpr2C (InitRange (RangeFromTo (InitNumber "0") (InitNumber a))) = return . text $ show (read a + 1) |
376 id2C IOLookup i |
375 initExpr2C (InitRange a) = return $ text "<<range>>" |
377 t <- gets lastType |
|
378 case t of |
|
379 BTEnum s -> return . int $ length s |
|
380 BTInt -> case i' of |
|
381 "byte" -> return $ int 256 |
|
382 _ -> error $ "InitRange identifier: " ++ i' |
|
383 _ -> error $ "InitRange: " ++ show r |
|
384 initExpr2C (InitRange (RangeFromTo (InitNumber "0") r)) = initExpr2C $ BuiltInFunction "succ" [r] |
|
385 initExpr2C (InitRange a) = error $ show a --return $ text "<<range>>" |
376 initExpr2C (InitSet []) = return $ text "0" |
386 initExpr2C (InitSet []) = return $ text "0" |
377 initExpr2C (InitSet a) = return $ text "<<set>>" |
387 initExpr2C (InitSet a) = return $ text "<<set>>" |
378 initExpr2C (BuiltInFunction "low" [InitReference e]) = return $ |
388 initExpr2C (BuiltInFunction "low" [InitReference e]) = return $ |
379 case e of |
389 case e of |
380 (Identifier "LongInt" _) -> int (-2^31) |
390 (Identifier "LongInt" _) -> int (-2^31) |
381 _ -> error $ show e |
391 _ -> error $ show e |
382 initExpr2C (BuiltInFunction "succ" [InitReference e]) = liftM (<> text " + 1") $ id2C IOLookup e |
392 initExpr2C (BuiltInFunction "succ" [e]) = liftM (<> text " + 1") $ initExpr2C e |
|
393 initExpr2C (BuiltInFunction "pred" [e]) = liftM (<> text " - 1") $ initExpr2C e |
383 initExpr2C b@(BuiltInFunction _ _) = error $ show b |
394 initExpr2C b@(BuiltInFunction _ _) = error $ show b |
384 initExpr2C a = error $ "initExpr2C: don't know how to render " ++ show a |
395 initExpr2C a = error $ "initExpr2C: don't know how to render " ++ show a |
385 |
396 |
386 |
397 |
387 range2C :: InitExpression -> State RenderState [Doc] |
398 range2C :: InitExpression -> State RenderState [Doc] |
400 return r |
411 return r |
401 where |
412 where |
402 type2C' VoidType = return (text "void" <+>) |
413 type2C' VoidType = return (text "void" <+>) |
403 type2C' (String l) = return (text ("string" ++ show l) <+>) |
414 type2C' (String l) = return (text ("string" ++ show l) <+>) |
404 type2C' (PointerTo (SimpleType i)) = liftM (\i a -> text "struct" <+> i <+> text "*" <+> a) $ id2C IODeferred i |
415 type2C' (PointerTo (SimpleType i)) = liftM (\i a -> text "struct" <+> i <+> text "*" <+> a) $ id2C IODeferred i |
405 type2C' (PointerTo t) = liftM (\t a -> t (text "*" <> a)) $ type2C t |
416 type2C' (PointerTo t) = liftM (\t a -> t (parens $ text "*" <> a)) $ type2C t |
406 type2C' (RecordType tvs union) = do |
417 type2C' (RecordType tvs union) = do |
407 t <- withState' id $ mapM (tvar2C False) tvs |
418 t <- withState' id $ mapM (tvar2C False) tvs |
408 u <- unions |
419 u <- unions |
409 return $ \i -> text "struct" <+> lbrace $+$ nest 4 ((vcat . map (<> semi) . concat $ t) $$ u) $+$ rbrace <+> i |
420 return $ \i -> text "struct" <+> lbrace $+$ nest 4 ((vcat . map (<> semi) . concat $ t) $$ u) $+$ rbrace <+> i |
410 where |
421 where |