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         # (ok, h, w) = fopen (bn <.> "h") FWriteText w
  58         | not ok = abort ("Couldn't open: " +++ bn <.> "h")
  59         # (ok, c, w) = fopen (bn <.> "c") FWriteText w
  60         | not ok = abort ("Couldn't open: " +++ bn <.> "c")
  61         # h = h <<< "#ifndef " <<< toUpperCase bn <<< "_H\n"
  62                 <<< "#define " <<< toUpperCase bn <<< "_H\n"
  63                 <<< includes
  64         # c = c <<< includes
  65                 <<< "#include \"" <<< (bn <.> "h") <<< "\"\n"
  66         # h = case typedefs tds of
  67                 Left e = abort ("Couldn't generate typedef: " +++ e)
  68                 Right d = foldl (<<<) h d
  69         # (h, c) = case parsers tds of
  70                 Left e = abort ("Couldn't generate parser: " +++ e)
  71                 Right (hd, cd) = (foldl (<<<) h hd, foldl (<<<) c cd)
  72         # h = h <<< "\n#endif"
  73         # (ok, w) = fclose h w
  74         | not ok = abort ("Couldn't close: " +++ bn <.> "h")
  75         # (ok, w) = fclose c w
  76         | not ok = abort ("Couldn't close: " +++ bn <.> "c")
  77         = w
  78
  79 genFilesFlat :: String (Box GType a) *World -> *World | gType{|*|} a
  80 genFilesFlat bn t w
  81         # ty = gTypeToType (unBox t)
  82         # (ok, h, w) = fopen (bn <.> "h") FWriteText w
  83         | not ok = abort ("Couldn't open: " +++ bn <.> "h")
  84         # (ok, c, w) = fopen (bn <.> "c") FWriteText w
  85         | not ok = abort ("Couldn't open: " +++ bn <.> "c")
  86         # h = h <<< "#ifndef " <<< toUpperCase bn <<< "_H\n"
  87                 <<< "#define " <<< toUpperCase bn <<< "_H\n"
  88                 <<< includes
  89         # c = c <<< includes
  90                 <<< "#include \"" <<< (bn <.> "h") <<< "\"\n"
  91         # h = case flatTypedef ty of
  92                 Left e = abort ("Couldn't generate typedef: " +++ e)
  93                 Right d = foldl (<<<) h d
  94         # (h, c) = case flatParser ty of
  95                 Left e = abort ("Couldn't generate parser: " +++ e)
  96                 Right (hd, cd) = (foldl (<<<) h hd, foldl (<<<) c cd)
  97         # h = h <<< "\n#endif"
  98         # (ok, w) = fclose h w
  99         | not ok = abort ("Couldn't close: " +++ bn <.> "h")
 100         # (ok, w) = fclose c w
 101         | not ok = abort ("Couldn't close: " +++ bn <.> "c")
 102         = w
 103
 104 Start w = foldr ($) w
 105         [ genFiles "maybeInt" maybeInt
 106         , genFiles "eitherIntChar" eitherIntChar
 107         , genFiles "eitherIntMaybeChar" eitherIntMaybeChar
 108         ]
 109 //      ( flatTypedef $ gTypeToType $ unBox t
 110 //      , typedefs $ map (map gTypeToType) $ map (filter (not o isBasic)) $ flattenGType $ unBox t
 111 //      , flatParser $ gTypeToType $ unBox t
 112 //      , parsers $ map (map gTypeToType) $ map (filter (not o isBasic)) $ flattenGType $ unBox t
 113 where
 114         maybeInt :: Box GType (?Int)
 115         maybeInt = gType{|*|}
 116
 117         eitherIntChar :: Box GType (Either Int Char)
 118         eitherIntChar = gType{|*|}
 119
 120         eitherIntMaybeChar :: Box GType (Either Int (?Char))
 121         eitherIntMaybeChar = gType{|*|}
 122
 123 //Start = typedefs //$ (\x->[[gTypeToType x]])
 124 //      $ map (/*filter (not o isBuiltin) o*/ catMaybes o map gTypeToType)
 125 //      $ (\x->[[x]])
 126 //      $ map (map gTypeToType)
 127 //      $ map (filter (not o isBasic))
 128 //      $ flattenGType
 129 //      $ unBox t
 130
 131 :: Nest m = Nest (m (m (m Int))) | NestBlurp
 132
 133 //t :: Box GType (?# Int)
 134 //t :: Box GType (Maybe [Maybe (Either Bool String)])
 135 //t :: Box GType ([SR], Enum, T Int, NT, Blurp Int)
 136 //t :: Box GType [EnumList]
 137 t :: Box GType (Nest ?, Tr Either (?(Int, Enum)))
 138 //t :: Box GType (Odd Int, (), [Either (R (T *World)) (Frac Real)], Tr Either Bool, Fix Maybe)
 139 t = gType{|*|}