+++ /dev/null
-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
-
-:: 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
- ]
-// ( 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{|*|}
-
-//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{|*|}
repositories / clean-tests.git / blobdiff