From: Mart Lubbers <mart@martlubbers.net>
Date: Mon, 7 Sep 2020 17:00:10 +0000 (+0200)
Subject: structure
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=3540be65cab4d636cd83e0b8e9e6b056c25db72b;p=clean-tests.git

structure
---

diff --git a/gengen/.gitignore b/gengen/.gitignore
new file mode 100644
index 0000000..b46064f
--- /dev/null
+++ b/gengen/.gitignore
@@ -0,0 +1,10 @@
+Clean System Files
+*.prj
+*.prp
+*.exe
+*.out
+*-data
+*-www
+*-sapl
+*.bc
+*.pbc
diff --git a/gengen/Data/GenType/Serialize.dcl b/gengen/Data/GenType/Serialize.dcl
deleted file mode 100644
index c0e173f..0000000
--- a/gengen/Data/GenType/Serialize.dcl
+++ /dev/null
@@ -1,10 +0,0 @@
-definition module Data.GenType.Serialize
-
-from Data.Either import :: Either
-from Data.GenType import :: Type
-
-/**
- * Generate a single parser for a type.
- * This does not terminate for a recursive type
- */
-serialize :: Type -> Either String [Char]
diff --git a/gengen/README.md b/gengen/README.md
new file mode 100644
index 0000000..6cce793
--- /dev/null
+++ b/gengen/README.md
@@ -0,0 +1,2 @@
+# Deeply embedded generics
+
diff --git a/gengen/gen b/gengen/gen
deleted file mode 100755
index be20b09..0000000
Binary files a/gengen/gen and /dev/null differ
diff --git a/gengen/Data/GenType.dcl b/gengen/src/GenType.dcl
similarity index 70%
rename from gengen/Data/GenType.dcl
rename to gengen/src/GenType.dcl
index c01eca9..062dbc5 100644
--- a/gengen/Data/GenType.dcl
+++ b/gengen/src/GenType.dcl
@@ -1,14 +1,16 @@
-definition module Data.GenType
+definition module GenType
 
 import StdGeneric
 from StdOverloaded import class ==, class toString
 
+//* Auxiliary type to help with casting values, this is gone at runtime
 :: Box b a =: Box b
 derive bimap Box
 unBox (Box b) :== b
 box b :== Box b
 reBox x :== box (unBox x)
 
+//* Deeply embedded generic type representation
 :: GType
 	= GTyBasic BasicType
 	| GTyRef String
@@ -24,6 +26,7 @@ reBox x :== box (unBox x)
 	| GTyObject GenericTypeDefDescriptor GType
 	| GTyRecord GenericRecordDescriptor GType
 
+//* Type representation larded with the generic type information
 :: Type
 	= TyBasic BasicType
 	| TyRef String
@@ -35,70 +38,54 @@ reBox x :== box (unBox x)
 	| TyObject GenericTypeDefDescriptor [(GenericConsDescriptor, [Type])]
 	| TyRecord GenericRecordDescriptor [(GenericFieldDescriptor, Type)]
 
+//* Basic types
 :: BasicType = BTInt | BTChar | BTReal | BTBool | BTDynamic | BTFile | BTWorld
+//* Array kinds
 :: ArrayType = AStrict | ALazy | AUnboxed | APacked
+//* Unboxed list kinds
 :: UListType = ULLazy | ULStrict
+//* Kind of a type
+:: Kind = KStar | (KArrow) infixr 1 Kind Kind
 
-instance == GType, Type, BasicType, ArrayType, UListType, GenType
-instance toString GType, Type, BasicType, ArrayType, UListType, GenType
+instance == GType, Type, BasicType, ArrayType, UListType, GenType, Kind
+instance toString GType, Type, BasicType, ArrayType, UListType, GenType, Kind
 
 /**
  * Removes recursive types by replacing them with references
  *
  * @param gtype
  * @result the main type
- * @result all the separate types grouped in the strongly connected components
+ * @result the separated types grouped in strongly connected components
  */
 flattenGType :: GType -> [[GType]]
 
-/**
- * Convert a GType to a Type. This always returns a Just if the GType was
- * constructed using the gType generic function
- *
- * @param gtype
- * @result a type on success
- */
+//* Convert a GType to a Type
 gTypeToType :: GType -> Type
 
-/**
- * Gives the name for the type
- */
+//* Extract the name of the type
 typeName :: Type -> String
 
