tools/pas2c.hs
changeset 6980 07a710e22846
parent 6979 cd28fe36170a
child 7002 5d817ba976f7
equal deleted inserted replaced
6979:cd28fe36170a 6980:07a710e22846
   368         _ -> type2C t
   368         _ -> type2C t
   369     return [text "typedef" <+> tp i]
   369     return [text "typedef" <+> tp i]
   370     
   370     
   371 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do
   371 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do
   372     t' <- liftM (((if isConst then text "const" else empty) <+>) . ) $ type2C t
   372     t' <- liftM (((if isConst then text "const" else empty) <+>) . ) $ type2C t
       
   373     ie <- initExpr mInitExpr
   373     lt <- gets lastType
   374     lt <- gets lastType
   374     ie <- initExpr mInitExpr
       
   375     case (isConst, lt, ids, mInitExpr) of
   375     case (isConst, lt, ids, mInitExpr) of
   376          (True, BTInt, [i], Just _) -> do
   376          (True, BTInt, [i], Just _) -> do
   377              i' <- id2CTyped t i
   377              i' <- id2CTyped t i
   378              return [text "enum" <> braces (i' <+> ie)]
   378              return [text "enum" <> braces (i' <+> ie)]
   379          _ -> liftM (map(\i -> t' i <+> ie)) $ mapM (id2CTyped t) ids
   379          _ -> liftM (map(\i -> t' i <+> ie)) $ mapM (id2CTyped t) ids
   465 
   465 
   466 range2C :: InitExpression -> State RenderState [Doc]
   466 range2C :: InitExpression -> State RenderState [Doc]
   467 range2C (InitString [a]) = return [quotes $ text [a]]
   467 range2C (InitString [a]) = return [quotes $ text [a]]
   468 range2C (InitRange (Range i)) = liftM (flip (:) []) $ id2C IOLookup i
   468 range2C (InitRange (Range i)) = liftM (flip (:) []) $ id2C IOLookup i
   469 range2C (InitRange (RangeFromTo (InitString [a]) (InitString [b]))) = return $ map (\i -> quotes $ text [i]) [a..b]
   469 range2C (InitRange (RangeFromTo (InitString [a]) (InitString [b]))) = return $ map (\i -> quotes $ text [i]) [a..b]
   470     
       
   471 range2C a = liftM (flip (:) []) $ initExpr2C a
   470 range2C a = liftM (flip (:) []) $ initExpr2C a
       
   471 
       
   472 baseType2C :: String -> BaseType -> Doc
       
   473 baseType2C _ BTFloat = text "float"
       
   474 baseType2C _ BTBool = text "bool"
       
   475 baseType2C _ BTString = text "string255"
       
   476 baseType2C s a = error $ "baseType2C: " ++ show a ++ "\n" ++ s
   472 
   477 
   473 type2C :: TypeDecl -> State RenderState (Doc -> Doc)
   478 type2C :: TypeDecl -> State RenderState (Doc -> Doc)
   474 type2C (SimpleType i) = liftM (\i a -> i <+> a) $ id2C IOLookup i
   479 type2C (SimpleType i) = liftM (\i a -> i <+> a) $ id2C IOLookup i
   475 type2C t = do
   480 type2C t = do
   476     r <- type2C' t
   481     r <- type2C' t
   509     type2C' (Set t) = return (text "<<set>>" <+>)
   514     type2C' (Set t) = return (text "<<set>>" <+>)
   510     type2C' (FunctionType returnType params) = do
   515     type2C' (FunctionType returnType params) = do
   511         t <- type2C returnType
   516         t <- type2C returnType
   512         p <- withState' id $ functionParams2C params
   517         p <- withState' id $ functionParams2C params
   513         return (\i -> t empty <+> i <> parens p)
   518         return (\i -> t empty <+> i <> parens p)
   514     type2C' (DeriveType (InitBinOp {})) = return (text "int" <+>)
   519     type2C' (DeriveType (InitBinOp _ _ i)) = type2C' (DeriveType i)
   515     type2C' (DeriveType (InitPrefixOp _ i)) = type2C' (DeriveType i)
   520     type2C' (DeriveType (InitPrefixOp _ i)) = type2C' (DeriveType i)
   516     type2C' (DeriveType (InitNumber _)) = return (text "int" <+>)
   521     type2C' (DeriveType (InitNumber _)) = return (text "int" <+>)
   517     type2C' (DeriveType (InitHexNumber _)) = return (text "int" <+>)
   522     type2C' (DeriveType (InitHexNumber _)) = return (text "int" <+>)
   518     type2C' (DeriveType (InitFloat _)) = return (text "float" <+>)
   523     type2C' (DeriveType (InitFloat _)) = return (text "float" <+>)
   519     type2C' (DeriveType (BuiltInFunction {})) = return (text "int" <+>)
   524     type2C' (DeriveType (BuiltInFunction {})) = return (text "int" <+>)
   520     type2C' (DeriveType (InitString {})) = return (text "string255" <+>)
   525     type2C' (DeriveType (InitString {})) = return (text "string255" <+>)
   521     type2C' (DeriveType (InitReference {})) = return (text "<<some type>>" <+>)
   526     type2C' (DeriveType r@(InitReference {})) = do
       
   527         initExpr2C r
       
   528         t <- gets lastType
       
   529         return (baseType2C (show r) t <+>)
   522     type2C' (DeriveType a) = error $ "Can't derive type from " ++ show a
   530     type2C' (DeriveType a) = error $ "Can't derive type from " ++ show a
   523 
   531 
   524 phrase2C :: Phrase -> State RenderState Doc
   532 phrase2C :: Phrase -> State RenderState Doc
   525 phrase2C (Phrases p) = do
   533 phrase2C (Phrases p) = do
   526     ps <- mapM phrase2C p
   534     ps <- mapM phrase2C p