249 resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids |
249 resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids |
250 resolveType (RangeType _) = return $ BTVoid |
250 resolveType (RangeType _) = return $ BTVoid |
251 resolveType (Set t) = liftM BTSet $ resolveType t |
251 resolveType (Set t) = liftM BTSet $ resolveType t |
252 |
252 |
253 |
253 |
254 fromPointer :: BaseType -> State RenderState BaseType |
254 fromPointer :: String -> BaseType -> State RenderState BaseType |
255 fromPointer (BTPointerTo t) = f t |
255 fromPointer s (BTPointerTo t) = f t |
256 where |
256 where |
257 f (BTUnresolved s) = do |
257 f (BTUnresolved s) = do |
258 v <- gets $ find (\(a, _) -> a == s) . currentScope |
258 v <- gets $ find (\(a, _) -> a == s) . currentScope |
259 if isJust v then |
259 if isJust v then |
260 f . snd . snd . fromJust $ v |
260 f . snd . snd . fromJust $ v |
261 else |
261 else |
262 error $ "Unknown type " ++ show t |
262 error $ "Unknown type " ++ show t ++ "\n" ++ s |
263 f t = return t |
263 f t = return t |
264 fromPointer t = do |
264 fromPointer s t = do |
265 ns <- gets currentScope |
265 ns <- gets currentScope |
266 error $ "Dereferencing from non-pointer type " ++ show t ++ "\n\n" ++ show (take 100 ns) |
266 error $ "Dereferencing from non-pointer type " ++ show t ++ "\n" ++ s ++ "\n\n" ++ show (take 100 ns) |
267 |
267 |
268 |
268 |
269 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState Doc |
269 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState Doc |
270 tvar2C _ (FunctionDeclaration name returnType params Nothing) = do |
270 tvar2C _ (FunctionDeclaration name returnType params Nothing) = do |
271 t <- type2C returnType |
271 t <- type2C returnType |
|
272 t'<- gets lastType |
272 p <- withState' id $ liftM hcat $ mapM (tvar2C False) params |
273 p <- withState' id $ liftM hcat $ mapM (tvar2C False) params |
273 n <- id2C IOInsert name |
274 n <- id2C IOInsert $ setBaseType (BTFunction t') name |
274 return $ t <+> n <> parens p <> text ";" |
275 return $ t <+> n <> parens p <> text ";" |
275 |
276 |
276 tvar2C True (FunctionDeclaration (Identifier i _) returnType params (Just (tvars, phrase))) = do |
277 tvar2C True (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do |
277 t <- type2C returnType |
278 t <- type2C returnType |
278 t'<- gets lastType |
279 t'<- gets lastType |
279 n <- id2C IOInsert (Identifier i (BTFunction t')) |
280 n <- id2C IOInsert $ setBaseType (BTFunction t') name |
280 (p, ph) <- withState' (\st -> st{currentScope = (lastIdentifier st, (lastIdentifier st ++ "_result", t')) : currentScope st}) $ do |
281 (p, ph) <- withState' (\st -> st{currentScope = (lastIdentifier st, (lastIdentifier st ++ "_result", t')) : currentScope st}) $ do |
281 p <- liftM hcat $ mapM (tvar2C False) params |
282 p <- liftM hcat $ mapM (tvar2C False) params |
282 ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase) |
283 ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase) |
283 return (p, ph) |
284 return (p, ph) |
284 let res = docToLower $ n <> text "_result" |
285 let res = docToLower $ n <> text "_result" |
453 ref2C :: Reference -> State RenderState Doc |
454 ref2C :: Reference -> State RenderState Doc |
454 -- rewrite into proper form |
455 -- rewrite into proper form |
455 ref2C r@(RecordField ref1 (ArrayElement exprs ref2)) = ref2C $ ArrayElement exprs (RecordField ref1 ref2) |
456 ref2C r@(RecordField ref1 (ArrayElement exprs ref2)) = ref2C $ ArrayElement exprs (RecordField ref1 ref2) |
456 ref2C r@(RecordField ref1 (Dereference ref2)) = ref2C $ Dereference (RecordField ref1 ref2) |
457 ref2C r@(RecordField ref1 (Dereference ref2)) = ref2C $ Dereference (RecordField ref1 ref2) |
457 ref2C r@(RecordField ref1 (RecordField ref2 ref3)) = ref2C $ RecordField (RecordField ref1 ref2) ref3 |
458 ref2C r@(RecordField ref1 (RecordField ref2 ref3)) = ref2C $ RecordField (RecordField ref1 ref2) ref3 |
|
459 ref2C r@(RecordField ref1 (FunCall params ref2)) = ref2C $ FunCall params (RecordField ref1 ref2) |
458 -- conversion routines |
460 -- conversion routines |
459 ref2C ae@(ArrayElement exprs ref) = do |
461 ref2C ae@(ArrayElement exprs ref) = do |
460 es <- mapM expr2C exprs |
462 es <- mapM expr2C exprs |
461 r <- ref2C ref |
463 r <- ref2C ref |
462 t <- gets lastType |
464 t <- gets lastType |
471 a -> error $ "Getting element of " ++ show a ++ "\nReference: " ++ show ae ++ "\n" ++ show (take 100 ns) |
473 a -> error $ "Getting element of " ++ show a ++ "\nReference: " ++ show ae ++ "\n" ++ show (take 100 ns) |
472 return $ r <> (brackets . hcat) (punctuate comma es) |
474 return $ r <> (brackets . hcat) (punctuate comma es) |
473 ref2C (SimpleReference name) = id2C IOLookup name |
475 ref2C (SimpleReference name) = id2C IOLookup name |
474 ref2C rf@(RecordField (Dereference ref1) ref2) = do |
476 ref2C rf@(RecordField (Dereference ref1) ref2) = do |
475 r1 <- ref2C ref1 |
477 r1 <- ref2C ref1 |
476 t <- fromPointer =<< gets lastType |
478 t <- fromPointer (show ref1) =<< gets lastType |
477 ns <- gets currentScope |
479 ns <- gets currentScope |
478 r2 <- case t of |
480 r2 <- case t of |
479 BTRecord rs -> withRecordNamespace rs $ ref2C ref2 |
481 BTRecord rs -> withRecordNamespace rs $ ref2C ref2 |
480 BTUnit -> withLastIdNamespace $ ref2C ref2 |
482 BTUnit -> withLastIdNamespace $ ref2C ref2 |
481 a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf ++ "\n" ++ show (take 100 ns) |
483 a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf ++ "\n" ++ show (take 100 ns) |
489 BTRecord rs -> withRecordNamespace rs $ ref2C ref2 |
491 BTRecord rs -> withRecordNamespace rs $ ref2C ref2 |
490 BTUnit -> withLastIdNamespace $ ref2C ref2 |
492 BTUnit -> withLastIdNamespace $ ref2C ref2 |
491 a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf ++ "\n" ++ show (take 100 ns) |
493 a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf ++ "\n" ++ show (take 100 ns) |
492 return $ |
494 return $ |
493 r1 <> text "." <> r2 |
495 r1 <> text "." <> r2 |
494 ref2C (Dereference ref) = do |
496 ref2C d@(Dereference ref) = do |
495 r <- ref2C ref |
497 r <- ref2C ref |
496 t <- fromPointer =<< gets lastType |
498 t <- fromPointer (show d) =<< gets lastType |
497 modify (\st -> st{lastType = t}) |
499 modify (\st -> st{lastType = t}) |
498 return $ (parens $ text "*") <> r |
500 return $ (parens $ text "*") <> r |
499 ref2C (FunCall params ref) = do |
501 ref2C (FunCall params ref) = do |
500 ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params |
502 ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params |
501 r <- ref2C ref |
503 r <- ref2C ref |