-/**
- * Gives the genType for a type
- */
+//* Extract the genType for a type
 typeGenType :: Type -> [GenType]
 
-/**
- * Return an approximation of the kind of the type given all the constructors
- */
-:: Kind = KStar | (KArrow) infixr 1 Kind Kind
+//* Extract the kind of the type's constructors (see `{{typeGenType}}`)
 genTypeKind :: [GenType] -> Kind
-instance toString Kind
+//* @type Type -> Kind
+typeKind t :== genTypeKind (typeGenType t)
 
-/**
- * Predicate whether the outer type is a builtin type
- */
+//* Predicate whether the outer type is a builtin type
 class isBuiltin a :: a -> Bool
 instance isBuiltin Type, GType
 
-/**
- * Predicate whether the outer type is a basic type
- * Int, Bool, Char, Real, World, File, Dynamic
- */
+//* Predicate whether the outer type is a basic type
 class isBasic a :: a -> Bool
 instance isBasic Type, GType
 
-/**
- * Replace builtin constructors with their pretty names
- */
+//* Replace builtin constructors with their pretty names (e.g. _!Cons with [!])
 class replaceBuiltins a :: a -> a
 instance replaceBuiltins Type, GType, GenType
 
-/**
- * Creates a deep representation of the type
- */
+//* Creates a deep embedded generic representation of a type
 generic gType a :: Box GType a
 derive gType UNIT, EITHER, PAIR, CONS of gcd, FIELD of gfd, OBJECT of gtd, RECORD of grd
 derive gType Int, Bool, Real, Char, World, File
diff --git a/gengen/Data/GenType.icl b/gengen/src/GenType.icl
similarity index 95%
rename from gengen/Data/GenType.icl
rename to gengen/src/GenType.icl
index 4d2e311..cfd52e9 100644
--- a/gengen/Data/GenType.icl
+++ b/gengen/src/GenType.icl
@@ -1,4 +1,4 @@
-implementation module Data.GenType
+implementation module GenType
 
 import StdEnv, StdGeneric
 import Control.Applicative
@@ -258,7 +258,7 @@ typeName (TyRef a) = a
 typeName (TyArrow l r) = typeName l +++ "->" +++ typeName r
 typeName (TyArray s a) = "{" +++ toString s +++ typeName a +++ "}"
 typeName (TyUList s a) = "[#" +++ toString s +++ typeName a +++ "]"
-typeName (TyUMaybe a) = "?" +++ typeName a
+typeName (TyUMaybe a) = "?#" +++ typeName a
 typeName (TyNewType i _ _) = i.gtd_name
 typeName (TyObject i _) = i.gtd_name
 typeName (TyRecord i _) = i.grd_name
@@ -270,7 +270,7 @@ typeGenType (TyArrow l r) = GenTypeArrow <$> typeGenType l <*> typeGenType r
 typeGenType (TyArray s a) = GenTypeApp (GenTypeCons (toString s)) <$> typeGenType a
 typeGenType (TyUList s a) = [GenTypeCons "_#Nil":GenTypeApp (GenTypeCons (toString s)) <$> typeGenType a]
 typeGenType (TyUMaybe a) = [GenTypeCons "_#Nothing":GenTypeApp (GenTypeCons "_#Just") <$> typeGenType a]
-typeGenType (TyNewType _ _ a) = abort "typeGenType for newtypes not yet implemented\n"
+typeGenType (TyNewType _ i a) = [i.gcd_type]
 typeGenType (TyRecord i _) = [i.grd_type]
 typeGenType (TyObject _ fs) = [c.gcd_type\\(c, _)<-fs]
 
@@ -278,18 +278,32 @@ genTypeKind :: [GenType] -> Kind
 genTypeKind ts = foldr (KArrow) KStar $ map snd $ sortBy ((<) `on` fst) $ foldr (\t->gt t id) [] ts
 where
 	gt :: GenType (Kind -> Kind) [(Int, Kind)] -> [(Int, Kind)]
