yes

diff --git a/gengen/Data/GenType.dcl b/gengen/Data/GenType.dcl
index 8bef27a..a073c6b 100644 (file)
--- a/gengen/Data/GenType.dcl
+++ b/gengen/Data/GenType.dcl
@@ -56,7 +56,7 @@ flattenGType :: GType -> [[GType]]
  * @param gtype
  * @result a type on success
  */
-gTypeToType :: GType -> Maybe Type
+gTypeToType :: GType -> Type
 
 /**
  * Gives the name for the type

diff --git a/gengen/Data/GenType.icl b/gengen/Data/GenType.icl
index 64b804d..e6cfe8b 100644 (file)
--- a/gengen/Data/GenType.icl
+++ b/gengen/Data/GenType.icl
@@ -164,30 +164,31 @@ instance toString GenType where toString a = concat $ print a []
 isperse :: a [[a] -> [a]] [a] -> [a]
 isperse s m c = foldr id c $ intersperse (\c->[s:c]) m
 
-gTypeToType :: GType -> Maybe Type
-gTypeToType (GTyBasic a) = pure $ TyBasic a
-gTypeToType (GTyRef a) = pure $ TyRef a
-gTypeToType (GTyArrow l r) = TyArrow <$> gTypeToType l <*> gTypeToType r
-gTypeToType (GTyArray s a) = TyArray s <$> gTypeToType a
-gTypeToType (GTyUList s a) = TyUList s <$> gTypeToType a
-gTypeToType (GTyRecord i t) = TyRecord i <$> gtrec t
+gTypeToType :: GType -> Type
+gTypeToType (GTyBasic a) = TyBasic a
+gTypeToType (GTyRef a) = TyRef a
+gTypeToType (GTyArrow l r) = TyArrow (gTypeToType l) (gTypeToType r)
+gTypeToType (GTyArray s a) = TyArray s (gTypeToType a)
+gTypeToType (GTyUList s a) = TyUList s (gTypeToType a)
+gTypeToType (GTyRecord i t) = TyRecord i (gtrec t [])
 where
-       gtrec (GTyField i t) = (\x->[(i, x)]) <$> gTypeToType t
-       gtrec (GTyPair l r) = (++) <$> gtrec l <*> gtrec r
-       gtrec _ = Nothing
+       gtrec :: GType [(GenericFieldDescriptor, Type)] -> [(GenericFieldDescriptor, Type)]
+       gtrec (GTyField i t) c = [(i, gTypeToType t):c]
+       gtrec (GTyPair l r) c = gtrec l $ gtrec r c
+       gtrec _ c = c
 gTypeToType (GTyObject i=:{gtd_num_conses=0} t)
-       = TyNewType i (hd i.gtd_conses) <$> gTypeToType t
-gTypeToType (GTyObject i t) = TyObject i <$> gtobj t
+       = TyNewType i (hd i.gtd_conses) (gTypeToType t)
+gTypeToType (GTyObject i t) = TyObject i (gtobj t [])
 where
-       gtobj :: GType -> Maybe [(GenericConsDescriptor, [Type])]
-       gtobj (GTyEither l r) = (++) <$> gtobj l <*> gtobj r
-       gtobj (GTyCons i a) = (\x->[(i, x)]) <$> gtcons a
-       gtobj _ = Nothing
+       gtobj :: GType [(GenericConsDescriptor, [Type])] -> [(GenericConsDescriptor, [Type])]
+       gtobj (GTyEither l r) c = gtobj l $ gtobj r c
+       gtobj (GTyCons i a) c = [(i, gtcons a []):c]
+       gtobj _ c = c
        
-       gtcons :: GType -> Maybe [Type]
-       gtcons GTyUnit = pure []
-       gtcons (GTyPair l r) = (++) <$> gtcons l <*> gtcons r
-       gtcons t = (\x->[x]) <$> gTypeToType t
+       gtcons :: GType [Type] -> [Type]
+       gtcons GTyUnit c = c
+       gtcons (GTyPair l r) c = gtcons l $ gtcons r c
+       gtcons t c = [gTypeToType t:c]
 
 :: FlatMonad :== State FMState GType
 :: FMState = { objects :: [String], types :: [GType], otypes :: [GType], depth :: Int }

diff --git a/gengen/Data/GenType/CType.icl b/gengen/Data/GenType/CType.icl
index d8ba99b..3ce9216 100644 (file)
--- a/gengen/Data/GenType/CType.icl
+++ b/gengen/Data/GenType/CType.icl
@@ -22,8 +22,10 @@ typedefs ts = flatten <$> evalStateT (mapM typedefgroup ts) { tinfo = [] }
 typedefgroup :: [Type] -> TDMonad
 typedefgroup ts
        =   flatten
-       <$  mapM (\t->modify \s->{s & tinfo=[(typeName t, if (ts =: [_]) (maybeInfinite t) True):s.tinfo]}) ts
+//     <$  mapM (\t->modify \s->{s & tinfo=[(typeName t, True):s.tinfo]}) ts
+       <$  modify (\s->{s & tinfo=[(typeName t, True)\\t<-ts] ++ s.tinfo})
        <*> mapM (\t->typedef t >>= post ["\n"]) ts
+       <*  modify (\s->{s & tinfo=[(typeName t, maybeInfinite t)\\t<-ts] ++ s.tinfo})
 where
        maybeInfinite :: Type -> Bool
        maybeInfinite t = False
@@ -38,7 +40,6 @@ pre t s = ((++)t) <$> s
 post :: [String] [String] -> m [String] | pure m
 post t s = pure (s ++ t)
 
-import StdDebug
 typedef :: Type -> TDMonad
 typedef (TyRef s) = printTypeName s
 typedef (TyBasic BTInt) = pure [IF_INT_64_OR_32 "int64_t" "int32_t"]
@@ -50,8 +51,7 @@ typedef t=:(TyNewType ti ci a)
        = pre ["// ", toString t, "\n", "typedef ", ti.gtd_name, " "] $ fmtFields 0 ci.gcd_type [""]
 typedef t=:(TyRecord ti fs) = pre
        [ "// ", toString t, "\n", "struct ", ti.grd_name, " {\n"]
-       $ fmtFields 1 ti.grd_type [fi.gfd_name\\(fi, _)<-fs]
-       >>= post ["};\n"]
+       $ fmtFields 1 ti.grd_type [fi.gfd_name\\(fi, _)<-fs] >>= post ["};\n"]
 //Enumeration
 typedef t=:(TyObject ti fs)
        | and [t =: [] \\ (_, t)<-fs] = pure
@@ -63,8 +63,7 @@ typedef t=:(TyObject ti [(ci, [ty])]) = pre
 //Single constructor
 typedef t=:(TyObject ti [(ci, ts)]) = pre
        [ "// ", toString t, "\n", "struct ", ti.gtd_name, " {\n"]
-       $ fmtFields 1 ci.gcd_type ["f" +++ toString i\\i<-indexList ts]
-       >>= post ["};\n"]
+       $ fmtFields 1 ci.gcd_type ["f" +++ toString i\\i<-indexList ts] >>= post ["};\n"]
 //Complex adt
 typedef t=:(TyObject ti fs) = pre
        [ "// ", toString t, "\nstruct ", ti.gtd_name, " {\n"

diff --git a/gengen/test.icl b/gengen/test.icl
index 27fcd7d..2a59baa 100644 (file)
--- a/gengen/test.icl
+++ b/gengen/test.icl
@@ -14,7 +14,7 @@ import Data.Either
 import Data.GenType
 import Data.GenType.CType
 
-derive gType Either, Maybe, T, R, Frac, Tr, Fix, Odd, Even, SR, List, Enum, NT
+derive gType Either, Maybe, T, R, Frac, Tr, Fix, Odd, Even, SR, List, Enum, NT, Blurp
 
 :: T a =: T2 a
 :: NT =: NT Int
@@ -28,6 +28,8 @@ derive gType Either, Maybe, T, R, Frac, Tr, Fix, Odd, Even, SR, List, Enum, NT
 
 :: List a = Cons a (List a) | Nil
 
+:: Blurp a = Blurp (List a) | Blorp
+
 ////Start :: [String]
 ////Start = foldr (\i c->print i ["\n":c]) [] $ catMaybes $ map gTypeToType $ flattenGType $ unBox t
 //:: Pair a b = Pair a b
@@ -36,17 +38,17 @@ derive gType Either, Maybe, T, R, Frac, Tr, Fix, Odd, Even, SR, List, Enum, NT
 :: Odd a = Odd (Even a) | OddBlurp
 :: Even a = Even (Odd a) | EvenBlurp
 :: Enum = A | B | C
-Start = typedefs
+Start = typedefs //$ (\x->[[gTypeToType x]])
 //     $ map (/*filter (not o isBuiltin) o*/ catMaybes o map gTypeToType)
-//     $ flattenGType
-       $ (\x->[[fromJust x]])
-       $ gTypeToType
+//     $ (\x->[[x]])
+       $ map (map gTypeToType)
+       $ flattenGType
        $ unBox t
 //
 //
 //t :: Box GType (?# Int)
 //t :: Box GType (Maybe [Maybe (Either Bool String)])
-t :: Box GType ([SR], Enum, T Int, NT)
+t :: Box GType ([SR], Enum, T Int, NT, Blurp Int)
 //t :: Box GType (Tr Either Enum)
 //t :: Box GType (Odd Int, (), [Either (R (T *World)) (Frac Real)], Tr Either Bool, Fix Maybe)
 t = gType{|*|}