- sf '~' = "Tld"
- sf '@' = "At"
- sf '#' = "Hsh"
- sf '$' = "Dlr"
- sf '%' = "Prc"
- sf '^' = "Hat"
- sf '?' = "Qtn"
- sf '!' = "Bng"
- sf ':' = "Cln"
- sf '+' = "Pls"
- sf '-' = "Min"
- sf '*' = "Ast"
- sf '<' = "Les"
- sf '>' = "Gre"
- sf '\\' = "Bsl"
- sf '/' = "Slh"
- sf '|' = "Pip"
- sf '&' = "Amp"
- sf '=' = "Eq"
- sf '.' = "Dot"
- sf c = toString c
-
-pre :: [String] (m [String]) -> m [String] | Monad m
-pre t s = ((++)t) <$> s
-
-post :: [String] [String] -> m [String] | pure m
-post t s = pure (s ++ t)
-
-header t c = pre ["// ", toString (replaceBuiltins t), "\n":c]
-
-typedef :: Type -> TDMonad
-typedef (TyRef s) = printTypeName s
-typedef (TyBasic t) = case t of
- BTInt = printTypeName "int64_t"
- BTChar = printTypeName "char"
- BTReal = printTypeName "double"
- BTBool = printTypeName "bool"
- t = pure []//liftT $ Left $ "basic type: " +++ toString t +++ " not implemented"
-typedef (TyArray _ a) = pre ["*"] $ typedef a
-typedef t=:(TyNewType ti ci a)
- = header t [] $ tydef ti.gtd_name ci.gcd_type
-typedef t=:(TyRecord ti fs) = header t ["struct ", safe ti.grd_name, " {\n"]
- $ fmtFields 1 ti.grd_type [fi.gfd_name\\(fi, _)<-fs] >>= post ["};\n"]
-//Enumeration
-typedef t=:(TyObject ti fs)
- | and [t =: [] \\ (_, t)<-fs] = header t
- ["enum ", safe ti.gtd_name, " {"
- , join ", " [safe ci.gcd_name\\(ci, _)<-fs], "};\n"] $ pure []
-//Single constructor, single field (box)
-typedef t=:(TyObject ti [(ci, [ty])]) = header t [] $ tydef ti.gtd_name ci.gcd_type
-//Single constructor
-typedef t=:(TyObject ti [(ci, ts)]) = header t ["struct ", safe ti.gtd_name, " {\n"]
- $ fmtFields 1 ci.gcd_type ["f" +++ toString i\\i<-indexList ts] >>= post ["};\n"]
-//Complex adt
-typedef t=:(TyObject ti fs) = header t
- ["struct ", safe ti.gtd_name, " {\n"
+ typedefgroup :: [Type] -> TDMonad
+ typedefgroup ts
+ = flatten
+ <$ modify ('Data.Map'.putList [(typeName ty, (prefix ty, True))\\ty<-ts])
+ <*> mapM (\t->typedef t >>= post ["\n"]) ts
+ <* modify (flip (foldr $ 'Data.Map'.alter (fmap (fmap \_->False)) o typeName) ts)
+ >>= \c->case ts of
+ [_] = pure c
+ ts = mapM (\x->printTypeName x >>= post [";\n"]) (map typeName ts)
+ >>= post c o flatten
+ where
+ prefix :: Type -> String
+ prefix (TyRecord _ _) = "struct "
+ prefix (TyObject _ fs)
+ | and [t =: [] \\ (_, t)<-fs] = "enum "
+ | fs =: [(_, [_])] = ""
+ | fs =: [_] = "struct "
+ = "struct "
+ prefix _ = ""
+
+ printTypeName :: String -> TDMonad
+ printTypeName tname
+ = gets $ maybe [safe tname, " "] (\(p, b)->[p, safe tname, if b " *" " "]) o 'Data.Map'.get tname
+
+ pre :: [String] (m [String]) -> m [String] | Monad m
+ pre t s = ((++)t) <$> s
+
+ post :: [String] [String] -> m [String] | pure m
+ post t s = pure (s ++ t)
+
+ header t c = pre ["// ", toString (replaceBuiltins t), "\n":c]
+
+ typedef :: Type -> TDMonad
+ typedef (TyRef s) = printTypeName s
+ typedef (TyBasic t) = case t of
+ BTInt = printTypeName "int64_t"
+ BTChar = printTypeName "char"
+ BTReal = printTypeName "double"
+ BTBool = printTypeName "bool"
+ t = pure []//liftT $ Left $ "basic type: " +++ toString t +++ " not implemented"
+ typedef (TyArray _ a) = pre ["*"] $ typedef a
+ typedef t=:(TyNewType ti ci a)
+ = header t [] $ tydef ti.gtd_name ci.gcd_type
+ typedef t=:(TyRecord ti fs) = header t ["struct ", safe ti.grd_name, " {\n"]
+ $ fmtFields 1 ti.grd_type [fi.gfd_name\\(fi, _)<-fs] >>= post ["};\n"]
+ //Enumeration
+ typedef t=:(TyObject ti fs)
+ | and [t =: [] \\ (_, t)<-fs] = header t
+ ["enum ", safe ti.gtd_name, " {"
+ , join ", " [safe ci.gcd_name\\(ci, _)<-fs], "};\n"] $ pure []
+ //Single constructor, single field (box)
+ typedef t=:(TyObject ti [(ci, [ty])]) = header t [] $ tydef ti.gtd_name ci.gcd_type
+ //Single constructor
+ typedef t=:(TyObject ti [(ci, ts)]) = header t ["struct ", safe ti.gtd_name, " {\n"]
+ $ fmtFields 1 ci.gcd_type ["f" +++ toString i\\i<-indexList ts] >>= post ["};\n"]
+ //Complex adt
+ typedef t=:(TyObject ti fs) = header t
+ ["struct ", safe ti.gtd_name, " {\n"