structure

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

diff --git a/gengen/Data/GenType/CType.icl b/gengen/src/GenType/CType.icl
similarity index 82%
rename from gengen/Data/GenType/CType.icl
rename to gengen/src/GenType/CType.icl
index 4a5a63a..a569ab0 100644 (file)
--- a/gengen/Data/GenType/CType.icl
+++ b/gengen/src/GenType/CType.icl
@@ -1,4 +1,4 @@
-implementation module Data.GenType.CType
+implementation module GenType.CType
 
 import Control.Applicative
 import Control.Monad
@@ -10,7 +10,6 @@ import Control.Monad.Writer
 import Data.Either
 import Data.Func
 import Data.Functor
-import Data.GenType
 import Data.List
 import qualified Data.Map
 from Data.Map import :: Map(..)
@@ -20,6 +19,8 @@ import StdEnv
 import qualified Text
 from Text import class Text(concat), instance Text String
 
+import GenType
+
 instance MonadFail (Either String) where fail s = Left s
 
 safe :: String -> String
@@ -105,29 +106,30 @@ where
        fmtField (name, ty) = ftd ty False >>| tell [" ", name, ";\n"]
 
 :: TDMonad :== WriterT [String] (StateT TDState (Either String)) ()
-:: TDState :== 'Data.Map'.Map String (String, Bool)
+:: TDState :== ('Data.Map'.Map String (String, Bool), [String])
 typedefs :: [[Type]] -> Either String [String]
-typedefs ts = evalStateT (execWriterT (mapM_ typedefgroup ts)) 'Data.Map'.newMap
+typedefs ts = (\(text, (_, enums))->enums ++ text)
+       <$> runStateT (execWriterT (mapM_ typedefgroup ts)) ('Data.Map'.newMap, [])
 where
        typedefgroup :: [Type] -> TDMonad
        typedefgroup ts
-               =   liftT (modify ('Data.Map'.putList [(typeName ty, (prefix ty, False))\\ty<-ts]))
+               =   liftT (modify (appFst $ 'Data.Map'.putList [(typeName ty, (prefix ty, False))\\ty<-ts]))
                >>| mapM_ (\x->printTypeName x >>| tell [";\n"]) (if (ts=:[_,_:_]) (map typeName ts) [])
-               >>| liftT (modify (flip (foldr $ 'Data.Map'.alter (fmap (fmap \_->True)) o typeName) ts))
+               >>| liftT (modify (appFst $ flip (foldr $ 'Data.Map'.alter (fmap (fmap \_->True)) o typeName) ts))
                >>| mapM_ (\t->typedef t >>| tell ["\n"]) ts
 
        printTypeName :: String -> TDMonad
        printTypeName tname
-               = liftT (gets (\s->maybe [safe tname, " "] (\(p, b)->[p, safe tname, if b " *" " "]) $ 'Data.Map'.get tname s))
+               = liftT (gets $ maybe [safe tname, " "] (\(p, b)->[p, safe tname, if b " *" " "]) o 'Data.Map'.get tname o fst)
                >>= tell
 
        typedef :: Type -> TDMonad
        typedef (TyRef s) = printTypeName s
        typedef (TyBasic t) = case t of
-               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"]
+               BTInt = tell ["typedef uint64_t Int;"]
+               BTChar = tell ["typedef char Char;"]
+               BTReal = tell ["typedef double Real;"]
+               BTBool = tell ["typedef bool Bool;"]
                t = fail $ "basic type: " +++ toString t +++ " not implemented"
        typedef (TyArray _ a) = tell ["*"] >>| typedef a
        typedef t=:(TyNewType ti ci a)
@@ -138,8 +140,8 @@ where
                >>| tell ["};\n"]
        //Enumeration
        typedef t=:(TyObject ti fs)
-               | and [t =: [] \\ (_, t)<-fs] = tell
-                       [consName ti, " {", 'Text'.join ", " [safe ci.gcd_name\\(ci, _)<-fs], "};\n"]
+               | and [t =: [] \\ (_, t)<-fs] = enum ti fs >>| tell [";\n"]
+                       //[consName ti, " {", 'Text'.join ", " [safe ci.gcd_name\\(ci, _)<-fs], "};\n"]
        //Single constructor, single field (box)
        typedef t=:(TyObject ti [(ci, [ty])]) = tydef ti.gtd_name ci.gcd_type
        //Single constructor
@@ -149,9 +151,9 @@ where
                >>| tell ["};\n"]
        //Complex adt
        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"]
+               ["struct ", safe ti.gtd_name, " {\n\t"]
+               >>| enum ti fs >>| tell [" cons;\n\tstruct {\n"]
+                       //, consName ti, " {", 'Text'.join ", " [safe ci.gcd_name\\(ci, _)<-fs], "} cons;\n"
                >>| mapM_ fmtCons fs
                >>| tell ["\t} data;\n};\n"]
        where
@@ -163,6 +165,10 @@ where
                        >>| tell ["\t\t} ", safe ci.gcd_name, ";\n"]
        typedef t = fail $ toString t +++ " not implemented"
 
+       enum :: GenericTypeDefDescriptor [(GenericConsDescriptor, [Type])] -> TDMonad
+       enum ti fs = liftT (modify (appSnd \xs->[consName ti, " {", 'Text'.join ", " [safe ci.gcd_name\\(ci, _)<-fs], "};\n":xs]))
+               >>| tell [consName ti]
+
        tydef :: String GenType -> TDMonad
        tydef name (GenTypeArrow l r) = tell ["typedef "] >>| fmtField "" l >>| tell [safe name,";\n"]