-	gt (GenTypeCons _) c ks = ks
-	gt (GenTypeVar i) c ks = case lookup i ks of
-		Nothing = [(i, c KStar):ks]
-		Just KStar = [(i, c KStar):filter ((<>)i o fst) ks]
-		Just _ = ks
-	gt (GenTypeArrow l r) c ks = gt l id $ gt r id ks
+	gt (GenTypeCons _) _ ks = ks
+	gt (GenTypeVar i) c ks
+		# k = c KStar
+		= case lookup i ks of
+			Nothing = [(i, k):ks]
+			Just k`
+				| numArr k` > numArr k = ks
+				= [(i, k):filter ((<>)i o fst) ks]
+	gt (GenTypeArrow l r) _ ks = gt l id $ gt r id ks
 	gt (GenTypeApp l r) c ks = gt l ((KArrow) KStar o c) $ gt r id ks
-instance toString Kind where toString k = concat $ print k []
-instance print Kind
+
+numArr :: Kind -> Int
+numArr KStar = 0
+numArr (l KArrow r) = inc (numArr l + numArr r)
+
+instance == Kind
 where
-	print KStar c = ["*":c]
-	print (l KArrow r) c = ["(":print l ["->":print r [")":c]]]
+	(==) KStar KStar = True
+	(==) (l1 KArrow r1) (l2 KArrow r2) = l1 == l2 && r1 == r2
+	(==) _ _ = False
+instance toString Kind where toString k = concat $ pr k False []
+
+
+pr :: Kind Bool [String] -> [String]
+pr KStar _ c = ["*":c]
+pr (l KArrow r) b c = [if b "(" "":pr l True ["->":pr r False [if b ")" "":c]]]
 
 instance isBuiltin String
 where
diff --git a/gengen/Data/GenType/CParser.dcl b/gengen/src/GenType/CParser.dcl
similarity index 82%
rename from gengen/Data/GenType/CParser.dcl
rename to gengen/src/GenType/CParser.dcl
index 67db0f3..617594d 100644
--- a/gengen/Data/GenType/CParser.dcl
+++ b/gengen/src/GenType/CParser.dcl
@@ -1,7 +1,7 @@
-definition module Data.GenType.CParser
+definition module GenType.CParser
 
 from Data.Either import :: Either
-from Data.GenType import :: Type
+from GenType import :: Type
 
 /**
  * Generate a single parser for a type.
diff --git a/gengen/Data/GenType/CParser.icl b/gengen/src/GenType/CParser.icl
similarity index 82%
rename from gengen/Data/GenType/CParser.icl
rename to gengen/src/GenType/CParser.icl
index 130ee3d..0677604 100644
--- a/gengen/Data/GenType/CParser.icl
+++ b/gengen/src/GenType/CParser.icl
@@ -1,4 +1,4 @@
-implementation module Data.GenType.CParser
+implementation module GenType.CParser
 
 import Control.Applicative
 import Control.Monad
@@ -19,15 +19,15 @@ import StdEnv
 import qualified Text
 from Text import class Text(concat), instance Text String
 
-import Data.GenType
-import Data.GenType.CType
+import GenType
+import GenType.CType
 
 instance MonadFail (Either String) where fail s = Left s
 :: FPMonad :== WriterT [String] (ReaderT Int (Either String)) ()
 
 indent c = liftT ask >>= \i->tell [createArray i '\t':c]
 
-parsefun t = "parse_" +++ safe (typeName t)
+parsefun t c = ["parse_", safe (typeName t):c]
 
 (<.>) infixr 6
 (<.>) a b = a +++ "." +++ b
@@ -42,14 +42,10 @@ tail = ["\treturn r;\n}\n"]
 parsenameimp t c def = def t [" {\n\t":ctypename t [" ", c, "\n\n"]]
 ctypename t c = [prefix t, safe (typeName t):c]
 
-/**
- * Generate a single parser for a type.
- * This does not terminate for a recursive type
- */
 flatParser :: Type -> Either String ([String], [String])
 flatParser t = tuple (parsedef [";\n"]) <$> runReaderT (execWriterT (tell (parsenameimp t "r;" \_->parsedef) >>| fpd t True "r" >>| tell tail)) 1
 where
-	parsedef c = ctypename t [" ", parsefun t, "(uint8_t (*get)())":c]
+	parsedef c = ctypename t [" ":parsefun t ["(uint8_t (*get)())":c]]
 
 	fpd :: Type Bool String -> FPMonad
 	fpd (TyRef s) tl r = assign r (parsename s)
@@ -65,7 +61,7 @@ where
 				>>| result r "+=" "(int64_t)get()<<8"
 				>>| result r "+=" "(int64_t)get()"
 			BTChar = assign r "(char)get()"
