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