equal
deleted
inserted
replaced
150 |
150 |
151 withRecordNamespace :: String -> [(String, BaseType)] -> State RenderState Doc -> State RenderState Doc |
151 withRecordNamespace :: String -> [(String, BaseType)] -> State RenderState Doc -> State RenderState Doc |
152 withRecordNamespace _ [] = error "withRecordNamespace: empty record" |
152 withRecordNamespace _ [] = error "withRecordNamespace: empty record" |
153 withRecordNamespace prefix recs = withState' f |
153 withRecordNamespace prefix recs = withState' f |
154 where |
154 where |
155 f st = st{currentScope = Map.unionWith un records (currentScope st)} |
155 f st = st{currentScope = Map.unionWith un records (currentScope st), currentUnit = ""} |
156 records = Map.fromList $ map (\(a, b) -> (map toLower a, [(prefix ++ a, b)])) recs |
156 records = Map.fromList $ map (\(a, b) -> (map toLower a, [(prefix ++ a, b)])) recs |
157 un [a] b = a : b |
157 un [a] b = a : b |
158 |
158 |
159 toCFiles :: Map.Map String Records -> (String, PascalUnit) -> IO () |
159 toCFiles :: Map.Map String Records -> (String, PascalUnit) -> IO () |
160 toCFiles _ (_, System _) = return () |
160 toCFiles _ (_, System _) = return () |
335 error $ "Unknown type " ++ show t ++ "\n" ++ s |
335 error $ "Unknown type " ++ show t ++ "\n" ++ s |
336 resolve _ t = return t |
336 resolve _ t = return t |
337 |
337 |
338 fromPointer :: String -> BaseType -> State RenderState BaseType |
338 fromPointer :: String -> BaseType -> State RenderState BaseType |
339 fromPointer s (BTPointerTo t) = resolve s t |
339 fromPointer s (BTPointerTo t) = resolve s t |
340 --fromPointer s (BTFunctionReturn _ (BTPointerTo t)) = resolve s t |
|
341 fromPointer s t = do |
340 fromPointer s t = do |
342 error $ "Dereferencing from non-pointer type " ++ show t ++ "\n" ++ s |
341 error $ "Dereferencing from non-pointer type " ++ show t ++ "\n" ++ s |
343 |
342 |
344 |
343 |
345 functionParams2C params = liftM (hcat . punctuate comma . concat) $ mapM (tvar2C False) params |
344 functionParams2C params = liftM (hcat . punctuate comma . concat) $ mapM (tvar2C False) params |
389 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState [Doc] |
388 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState [Doc] |
390 tvar2C b f@(FunctionDeclaration (Identifier name _) _ _ _) = |
389 tvar2C b f@(FunctionDeclaration (Identifier name _) _ _ _) = |
391 fun2C b name f |
390 fun2C b name f |
392 tvar2C _ td@(TypeDeclaration i' t) = do |
391 tvar2C _ td@(TypeDeclaration i' t) = do |
393 i <- id2CTyped t i' |
392 i <- id2CTyped t i' |
394 tp <- case t of |
393 tp <- type2C t |
395 FunctionType {} -> type2C (PointerTo t) |
|
396 _ -> type2C t |
|
397 return [text "typedef" <+> tp i] |
394 return [text "typedef" <+> tp i] |
398 |
395 |
399 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do |
396 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do |
400 t' <- liftM (((if isConst then text "const" else empty) <+>) . ) $ type2C t |
397 t' <- liftM (((if isConst then text "const" else empty) <+>) . ) $ type2C t |
401 ie <- initExpr mInitExpr |
398 ie <- initExpr mInitExpr |
406 return [text "enum" <> braces (i' <+> ie)] |
403 return [text "enum" <> braces (i' <+> ie)] |
407 (True, BTFloat, [i], Just e) -> do |
404 (True, BTFloat, [i], Just e) -> do |
408 i' <- id2CTyped t i |
405 i' <- id2CTyped t i |
409 ie <- initExpr2C e |
406 ie <- initExpr2C e |
410 return [text "#define" <+> i' <+> parens ie <> text "\n"] |
407 return [text "#define" <+> i' <+> parens ie <> text "\n"] |
|
408 (_, BTFunction{}, _, Nothing) -> liftM (map(\i -> t' $ text "*" <+> i)) $ mapM (id2CTyped t) ids |
411 _ -> liftM (map(\i -> t' i <+> ie)) $ mapM (id2CTyped t) ids |
409 _ -> liftM (map(\i -> t' i <+> ie)) $ mapM (id2CTyped t) ids |
412 where |
410 where |
413 initExpr Nothing = return $ empty |
411 initExpr Nothing = return $ empty |
414 initExpr (Just e) = liftM (text "=" <+>) (initExpr2C e) |
412 initExpr (Just e) = liftM (text "=" <+>) (initExpr2C e) |
415 |
413 |