183 return . text . fst . snd . fromJust $ v |
183 return . text . fst . snd . fromJust $ v |
184 |
184 |
185 id2CTyped :: TypeDecl -> Identifier -> State RenderState Doc |
185 id2CTyped :: TypeDecl -> Identifier -> State RenderState Doc |
186 id2CTyped t (Identifier i _) = do |
186 id2CTyped t (Identifier i _) = do |
187 tb <- resolveType t |
187 tb <- resolveType t |
|
188 ns <- gets currentScope |
188 case tb of |
189 case tb of |
189 BTUnknown -> do |
190 BTUnknown -> do |
190 ns <- gets currentScope |
191 ns <- gets currentScope |
191 error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\ntype: " ++ show t ++ "\nnamespace: " -- ++ show ns |
192 error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\ntype: " ++ show t ++ "\nnamespace: " ++ show (take 100 ns) |
192 _ -> id2C IOInsert (Identifier i tb) |
193 _ -> id2C IOInsert (Identifier i tb) |
193 |
194 |
194 |
195 |
195 resolveType :: TypeDecl -> State RenderState BaseType |
196 resolveType :: TypeDecl -> State RenderState BaseType |
196 resolveType st@(SimpleType (Identifier i _)) = do |
197 resolveType st@(SimpleType (Identifier i _)) = do |
214 f :: TypeVarDeclaration -> State RenderState [(String, BaseType)] |
215 f :: TypeVarDeclaration -> State RenderState [(String, BaseType)] |
215 f (VarDeclaration _ (ids, td) _) = mapM (\(Identifier i _) -> liftM ((,) i) $ resolveType td) ids |
216 f (VarDeclaration _ (ids, td) _) = mapM (\(Identifier i _) -> liftM ((,) i) $ resolveType td) ids |
216 resolveType (ArrayDecl (Just _) t) = liftM (BTArray BTInt) $ resolveType t |
217 resolveType (ArrayDecl (Just _) t) = liftM (BTArray BTInt) $ resolveType t |
217 resolveType (ArrayDecl Nothing t) = liftM (BTArray BTInt) $ resolveType t |
218 resolveType (ArrayDecl Nothing t) = liftM (BTArray BTInt) $ resolveType t |
218 resolveType (FunctionType t _) = liftM BTFunction $ resolveType t |
219 resolveType (FunctionType t _) = liftM BTFunction $ resolveType t |
219 resolveType (DeriveType _) = return BTInt |
220 resolveType (DeriveType (InitHexNumber _)) = return BTInt |
|
221 resolveType (DeriveType (InitNumber _)) = return BTInt |
|
222 resolveType (DeriveType (InitFloat _)) = return BTFloat |
|
223 resolveType (DeriveType (InitString _)) = return BTString |
|
224 resolveType (DeriveType (InitBinOp {})) = return BTInt |
|
225 resolveType (DeriveType (InitPrefixOp {})) = return BTInt |
|
226 resolveType (DeriveType (BuiltInFunction{})) = return BTInt |
|
227 resolveType (DeriveType (InitReference (Identifier{}))) = return BTBool -- TODO: derive from actual type |
|
228 resolveType (DeriveType _) = return BTUnknown |
220 resolveType (String _) = return BTString |
229 resolveType (String _) = return BTString |
221 resolveType VoidType = return BTVoid |
230 resolveType VoidType = return BTVoid |
222 resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids |
231 resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids |
223 resolveType (RangeType _) = return $ BTInt |
232 resolveType (RangeType _) = return $ BTUnknown |
224 resolveType (Set t) = liftM BTSet $ resolveType t |
233 resolveType (Set t) = liftM BTSet $ resolveType t |
225 --resolveType UnknownType = return BTUnknown |
234 --resolveType UnknownType = return BTUnknown |
226 resolveType a = error $ "resolveType: " ++ show a |
235 resolveType a = error $ "resolveType: " ++ show a |
227 |
236 |
228 |
237 |
406 expr2C _ = return $ text "<<expression>>" |
415 expr2C _ = return $ text "<<expression>>" |
407 |
416 |
408 |
417 |
409 ref2C :: Reference -> State RenderState Doc |
418 ref2C :: Reference -> State RenderState Doc |
410 ref2C ae@(ArrayElement exprs ref) = do |
419 ref2C ae@(ArrayElement exprs ref) = do |
|
420 es <- mapM expr2C exprs |
411 r <- ref2C ref |
421 r <- ref2C ref |
412 t <- gets lastType |
422 t <- gets lastType |
413 case t of |
423 case t of |
414 (BTArray _ t') -> modify (\st -> st{lastType = t'}) |
424 (BTArray _ t') -> modify (\st -> st{lastType = t'}) |
415 a -> error $ show a ++ "\n" ++ show ae |
425 a -> error $ show a ++ "\n" ++ show ae |
416 es <- mapM expr2C exprs |
|
417 return $ r <> (brackets . hcat) (punctuate comma es) |
426 return $ r <> (brackets . hcat) (punctuate comma es) |
418 ref2C (SimpleReference name) = id2C IOLookup name |
427 ref2C (SimpleReference name) = id2C IOLookup name |
419 ref2C (RecordField (Dereference ref1) ref2) = do |
428 ref2C (RecordField (Dereference ref1) ref2) = do |
420 r1 <- ref2C ref1 |
429 r1 <- ref2C ref1 |
421 r2 <- ref2C ref2 |
430 r2 <- ref2C ref2 |
422 return $ |
431 return $ |
423 r1 <> text "->" <> r2 |
432 r1 <> text "->" <> r2 |
424 ref2C rf@(RecordField ref1 ref2) = do |
433 ref2C rf@(RecordField ref1 ref2) = do |
425 r1 <- ref2C ref1 |
434 r1 <- ref2C ref1 |
426 t <- gets lastType |
435 t <- gets lastType |
|
436 ns <- gets currentScope |
427 r2 <- case t of |
437 r2 <- case t of |
428 BTRecord rs -> withRecordNamespace rs $ ref2C ref2 |
438 BTRecord rs -> withRecordNamespace rs $ ref2C ref2 |
429 BTUnit -> withLastIdNamespace $ ref2C ref2 |
439 BTUnit -> withLastIdNamespace $ ref2C ref2 |
430 a -> error $ "dereferencing from " ++ show a ++ " - " ++ show rf |
440 a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf ++ "\n" ++ show (take 100 ns) |
431 return $ |
441 return $ |
432 r1 <> text "." <> r2 |
442 r1 <> text "." <> r2 |
433 ref2C (Dereference ref) = do |
443 ref2C (Dereference ref) = do |
434 r <- ref2C ref |
444 r <- ref2C ref |
435 t <- fromPointer =<< gets lastType |
445 t <- fromPointer =<< gets lastType |