yes

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

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 }