tools/pas2c.hs
changeset 7134 beb16926ae5c
parent 7075 6bd7e5ad3f2b
child 7151 ec15d9e1a7e3
equal deleted inserted replaced
7132:baf3351646f4 7134:beb16926ae5c
    37         lastType :: BaseType,
    37         lastType :: BaseType,
    38         stringConsts :: [(String, String)],
    38         stringConsts :: [(String, String)],
    39         uniqCounter :: Int,
    39         uniqCounter :: Int,
    40         toMangle :: Set.Set String,
    40         toMangle :: Set.Set String,
    41         currentUnit :: String,
    41         currentUnit :: String,
       
    42         currentFunctionResult :: String,
    42         namespaces :: Map.Map String Records
    43         namespaces :: Map.Map String Records
    43     }
    44     }
    44     
    45     
    45 emptyState = RenderState Map.empty "" BTUnknown [] 0 Set.empty ""
    46 emptyState = RenderState Map.empty "" BTUnknown [] 0 Set.empty "" ""
    46 
    47 
    47 getUniq :: State RenderState Int
    48 getUniq :: State RenderState Int
    48 getUniq = do
    49 getUniq = do
    49     i <- gets uniqCounter
    50     i <- gets uniqCounter
    50     modify(\s -> s{uniqCounter = uniqCounter s + 1})
    51     modify(\s -> s{uniqCounter = uniqCounter s + 1})
   379 fun2C True rv (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do
   380 fun2C True rv (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do
   380     let res = docToLower $ text rv <> text "_result"
   381     let res = docToLower $ text rv <> text "_result"
   381     t <- type2C returnType
   382     t <- type2C returnType
   382     t'<- gets lastType
   383     t'<- gets lastType
   383     n <- id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name
   384     n <- id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name
   384     (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [(render res, t')] $ currentScope st}) $ do
   385     
       
   386     let isVoid = case returnType of
       
   387             VoidType -> True
       
   388             _ -> False
       
   389             
       
   390     (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [(render res, t')] $ currentScope st
       
   391             , currentFunctionResult = if isVoid then [] else render res}) $ do
   385         p <- functionParams2C params
   392         p <- functionParams2C params
   386         ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase)
   393         ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase)
   387         return (p, ph)
   394         return (p, ph)
   388     let phrasesBlock = case returnType of
   395         
   389             VoidType -> ph
   396     let phrasesBlock = if isVoid then ph else t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi
   390             _ -> t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi
   397     
   391     return [ 
   398     return [ 
   392         t empty <+> n <> parens p
   399         t empty <+> n <> parens p
   393         $+$
   400         $+$
   394         text "{" 
   401         text "{" 
   395         $+$ 
   402         $+$ 
   613     t <- gets lastType
   620     t <- gets lastType
   614     case (t, expr) of
   621     case (t, expr) of
   615         (BTFunction {}, (Reference r')) -> do
   622         (BTFunction {}, (Reference r')) -> do
   616             e <- ref2C r'
   623             e <- ref2C r'
   617             return $ r <+> text "=" <+> e <> semi
   624             return $ r <+> text "=" <+> e <> semi
       
   625         (BTString, _) -> do
       
   626             e <- expr2C expr
       
   627             lt <- gets lastType
       
   628             case lt of
       
   629                 -- assume pointer to char for simplicity
       
   630                 BTPointerTo _ -> do
       
   631                     e <- expr2C $ Reference $ FunCall [Reference $ RefExpression expr] (SimpleReference (Identifier "pchar2str" BTUnknown))
       
   632                     return $ r <+> text "=" <+> e <> semi
       
   633                 BTString -> do
       
   634                     e <- expr2C expr
       
   635                     return $ r <+> text "=" <+> e <> semi
       
   636                 _ -> error $ "Assignment to string from " ++ show lt
   618         (BTArray (Range _) _ _, _) -> phrase2C $ 
   637         (BTArray (Range _) _ _, _) -> phrase2C $ 
   619             ProcCall (FunCall
   638             ProcCall (FunCall
   620                 [
   639                 [
   621                 Reference $ Address ref
   640                 Reference $ Address ref
   622                 , Reference $ Address $ RefExpression expr
   641                 , Reference $ Address $ RefExpression expr
   669     e <- expr2C e'
   688     e <- expr2C e'
   670     p <- phrase2C (Phrases p')
   689     p <- phrase2C (Phrases p')
   671     return $ text "do" <+> p <+> text "while" <> parens (text "!" <> parens e) <> semi
   690     return $ text "do" <+> p <+> text "while" <> parens (text "!" <> parens e) <> semi
   672 phrase2C NOP = return $ text ";"
   691 phrase2C NOP = return $ text ";"
   673 
   692 
   674 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "exit" BTUnknown))) = return $ text "return" <> semi
   693 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "exit" BTUnknown))) = do
       
   694     f <- gets currentFunctionResult
       
   695     if null f then
       
   696         return $ text "return" <> semi
       
   697         else
       
   698         return $ text "return" <+> text f <> semi
   675 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "break" BTUnknown))) = return $ text "break" <> semi
   699 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "break" BTUnknown))) = return $ text "break" <> semi
   676 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "continue" BTUnknown))) = return $ text "continue" <> semi
   700 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "continue" BTUnknown))) = return $ text "continue" <> semi
   677 phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "exit" BTUnknown))) = liftM (\e -> text "return" <+> e <> semi) $ expr2C e
   701 phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "exit" BTUnknown))) = liftM (\e -> text "return" <+> e <> semi) $ expr2C e
   678 phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "dec" BTUnknown))) = liftM (\e -> text "--" <> e <> semi) $ expr2C e
   702 phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "dec" BTUnknown))) = liftM (\e -> text "--" <> e <> semi) $ expr2C e
   679 phrase2C (BuiltInFunctionCall [e1, e2] (SimpleReference (Identifier "dec" BTUnknown))) = liftM2 (\a b -> a <> text " -= " <> b <> semi) (expr2C e1) (expr2C e2)
   703 phrase2C (BuiltInFunctionCall [e1, e2] (SimpleReference (Identifier "dec" BTUnknown))) = liftM2 (\a b -> a <> text " -= " <> b <> semi) (expr2C e1) (expr2C e2)