equal
deleted
inserted
replaced
76 |
76 |
77 |
77 |
78 toCFiles :: Map.Map String [Record] -> (String, PascalUnit) -> IO () |
78 toCFiles :: Map.Map String [Record] -> (String, PascalUnit) -> IO () |
79 toCFiles _ (_, System _) = return () |
79 toCFiles _ (_, System _) = return () |
80 toCFiles ns p@(fn, pu) = do |
80 toCFiles ns p@(fn, pu) = do |
81 hPutStrLn stdout $ show $ Map.lookup "pas2cSystem" ns |
|
82 hPutStrLn stderr $ "Rendering '" ++ fn ++ "'..." |
81 hPutStrLn stderr $ "Rendering '" ++ fn ++ "'..." |
83 toCFiles' p |
82 toCFiles' p |
84 where |
83 where |
85 toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ (render2C initialState . pascal2C) p |
84 toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ (render2C initialState . pascal2C) p |
86 toCFiles' (fn, (Unit _ interface implementation _ _)) = do |
85 toCFiles' (fn, (Unit _ interface implementation _ _)) = do |
150 return . text . fst . snd . fromJust $ v |
149 return . text . fst . snd . fromJust $ v |
151 |
150 |
152 id2CTyped :: BaseType -> Identifier -> State RenderState Doc |
151 id2CTyped :: BaseType -> Identifier -> State RenderState Doc |
153 id2CTyped BTUnknown i = do |
152 id2CTyped BTUnknown i = do |
154 ns <- gets currentScope |
153 ns <- gets currentScope |
155 error $ show i ++ "\n" ++ show ns |
154 error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\n" ++ show ns |
156 id2CTyped bt (Identifier i _) = id2C True (Identifier i bt) |
155 id2CTyped bt (Identifier i _) = id2C True (Identifier i bt) |
157 |
156 |
158 |
157 |
159 resolveType :: TypeDecl -> State RenderState BaseType |
158 resolveType :: TypeDecl -> State RenderState BaseType |
160 resolveType st@(SimpleType (Identifier i _)) = do |
159 resolveType st@(SimpleType (Identifier i _)) = do |
163 if isJust v then return . snd . snd $ fromJust v else return $ f i' |
162 if isJust v then return . snd . snd $ fromJust v else return $ f i' |
164 where |
163 where |
165 f "integer" = BTInt |
164 f "integer" = BTInt |
166 f "pointer" = BTPointerTo BTVoid |
165 f "pointer" = BTPointerTo BTVoid |
167 f "boolean" = BTBool |
166 f "boolean" = BTBool |
|
167 f "float" = BTFloat |
|
168 f "char" = BTChar |
|
169 f "string" = BTString |
168 f _ = error $ "Unknown system type: " ++ show st |
170 f _ = error $ "Unknown system type: " ++ show st |
169 resolveType (PointerTo t) = liftM BTPointerTo $ resolveType t |
171 resolveType (PointerTo t) = liftM BTPointerTo $ resolveType t |
170 resolveType (RecordType tv mtvs) = do |
172 resolveType (RecordType tv mtvs) = do |
171 tvs <- mapM f (concat $ tv : fromMaybe [] mtvs) |
173 tvs <- mapM f (concat $ tv : fromMaybe [] mtvs) |
172 return . BTRecord . concat $ tvs |
174 return . BTRecord . concat $ tvs |
207 phrase2C' p = phrase2C p |
209 phrase2C' p = phrase2C p |
208 |
210 |
209 tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name |
211 tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name |
210 |
212 |
211 tvar2C _ td@(TypeDeclaration i' t) = do |
213 tvar2C _ td@(TypeDeclaration i' t) = do |
|
214 tb <- resolveType t |
|
215 i <- id2CTyped tb i' |
212 tp <- type2C t |
216 tp <- type2C t |
213 tb <- resolveType t |
|
214 error $ show (td, tb) |
|
215 i <- id2CTyped tb i' |
|
216 return $ text "type" <+> i <+> tp <> text ";" |
217 return $ text "type" <+> i <+> tp <> text ";" |
217 |
218 |
218 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do |
219 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do |
219 t' <- type2C t |
220 t' <- type2C t |
220 tb <- resolveType t |
221 tb <- resolveType t |