302 resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids |
302 resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids |
303 resolveType (RangeType _) = return $ BTVoid |
303 resolveType (RangeType _) = return $ BTVoid |
304 resolveType (Set t) = liftM BTSet $ resolveType t |
304 resolveType (Set t) = liftM BTSet $ resolveType t |
305 |
305 |
306 |
306 |
307 fromPointer :: String -> BaseType -> State RenderState BaseType |
307 resolve :: String -> BaseType -> State RenderState BaseType |
308 fromPointer s (BTPointerTo t) = f t |
308 resolve s (BTUnresolved t) = do |
309 where |
309 v <- gets $ find (\(a, _) -> a == t) . currentScope |
310 f (BTUnresolved s) = do |
310 if isJust v then |
311 v <- gets $ find (\(a, _) -> a == s) . currentScope |
311 resolve s . snd . snd . fromJust $ v |
312 if isJust v then |
312 else |
313 f . snd . snd . fromJust $ v |
313 error $ "Unknown type " ++ show t ++ "\n" ++ s |
314 else |
314 resolve _ t = return t |
315 error $ "Unknown type " ++ show t ++ "\n" ++ s |
315 |
316 f t = return t |
316 fromPointer :: String -> BaseType -> State RenderState BaseType |
|
317 fromPointer s (BTPointerTo t) = resolve s t |
|
318 fromPointer s (BTFunctionReturn _ (BTPointerTo t)) = resolve s t |
317 fromPointer s t = do |
319 fromPointer s t = do |
318 ns <- gets currentScope |
320 ns <- gets currentScope |
319 error $ "Dereferencing from non-pointer type " ++ show t ++ "\n" ++ s ++ "\n\n" ++ show (take 100 ns) |
321 error $ "Dereferencing from non-pointer type " ++ show t ++ "\n" ++ s ++ "\n\n" ++ show (take 100 ns) |
320 |
322 |
321 |
323 |
332 fun2C True rv (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do |
334 fun2C True rv (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do |
333 let res = docToLower $ text rv <> text "_result" |
335 let res = docToLower $ text rv <> text "_result" |
334 t <- type2C returnType |
336 t <- type2C returnType |
335 t'<- gets lastType |
337 t'<- gets lastType |
336 n <- id2C IOInsert $ setBaseType (BTFunction t') name |
338 n <- id2C IOInsert $ setBaseType (BTFunction t') name |
337 (p, ph) <- withState' (\st -> st{currentScope = (map toLower rv, (render res, t')) : currentScope st}) $ do |
339 (p, ph) <- withState' (\st -> st{currentScope = (map toLower rv, (render res, BTFunctionReturn (render n) t')) : currentScope st}) $ do |
338 p <- functionParams2C params |
340 p <- functionParams2C params |
339 ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase) |
341 ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase) |
340 return (p, ph) |
342 return (p, ph) |
341 let phrasesBlock = case returnType of |
343 let phrasesBlock = case returnType of |
342 VoidType -> ph |
344 VoidType -> ph |
670 r <- ref2C ref |
672 r <- ref2C ref |
671 t <- gets lastType |
673 t <- gets lastType |
672 ns <- gets currentScope |
674 ns <- gets currentScope |
673 case t of |
675 case t of |
674 (BTArray _ _ t') -> modify (\st -> st{lastType = t'}) |
676 (BTArray _ _ t') -> modify (\st -> st{lastType = t'}) |
|
677 (BTFunctionReturn _ (BTArray _ _ t')) -> modify (\st -> st{lastType = t'}) |
|
678 (BTFunctionReturn _ (BTString)) -> modify (\st -> st{lastType = BTChar}) |
675 (BTString) -> modify (\st -> st{lastType = BTChar}) |
679 (BTString) -> modify (\st -> st{lastType = BTChar}) |
676 (BTPointerTo t) -> do |
680 (BTPointerTo t) -> do |
677 t'' <- fromPointer (show t) =<< gets lastType |
681 t'' <- fromPointer (show t) =<< gets lastType |
678 case t'' of |
682 case t'' of |
679 BTChar -> modify (\st -> st{lastType = BTChar}) |
683 BTChar -> modify (\st -> st{lastType = BTChar}) |
696 ref2C rf@(RecordField ref1 ref2) = do |
700 ref2C rf@(RecordField ref1 ref2) = do |
697 r1 <- ref2C ref1 |
701 r1 <- ref2C ref1 |
698 t <- gets lastType |
702 t <- gets lastType |
699 ns <- gets currentScope |
703 ns <- gets currentScope |
700 r2 <- case t of |
704 r2 <- case t of |
|
705 BTFunctionReturn s (BTRecord rs) -> withRecordNamespace "" rs $ ref2C ref2 |
701 BTRecord rs -> withRecordNamespace "" rs $ ref2C ref2 |
706 BTRecord rs -> withRecordNamespace "" rs $ ref2C ref2 |
702 BTUnit -> withLastIdNamespace $ ref2C ref2 |
707 BTUnit -> withLastIdNamespace $ ref2C ref2 |
703 a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf ++ "\n" ++ show (take 100 ns) |
708 a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf ++ "\n" ++ show (take 100 ns) |
704 return $ |
709 return $ |
705 r1 <> text "." <> r2 |
710 r1 <> text "." <> r2 |
706 ref2C d@(Dereference ref) = do |
711 ref2C d@(Dereference ref) = do |
707 r <- ref2C ref |
712 r <- ref2C ref |
714 case t of |
719 case t of |
715 BTFunction t' -> do |
720 BTFunction t' -> do |
716 ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params |
721 ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params |
717 modify (\s -> s{lastType = t'}) |
722 modify (\s -> s{lastType = t'}) |
718 return $ r <> ps |
723 return $ r <> ps |
|
724 BTFunctionReturn r t' -> do |
|
725 ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params |
|
726 modify (\s -> s{lastType = t'}) |
|
727 return $ text r <> ps |
719 _ -> case (ref, params) of |
728 _ -> case (ref, params) of |
720 (SimpleReference i, [p]) -> ref2C $ TypeCast i p |
729 (SimpleReference i, [p]) -> ref2C $ TypeCast i p |
721 _ -> error $ "ref2C FunCall erroneous type cast detected: " ++ show f ++ "\nType detected: " ++ show t |
730 _ -> error $ "ref2C FunCall erroneous type cast detected: " ++ show f ++ "\nType detected: " ++ show t |
722 |
731 |
723 ref2C (Address ref) = do |
732 ref2C (Address ref) = do |