gengen/test.icl

   1 module test
   2
   3 import StdEnv, StdGeneric
   4
   5 import Data.Func
   6 import Data.Functor
   7 import Data.List
   8 import Data.Tuple
   9 import Data.Bifunctor
  10 import Data.Maybe
  11 import Control.GenBimap
  12 import Data.Either
  13 import System.FilePath
  14
  15 import Data.GenType
  16 import Data.GenType.CType
  17 import Data.GenType.CParser
  18 import Text
  19
  20 derive gType Either, T, R, Frac, Tr, Fix, Odd, Even, SR, List, Enum, NT, Blurp, EnumList, ER, CP, RA, Nest, MR, P
  21
  22 :: P m = P (Tr m Int) | P2 (m Bool Bool)
  23
  24 :: T a = T2 a Char
  25 :: NT =: NT Int
  26 :: SR = {f1 :: Int, f2 :: Bool, f3 :: Tr Either Bool, f4 :: Enum}
  27 :: R a = {f1 :: ? (R a), f2 :: Bool, f3 :: T a, f4 :: Char -> Int,
  28         f5 :: [([#Int], [#Int!], [!Int!], [!Int], [Int!])],
  29         f6 :: ({!Int}, {R Bool}, {#Char}, {32#Int}),/*({!Int}, {#Char}, {R Bool})*/
  30         f7 :: {!Int}}
  31 :: Tr m b= Tr (m Int b) | TrBork
  32 :: Frac a = (/.) infixl 7 a a  | Flurp
  33 :: Fix f = Fix (f (Fix f))
  34
  35 :: List a = Cons a (List a) | Nil
  36
  37 :: Blurp a = Blurp (List a) | Blorp
  38
  39 :: EnumList = ECons Enum EnumList | ENil
  40
  41 :: ER = {nat :: Int, bool :: Bool}
  42 :: RA a = {a1 :: a, a2 :: Int}
  43 :: MR m = {b1 :: m Int}
  44
  45 :: CP = CLeft Int Bool | CRight Char Char
  46
  47 ////Start :: [String]
  48 ////Start = foldr (\i c->print i ["\n":c]) [] $ catMaybes $ map gTypeToType $ flattenGType $ unBox t
  49 //:: Pair a b = Pair a b
  50 //instance == (Pair a b) | == a where (==) (Pair a1 _) (Pair a2 _) = a1 == a2
  51 //instance < (Pair a b) | < a where (<) (Pair a1 _) (Pair a2 _) = a1 < a2
  52 :: Odd a = Odd (Even a) | OddBlurp
  53 :: Even a = Even (Odd a) | EvenBlurp
  54 :: Enum = A | B | C
  55 includes = "#include <stdint.h>\n#include <stdbool.h>\n"
  56
  57 genFiles :: String (Box GType a) *World -> *World | gType{|*|} a
  58 genFiles bn t w
  59 //      # tds = map (map gTypeToType) $ map (filter (not o isBasic)) $ flattenGType $ unBox t
  60         # tds = map (map gTypeToType) $ flattenGType $ unBox t
  61         # (ok, h, w) = fopen (bn <.> "h") FWriteText w
  62         | not ok = abort ("Couldn't open: " +++ bn <.> "h")
  63         # (ok, c, w) = fopen (bn <.> "c") FWriteText w
  64         | not ok = abort ("Couldn't open: " +++ bn <.> "c")
  65         # h = h <<< "#ifndef " <<< toUpperCase bn <<< "_H\n"
  66                 <<< "#define " <<< toUpperCase bn <<< "_H\n"
  67                 <<< includes
  68         # c = c <<< includes
  69                 <<< "#include <stdlib.h>\n"
  70                 <<< "#include \"" <<< (bn <.> "h") <<< "\"\n\n"
  71         # h = case typedefs tds of
  72                 Left e = abort ("Couldn't generate typedef: " +++ e)
  73                 Right d = foldl (<<<) h d
  74         # (h, c) = case parsers tds of
  75                 Left e = abort ("Couldn't generate parser: " +++ e)
  76                 Right (hd, cd) = (foldl (<<<) h hd, foldl (<<<) c cd)
  77         # h = h <<< "\n#endif"
  78         # (ok, w) = fclose h w
  79         | not ok = abort ("Couldn't close: " +++ bn <.> "h")
  80         # (ok, w) = fclose c w
  81         | not ok = abort ("Couldn't close: " +++ bn <.> "c")
  82         = w
  83
  84 genFilesFlat :: String (Box GType a) *World -> *World | gType{|*|} a
  85 genFilesFlat bn t w
  86         # ty = gTypeToType (unBox t)
  87         # (ok, h, w) = fopen (bn <.> "h") FWriteText w
  88         | not ok = abort ("Couldn't open: " +++ bn <.> "h")
  89         # (ok, c, w) = fopen (bn <.> "c") FWriteText w
  90         | not ok = abort ("Couldn't open: " +++ bn <.> "c")
  91         # h = h <<< "#ifndef " <<< toUpperCase bn <<< "_H\n"
  92                 <<< "#define " <<< toUpperCase bn <<< "_H\n"
  93                 <<< includes
  94         # c = c <<< includes
  95                 <<< "#include \"" <<< (bn <.> "h") <<< "\"\n\n"
  96         # h = case flatTypedef ty of
  97                 Left e = abort ("Couldn't generate typedef: " +++ e)
  98                 Right d = foldl (<<<) h d
  99         # (h, c) = case flatParser ty of
 100                 Left e = abort ("Couldn't generate parser: " +++ e)
 101                 Right (hd, cd) = (foldl (<<<) h hd, foldl (<<<) c cd)
 102         # h = h <<< "\n#endif"
 103         # (ok, w) = fclose h w
 104         | not ok = abort ("Couldn't close: " +++ bn <.> "h")
 105         # (ok, w) = fclose c w
 106         | not ok = abort ("Couldn't close: " +++ bn <.> "c")
 107         = w
 108
 109 Start w = foldr ($) w
 110         [ genFiles "maybeInt" maybeInt
 111         , genFiles "eitherIntChar" eitherIntChar
 112         , genFiles "eitherIntMaybeChar" eitherIntMaybeChar
 113         , genFiles "cp" cp
 114         , genFiles "raint" raInt
 115         , genFiles "lmint" lmInt
 116         , genFiles "trEitherInt" trEitherInt
 117         , genFiles "mrMaybe" mrMaybe
 118         , genFiles "pEither" pEither
 119         ]
 120 //      ( flatTypedef $ gTypeToType $ unBox t
 121 //      , typedefs $ map (map gTypeToType) $ map (filter (not o isBasic)) $ flattenGType $ unBox t
 122 //      , flatParser $ gTypeToType $ unBox t
 123 //      , parsers $ map (map gTypeToType) $ map (filter (not o isBasic)) $ flattenGType $ unBox t
 124 where
 125         maybeInt :: Box GType (?Int)
 126         maybeInt = gType{|*|}
 127
 128         eitherIntChar :: Box GType (Either Int Char)
 129         eitherIntChar = gType{|*|}
 130
 131         eitherIntMaybeChar :: Box GType (Either Int (?Char))
 132         eitherIntMaybeChar = gType{|*|}
 133
 134         cp :: Box GType CP
 135         cp = gType{|*|}
 136
 137         raInt :: Box GType (RA Int)
 138         raInt = gType{|*|}
 139
 140         lmInt :: Box GType [?Int]
 141         lmInt = gType{|*|}
 142
 143         trEitherInt :: Box GType (Tr Either Int)
 144         trEitherInt = gType{|*|}
 145
 146         mrMaybe :: Box GType (MR ?)
 147         mrMaybe = gType{|*|}
 148
 149         pEither :: Box GType (P Either)
 150         pEither = gType{|*|}
 151
 152 //Start = typedefs //$ (\x->[[gTypeToType x]])
 153 //      $ map (/*filter (not o isBuiltin) o*/ catMaybes o map gTypeToType)
 154 //      $ (\x->[[x]])
 155 //      $ map (map gTypeToType)
 156 //      $ map (filter (not o isBasic))
 157 //      $ flattenGType
 158 //      $ unBox t
 159
 160 :: Nest m = Nest (m (m (m Int))) | NestBlurp
 161
 162 //t :: Box GType (?# Int)
 163 //t :: Box GType (Maybe [Maybe (Either Bool String)])
 164 //t :: Box GType ([SR], Enum, T Int, NT, Blurp Int)
 165 //t :: Box GType [EnumList]
 166 t :: Box GType (Nest ?, Tr Either (?(Int, Enum)))
 167 //t :: Box GType (Odd Int, (), [Either (R (T *World)) (Frac Real)], Tr Either Bool, Fix Maybe)
 168 t = gType{|*|}