+implementation module Data.GenC
+
+import StdEnv
+import StdGeneric
+import StdDebug
+
+import Data.Map => qualified updateAt
+import Data.Func
+
+import Text
+import Debug.Trace
+
+//derive class gGenerateC (),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
+
+derive bimap Structmaker, Box
+
+toEnumValue :: GenericConsDescriptor -> String
+toEnumValue gcd = gcd.gcd_type_def.gtd_name +++ "_" +++ gcd.gcd_name
+
+toEnumType :: GenericTypeDefDescriptor -> String
+toEnumType gtd = "enum cleanc_" +++ gtd.gtd_name
+
+class toStructType a :: a -> String
+instance toStructType GenericTypeDefDescriptor where
+ toStructType gtd = "struct clean_" +++ gtd.gtd_name
+instance toStructType GenericRecordDescriptor where
+ toStructType grd = "struct clean_" +++ grd.grd_name
+
+:: CInfo a = {header :: String , toValue :: a -> String}
+
+runStructMaker :: (Structmaker a) -> String
+runStructMaker (SM t)
+# {defs,imps} = snd $ t {dict=newMap,fresh=0,inRecord=False} []
+= end (elems defs) +++ end imps
+where
+ end d = concat [d +++ ";\n"\\d<-d]
+
+generic gToCType a | gPotentialInf a :: Structmaker a
+derive gToCType [], [! ], [ !], [!!]
+derive gToCType (),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
+:: Structmaker a = SM (SMInput [String] -> ([String], SMOutput)) | Onzinconstructor a
+runSM (SM a) = a
+:: SMInput =
+ { fresh :: Int
+ , inRecord :: Bool
+ , dict :: Map String String
+ }
+:: SMOutput =
+ { defs :: Map String String
+ , imps :: [String]
+ }
+
+instance + SMOutput where + a b = {defs=union a.defs b.defs, imps=a.imps++b.imps}
+instance zero SMOutput where zero = {defs=newMap, imps=[]}
+
+show :: String -> Structmaker a
+show str = SM \st c->([str:c], zero)
+
+gToCType{|Char|} = show "char"
+gToCType{|Int|} = show "uint64_t"
+gToCType{|Real|} = show "double"
+gToCType{|Bool|} = show "bool"
+gToCType{|UNIT|} = SM \st c->(c, zero)
+gToCType{|EITHER|} fl il fr ir = SM \st c
+ # (c, oa) = runSM fl st c
+ # (c, ob) = runSM fr {st & dict=union st.dict oa.defs} c
+ = (c, oa + ob)
+gToCType{|PAIR|} fl il fr ir
+ = SM \st c
+ # (c, oa) = runSM fr st c
+ # st & dict = union st.dict oa.defs
+ # (c, ob) = if st.inRecord
+ (runSM fl st c)
+ (runSM fl {st & fresh=st.fresh+1} [" f", toString st.fresh, ";\n":c])
+ = (c, oa + ob)
+gToCType{|OBJECT of gtd|} f i
+ //Newtype
+ | gtd.gtd_num_conses == 0
+ = SM $ runSM f
+ = SM \st c->case get gtd.gtd_name st.dict of
+ Just n = ([n:c], zero)
+ Nothing
+ //Generate the enumeration if necessary
+ # box = gtd.gtd_num_conses == 1
+ # enums = \c->if box c
+ [concat [toEnumType gtd, " {", join ", " (map toEnumValue gtd.gtd_conses), "}"]:c]
+ //If it is just an enumeration, Just an enumeration
+ | and [gcd.gcd_arity == 0\\gcd<-gtd.gtd_conses]
+ = ( [toEnumType gtd:c]
+ , {defs=singleton gtd.gtd_name $ toEnumType gtd,imps=enums []}
+ )
+ //Only one constructor
+ # defs = singleton gtd.gtd_name (toStructType gtd +++ " *")
+ # (c`, o) = runSM f {st & dict=union defs st.dict} (if box [] ["} data;\n}"])
+ # obj = concat [toStructType gtd, "{\n":if box c` [toEnumType gtd, " cons;\nunion {\n":c`]]
+ = ([toStructType gtd:if (isInfinite i) c [" *":c]], {defs=union o.defs defs, imps=enums [obj:o.imps]})
+gToCType{|CONS of gcd|} f i
+ //No data field
+ | gcd.gcd_arity == 0 = SM \st c->(c, zero)
+ //Only one data field
+ | gcd.gcd_arity == 1 = SM \st c->runSM f st [" ", gcd.gcd_name, ";\n":c]
+ //Multiple data fields
+ = SM \st c
+ # (c, o) = runSM f st [" f", toString (gcd.gcd_arity - 1), ";\n} ", gcd.gcd_name, ";\n":c]
+ = (["struct {\n":c], o)
+gToCType{|RECORD of grd|} f i
+ = SM \st c
+ # grd = trace_stdout grd
+ # defs = singleton grd.grd_name (toStructType grd)
+ # (c`, o) = runSM f {st & inRecord=True,dict=union defs st.dict} ["}"]
+ # obj = concat [toStructType grd, " {\n":c`]
+ = ([toStructType grd:c], {defs=union defs o.defs, imps=[obj:o.imps]})
+gToCType{|FIELD of gfd|} f i
+ = SM \s c->runSM f s [" ", gfd.gfd_name,";\n":c]
+gToCType{|{}|} f i = SM \s c->runSM f s ["*":c]
+gToCType{|{!}|} f i = SM \s c->runSM f s ["*":c]
+gToCType{|{#}|} f i = SM \s c->runSM f s ["*":c]
+
+unBox (Box b) :== b
+box b :== Box b
+
+isInfinite :: ([String] -> Box Bool a) -> Bool
+isInfinite f = unBox (f [])
+
+generic gPotentialInf a :: [String] -> Box Bool a
+derive gPotentialInf [], [! ], [ !], [!!]
+derive gPotentialInf (),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
+gPotentialInf{|World|} _ = box False
+gPotentialInf{|File|} _ = box False
+gPotentialInf{|Bool|} _ = box False
+gPotentialInf{|Char|} _ = box False
+gPotentialInf{|Real|} _ = box False
+gPotentialInf{|Int|} _ = box False
+gPotentialInf{|Dynamic|} _ = box False
+gPotentialInf{|(->)|} _ _ _ = box False
+gPotentialInf{|{}|} a m = box (unBox (a m))
+gPotentialInf{|{!}|} a m = box (unBox (a m))
+gPotentialInf{|{#}|} a m = box (unBox (a m))
+gPotentialInf{|UNIT|} _ = box False
+gPotentialInf{|EITHER|} l r m = box (unBox (l m) || unBox (r m))
+gPotentialInf{|PAIR|} l r m = box (unBox (l m) || unBox (r m))
+gPotentialInf{|CONS|} x m = box (unBox (x m))
+gPotentialInf{|FIELD|} x m = box (unBox (x m))
+gPotentialInf{|RECORD of {grd_name}|} x m
+ | isMember grd_name m = box True
+ = box (unBox (x [grd_name:m]))
+gPotentialInf{|OBJECT of {gtd_name}|} x m
+ | isMember gtd_name m = box True
+ = box (unBox (x [gtd_name:m]))