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