equal
deleted
inserted
replaced
146 if isNothing v then |
146 if isNothing v then |
147 error $ "Not defined: '" ++ i' ++ "'\n" ++ show ns |
147 error $ "Not defined: '" ++ i' ++ "'\n" ++ show ns |
148 else |
148 else |
149 return . text . fst . snd . fromJust $ v |
149 return . text . fst . snd . fromJust $ v |
150 |
150 |
151 id2CTyped :: BaseType -> Identifier -> State RenderState Doc |
151 id2CTyped :: TypeDecl -> Identifier -> State RenderState Doc |
152 id2CTyped BTUnknown i = do |
152 id2CTyped t (Identifier i _) = do |
|
153 tb <- resolveType t |
|
154 id2C True (Identifier i tb) |
|
155 {--id2CTyped BTUnknown i = do |
153 ns <- gets currentScope |
156 ns <- gets currentScope |
154 error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\n" ++ show ns |
157 error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\n" ++ show ns |
155 id2CTyped bt (Identifier i _) = id2C True (Identifier i bt) |
158 id2CTyped bt (Identifier i _) = id2C True (Identifier i bt)--} |
156 |
159 |
157 |
160 |
158 resolveType :: TypeDecl -> State RenderState BaseType |
161 resolveType :: TypeDecl -> State RenderState BaseType |
159 resolveType st@(SimpleType (Identifier i _)) = do |
162 resolveType st@(SimpleType (Identifier i _)) = do |
160 let i' = map toLower i |
163 let i' = map toLower i |
166 f "boolean" = BTBool |
169 f "boolean" = BTBool |
167 f "float" = BTFloat |
170 f "float" = BTFloat |
168 f "char" = BTChar |
171 f "char" = BTChar |
169 f "string" = BTString |
172 f "string" = BTString |
170 f _ = error $ "Unknown system type: " ++ show st |
173 f _ = error $ "Unknown system type: " ++ show st |
171 resolveType (PointerTo t) = liftM BTPointerTo $ resolveType t |
174 resolveType (PointerTo t) = return $ BTPointerTo BTUnknown -- can't resolveType for t here |
172 resolveType (RecordType tv mtvs) = do |
175 resolveType (RecordType tv mtvs) = do |
173 tvs <- mapM f (concat $ tv : fromMaybe [] mtvs) |
176 tvs <- mapM f (concat $ tv : fromMaybe [] mtvs) |
174 return . BTRecord . concat $ tvs |
177 return . BTRecord . concat $ tvs |
175 where |
178 where |
176 f :: TypeVarDeclaration -> State RenderState [(String, BaseType)] |
179 f :: TypeVarDeclaration -> State RenderState [(String, BaseType)] |
178 resolveType (ArrayDecl (Just _) t) = liftM (BTArray BTInt) $ resolveType t |
181 resolveType (ArrayDecl (Just _) t) = liftM (BTArray BTInt) $ resolveType t |
179 resolveType (ArrayDecl Nothing t) = liftM (BTArray BTInt) $ resolveType t |
182 resolveType (ArrayDecl Nothing t) = liftM (BTArray BTInt) $ resolveType t |
180 resolveType (FunctionType _ _) = return BTFunction |
183 resolveType (FunctionType _ _) = return BTFunction |
181 resolveType (DeriveType _) = return BTInt |
184 resolveType (DeriveType _) = return BTInt |
182 resolveType (String _) = return BTString |
185 resolveType (String _) = return BTString |
|
186 resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids |
|
187 resolveType (RangeType _) = return $ BTInt |
|
188 resolveType (Set t) = liftM BTSet $ resolveType t |
183 --resolveType UnknownType = return BTUnknown |
189 --resolveType UnknownType = return BTUnknown |
184 resolveType a = error $ "resolveType: " ++ show a |
190 resolveType a = error $ "resolveType: " ++ show a |
185 |
191 |
186 |
192 |
187 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState Doc |
193 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState Doc |
209 phrase2C' p = phrase2C p |
215 phrase2C' p = phrase2C p |
210 |
216 |
211 tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name |
217 tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name |
212 |
218 |
213 tvar2C _ td@(TypeDeclaration i' t) = do |
219 tvar2C _ td@(TypeDeclaration i' t) = do |
214 tb <- resolveType t |
220 i <- id2CTyped t i' |
215 i <- id2CTyped tb i' |
|
216 tp <- type2C t |
221 tp <- type2C t |
217 return $ text "type" <+> i <+> tp <> text ";" |
222 return $ text "type" <+> i <+> tp <> text ";" |
218 |
223 |
219 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do |
224 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do |
220 t' <- type2C t |
225 t' <- type2C t |
221 tb <- resolveType t |
226 i <- mapM (id2CTyped t) ids |
222 i <- mapM (id2CTyped tb) ids |
|
223 ie <- initExpr mInitExpr |
227 ie <- initExpr mInitExpr |
224 return $ if isConst then text "const" else empty |
228 return $ if isConst then text "const" else empty |
225 <+> t' |
229 <+> t' |
226 <+> (hsep . punctuate (char ',') $ i) |
230 <+> (hsep . punctuate (char ',') $ i) |
227 <+> ie |
231 <+> ie |