-			BTReal = assign r "double"
+//			BTReal = assign r "double"
 			BTBool = assign r "(bool)get()"
 			t = fail $ "flatParse: there is no basic type for " +++ toString t
 	fpd (TyArrow _ _) tl r = fail $ "flatParser: function cannot be serialized"
@@ -100,12 +96,8 @@ where
 	fmtField :: (String, Type) -> FPMonad
 	fmtField (name, ty) = fpd ty False name
 
-/**
- * generate parsers for the types grouped by strongly connected components
- */
 :: TPMonad :== WriterT [String] (StateT TPState (Either String)) ()
 :: TPState :== 'Data.Map'.Map String (String, Bool)
-import Debug.Trace
 parsers :: [[Type]] -> Either String ([String], [String])
 parsers ts = tuple (parsedefs ts) <$> evalStateT (execWriterT $ mapM_ parsergroup ts) 'Data.Map'.newMap
 where
@@ -113,24 +105,20 @@ where
 	parsedefs = foldr (\t c->parsedef t [";\n":c]) [] o flatten
 
 	parsedef :: Type [String] -> [String]
-	parsedef t c
-		# (pt, _) = trace_stdout (parsefun t, toString $ genTypeKind $ typeGenType t)
-		= ctypename t [" *", /*parsefun */pt, "(uint8_t (*get)()",pd t, ")":c]
+	parsedef t c = ctypename t [" *":parsefun t ["(uint8_t (*get)()":pks (typeKind t) True [")":c]]]
 	where
-		pd (TyBasic s) = ""
-		pd (TyUList _ _) = ", void *parse_0(uint8_t (*get)())"
-		pd (TyUMaybe _) = ", void *parse_0(uint8_t (*get)())"
-		pd (TyObject gtd _) = concat [", void *parse_" +++ toString i +++ "(uint8_t (*)())"\\i<-[0..gtd.gtd_arity-1]]
-		pd (TyRecord grd _) = concat [", void *parse_" +++ toString i +++ "(uint8_t (*)())"\\i<-[0..recordArity (trace_stdout grd.grd_type)-1]]
-//		pd (TyNewType _ _ _) = abort "not implemented yet\n"
-		pd t = abort $ "not implemented yet: " +++ toString t +++ "\n"
-
-	recordArity :: GenType -> Int
-	recordArity (GenTypeCons _) = 0
-	recordArity (GenTypeVar _) = 0
-	recordArity (GenTypeApp _ _) = 0
-	recordArity (GenTypeArrow _ (GenTypeApp _ _)) = 1
-	recordArity (GenTypeArrow l r) = inc $ recordArity l
+		pks :: Kind Bool [String] -> [String]
+		pks k tl c = foldr (\(i, k) c->pd k tl i c) c $ zip2 [0..] $ typeArgs k
+
+		pd :: Kind Bool Int [String] -> [String]
+		pd KStar tl i c = [", void *(*", if tl ("parse_"+++toString i) "", ")(uint8_t (*)())":c]
+		pd (l KArrow r) tl i c =
+			[ ", void *(*", if tl ("parse_"+++toString i) "", ")(uint8_t (*)()"
+			: pks l False $ pd r False (inc i) [")":c]]
+
+		typeArgs :: Kind -> [Kind]
+		typeArgs KStar = []
+		typeArgs (l KArrow r) = [l:typeArgs r]
 
 	parsergroup :: [Type] -> TPMonad
 	parsergroup ts
@@ -145,7 +133,7 @@ where
 		>>= tell
 
 	parser :: Type -> TPMonad
