geg

[clean-tests.git] / gengen / Data / GenType / CType.icl

diff --git a/gengen/Data/GenType/CType.icl b/gengen/Data/GenType/CType.icl
index 8ff9341..4a5a63a 100644 (file)
--- a/gengen/Data/GenType/CType.icl
+++ b/gengen/Data/GenType/CType.icl
@@ -121,38 +121,34 @@ where
                = liftT (gets (\s->maybe [safe tname, " "] (\(p, b)->[p, safe tname, if b " *" " "]) $ 'Data.Map'.get tname s))
                >>= tell
 
-       header :: Type [String] -> WriterT [String] m () | Monad m
-       header t c = tell ["// ", toString (replaceBuiltins t), "\n":c]
-       
        typedef :: Type -> TDMonad
        typedef (TyRef s) = printTypeName s
        typedef (TyBasic t) = case t of
-               BTInt = printTypeName "int64_t"
-               BTChar = printTypeName "char"
-               BTReal = printTypeName "double"
-               BTBool = printTypeName "bool"
+               BTInt = tell ["typedef uint64_t Int;\n"]
+               BTChar = tell ["typedef char Char;\n"]
+               BTReal = tell ["typedef double Real;\n"]
+               BTBool = tell ["typedef bool Bool;\n"]
                t = fail $ "basic type: " +++ toString t +++ " not implemented"
        typedef (TyArray _ a) = tell ["*"] >>| typedef a
        typedef t=:(TyNewType ti ci a)
-               =   header t []
-               >>| tydef ti.gtd_name ci.gcd_type
+               = tydef ti.gtd_name ci.gcd_type
        typedef t=:(TyRecord ti fs)
-               =   header t ["struct ", safe ti.grd_name, " {\n"]
+               =   tell ["struct ", safe ti.grd_name, " {\n"]
                >>| fmtFields 1 ti.grd_type [fi.gfd_name\\(fi, _)<-fs]
                >>| tell ["};\n"]
        //Enumeration
        typedef t=:(TyObject ti fs)
-               | and [t =: [] \\ (_, t)<-fs] = header t
+               | and [t =: [] \\ (_, t)<-fs] = tell
                        [consName ti, " {", 'Text'.join ", " [safe ci.gcd_name\\(ci, _)<-fs], "};\n"]
        //Single constructor, single field (box)
-       typedef t=:(TyObject ti [(ci, [ty])]) = header t [] >>| tydef ti.gtd_name ci.gcd_type
+       typedef t=:(TyObject ti [(ci, [ty])]) = tydef ti.gtd_name ci.gcd_type
        //Single constructor
        typedef t=:(TyObject ti [(ci, ts)])
-               =   header t ["struct ", safe ti.gtd_name, " {\n"]
+               =   tell ["struct ", safe ti.gtd_name, " {\n"]
                >>| fmtFields 1 ci.gcd_type ["f" +++ toString i\\i<-indexList ts]
                >>| tell ["};\n"]
        //Complex adt
-       typedef t=:(TyObject ti fs) = header t
+       typedef t=:(TyObject ti fs) = tell
                ["struct ", safe ti.gtd_name, " {\n"
                , "\t", consName ti, " {", 'Text'.join ", " [safe ci.gcd_name\\(ci, _)<-fs], "} cons;\n"
                , "\tstruct {\n"]
@@ -166,15 +162,15 @@ where
                        >>| fmtFields 3 ci.gcd_type ["f" +++ toString i\\i<-indexList ts]
                        >>| tell ["\t\t} ", safe ci.gcd_name, ";\n"]
        typedef t = fail $ toString t +++ " not implemented"
-       
+
        tydef :: String GenType -> TDMonad
        tydef name (GenTypeArrow l r) = tell ["typedef "] >>| fmtField "" l >>| tell [safe name,";\n"]
-       
+
        fmtFields :: Int GenType [String] -> TDMonad
        fmtFields i _ [] = pure ()
        fmtFields i (GenTypeArrow l r) [x:xs]
                = tell [createArray i '\t'] >>| fmtField x l >>| tell [";\n"] >>| fmtFields i r xs
-       
+
        fmtField :: String GenType -> TDMonad
        fmtField x (GenTypeCons a) = printTypeName a >>| tell [x]
        fmtField x (GenTypeVar a) = tell ["void *",x]