-	parser t=:(TyRef s) = tell [parsefun t]
+	parser t=:(TyRef s) = tell $ parsefun t []
 	parser (TyBasic t)
 		= case t of
 			BTInt = tell ["\t*r = (Int)get()<<54;\n"
diff --git a/gengen/Data/GenType/CType.dcl b/gengen/src/GenType/CType.dcl
similarity index 89%
rename from gengen/Data/GenType/CType.dcl
rename to gengen/src/GenType/CType.dcl
index ec6622f..2fb8ad3 100644
--- a/gengen/Data/GenType/CType.dcl
+++ b/gengen/src/GenType/CType.dcl
@@ -1,8 +1,8 @@
-definition module Data.GenType.CType
+definition module GenType.CType
 
 from StdGeneric import :: GenericTypeDefDescriptor
 from Data.Either import :: Either
-from Data.GenType import :: Type
+from GenType import :: Type
 
 /**
  * generate typedefs for the types grouped by strongly connected components
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
--- 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"]
 
diff --git a/gengen/test.icl b/gengen/test.icl
deleted file mode 100644
index 8d41f40..0000000
--- a/gengen/test.icl
+++ /dev/null
@@ -1,168 +0,0 @@
-module test
-
-import StdEnv, StdGeneric
-
-import Data.Func
-import Data.Functor
-import Data.List
-import Data.Tuple
-import Data.Bifunctor
-import Data.Maybe
-import Control.GenBimap
-import Data.Either
-import System.FilePath
-
-import Data.GenType
-import Data.GenType.CType
-import Data.GenType.CParser
-import Text
-
-derive gType Either, T, R, Frac, Tr, Fix, Odd, Even, SR, List, Enum, NT, Blurp, EnumList, ER, CP, RA, Nest, MR, P
-
-:: P m = P (Tr m Int) | P2 (m Bool Bool)
-
-:: T a = T2 a Char
-:: NT =: NT Int
-:: SR = {f1 :: Int, f2 :: Bool, f3 :: Tr Either Bool, f4 :: Enum}
-:: R a = {f1 :: ? (R a), f2 :: Bool, f3 :: T a, f4 :: Char -> Int,
-	f5 :: [([#Int], [#Int!], [!Int!], [!Int], [Int!])],
-	f6 :: ({!Int}, {R Bool}, {#Char}, {32#Int}),/*({!Int}, {#Char}, {R Bool})*/
-	f7 :: {!Int}}
-:: Tr m b= Tr (m Int b) | TrBork
-:: Frac a = (/.) infixl 7 a a  | Flurp
-:: Fix f = Fix (f (Fix f))
-
-:: List a = Cons a (List a) | Nil
-
-:: Blurp a = Blurp (List a) | Blorp
-
-:: EnumList = ECons Enum EnumList | ENil
-
-:: ER = {nat :: Int, bool :: Bool}
-:: RA a = {a1 :: a, a2 :: Int}
-:: MR m = {b1 :: m Int}
-
-:: CP = CLeft Int Bool | CRight Char Char
-
-////Start :: [String]
-////Start = foldr (\i c->print i ["\n":c]) [] $ catMaybes $ map gTypeToType $ flattenGType $ unBox t
-//:: Pair a b = Pair a b
-//instance == (Pair a b) | == a where (==) (Pair a1 _) (Pair a2 _) = a1 == a2
-//instance < (Pair a b) | < a where (<) (Pair a1 _) (Pair a2 _) = a1 < a2
-:: Odd a = Odd (Even a) | OddBlurp
-:: Even a = Even (Odd a) | EvenBlurp
-:: Enum = A | B | C
-includes = "#include <stdint.h>\n#include <stdbool.h>\n"
-
-genFiles :: String (Box GType a) *World -> *World | gType{|*|} a
-genFiles bn t w
-//	# tds = map (map gTypeToType) $ map (filter (not o isBasic)) $ flattenGType $ unBox t
-	# tds = map (map gTypeToType) $ flattenGType $ unBox t
-	# (ok, h, w) = fopen (bn <.> "h") FWriteText w
-	| not ok = abort ("Couldn't open: " +++ bn <.> "h")
-	# (ok, c, w) = fopen (bn <.> "c") FWriteText w
-	| not ok = abort ("Couldn't open: " +++ bn <.> "c")
-	# h = h <<< "#ifndef " <<< toUpperCase bn <<< "_H\n"
-		<<< "#define " <<< toUpperCase bn <<< "_H\n"
-		<<< includes
-	# c = c <<< includes
-		<<< "#include <stdlib.h>\n"
-		<<< "#include \"" <<< (bn <.> "h") <<< "\"\n\n"
-	# h = case typedefs tds of
-		Left e = abort ("Couldn't generate typedef: " +++ e)
-		Right d = foldl (<<<) h d
-	# (h, c) = case parsers tds of
-		Left e = abort ("Couldn't generate parser: " +++ e)
-		Right (hd, cd) = (foldl (<<<) h hd, foldl (<<<) c cd)
-	# h = h <<< "\n#endif"
-	# (ok, w) = fclose h w
-	| not ok = abort ("Couldn't close: " +++ bn <.> "h")
-	# (ok, w) = fclose c w
-	| not ok = abort ("Couldn't close: " +++ bn <.> "c")
-	= w
-
-genFilesFlat :: String (Box GType a) *World -> *World | gType{|*|} a
-genFilesFlat bn t w
-	# ty = gTypeToType (unBox t)
-	# (ok, h, w) = fopen (bn <.> "h") FWriteText w
-	| not ok = abort ("Couldn't open: " +++ bn <.> "h")
-	# (ok, c, w) = fopen (bn <.> "c") FWriteText w
-	| not ok = abort ("Couldn't open: " +++ bn <.> "c")
-	# h = h <<< "#ifndef " <<< toUpperCase bn <<< "_H\n"
-		<<< "#define " <<< toUpperCase bn <<< "_H\n"
-		<<< includes
-	# c = c <<< includes
-		<<< "#include \"" <<< (bn <.> "h") <<< "\"\n\n"
-	# h = case flatTypedef ty of
-		Left e = abort ("Couldn't generate typedef: " +++ e)
-		Right d = foldl (<<<) h d
-	# (h, c) = case flatParser ty of
-		Left e = abort ("Couldn't generate parser: " +++ e)
-		Right (hd, cd) = (foldl (<<<) h hd, foldl (<<<) c cd)
-	# h = h <<< "\n#endif"
-	# (ok, w) = fclose h w
-	| not ok = abort ("Couldn't close: " +++ bn <.> "h")
-	# (ok, w) = fclose c w
-	| not ok = abort ("Couldn't close: " +++ bn <.> "c")
-	= w
-
-Start w = foldr ($) w
-	[ genFiles "maybeInt" maybeInt
-	, genFiles "eitherIntChar" eitherIntChar
-	, genFiles "eitherIntMaybeChar" eitherIntMaybeChar
-	, genFiles "cp" cp
-	, genFiles "raint" raInt
-	, genFiles "lmint" lmInt
-	, genFiles "trEitherInt" trEitherInt
-	, genFiles "mrMaybe" mrMaybe
-	, genFiles "pEither" pEither
-	]
-//	( flatTypedef $ gTypeToType $ unBox t
-//	, typedefs $ map (map gTypeToType) $ map (filter (not o isBasic)) $ flattenGType $ unBox t
-//	, flatParser $ gTypeToType $ unBox t
-//	, parsers $ map (map gTypeToType) $ map (filter (not o isBasic)) $ flattenGType $ unBox t
-where
-	maybeInt :: Box GType (?Int)
-	maybeInt = gType{|*|}
-
-	eitherIntChar :: Box GType (Either Int Char)
-	eitherIntChar = gType{|*|}
-
-	eitherIntMaybeChar :: Box GType (Either Int (?Char))
-	eitherIntMaybeChar = gType{|*|}
-
-	cp :: Box GType CP
-	cp = gType{|*|}
-
-	raInt :: Box GType (RA Int)
-	raInt = gType{|*|}
-
-	lmInt :: Box GType [?Int]
-	lmInt = gType{|*|}
-
-	trEitherInt :: Box GType (Tr Either Int)
-	trEitherInt = gType{|*|}
-
-	mrMaybe :: Box GType (MR ?)
-	mrMaybe = gType{|*|}
-
-	pEither :: Box GType (P Either)
-	pEither = gType{|*|}
-
-//Start = typedefs //$ (\x->[[gTypeToType x]])
-//	$ map (/*filter (not o isBuiltin) o*/ catMaybes o map gTypeToType)
-//	$ (\x->[[x]])
-//	$ map (map gTypeToType)
-//	$ map (filter (not o isBasic))
-//	$ flattenGType
-//	$ unBox t
-
-:: Nest m = Nest (m (m (m Int))) | NestBlurp
-
-//t :: Box GType (?# Int)
-//t :: Box GType (Maybe [Maybe (Either Bool String)])
-//t :: Box GType ([SR], Enum, T Int, NT, Blurp Int)
-//t :: Box GType [EnumList]
-t :: Box GType (Nest ?, Tr Either (?(Int, Enum)))
-//t :: Box GType (Odd Int, (), [Either (R (T *World)) (Frac Real)], Tr Either Bool, Fix Maybe)
-t = gType{|*|}