gengen/test.icl

   1 module test
   2
   3 import StdEnv, StdGeneric, StdMaybe
   4
   5 import Data.Either, Data.Func
   6
   7 :: Box b a =: Box b
   8 derive bimap Box
   9 unBox (Box b) :== b
  10 box b :== Box b
  11 reBox x :== box (unBox x)
  12
  13 :: GGFuns st a =
  14         { int    :: st -> Either String (Int, st)
  15         , bool   :: st -> Either String (Bool, st)
  16         , real   :: st -> Either String (Real, st)
  17         , char   :: st -> Either String (Char, st)
  18
  19         , unit   :: st -> Either String (UNIT, st)
  20 //      , cons   :: (st -> Either String (a, st)) GenericConsDescriptor st -> Either String (CONS b, st)
  21 //      , field  :: (st -> Either String (a, st)) GenericFieldDescriptor st -> Either String (FIELD b, st)
  22 //      , record :: (st -> Either String (a, st)) GenericRecordDescriptor st -> Either String (RECORD b, st)
  23 //      , object :: (st -> Either String (a, st)) GenericTypeDefDescriptor st -> Either String (OBJECT b, st)
  24 //      , pair   :: (st -> Either String (al, st)) (st -> Either String (br, st)) st -> Either String (PAIR bl br, st)
  25 //      , either :: (st -> Either String (al, st)) (st -> Either String (br, st)) st -> Either String (EITHER bl br, st)
  26         }
  27
  28 ggcast :: (GGFuns st a) -> GGFuns st c
  29 ggcast d = {d & int=d.int}
  30
  31 generic gGeneric a :: (GGFuns st a) st -> Either String (a, st)
  32
  33 gGeneric{|Int|} d st = d.int st
  34 gGeneric{|Bool|} d st = d.bool st
  35 gGeneric{|Real|} d st = d.real st
  36 gGeneric{|Char|} d st = d.char st
  37
  38 gGeneric{|UNIT|} d st = d.unit st
  39 //gGeneric{|CONS of gcd|} f d st = d.cons (f (ggcast d)) gcd st
  40 //gGeneric{|FIELD of gfd|} f d st = d.field (f (ggcast d)) gfd st
  41 //gGeneric{|OBJECT of gtd|} f d st = d.object (f (ggcast d)) gtd st
  42 //gGeneric{|RECORD of grd|} f d st = d.record (f (ggcast d)) grd st
  43 //gGeneric{|PAIR|} fl fr d st = d.pair (fl (ggcast d)) (fr (ggcast d)) st
  44 //gGeneric{|EITHER|} fl fr d st = d.either (fl (ggcast d)) (fr (ggcast d)) st
  45
  46 gDefault :: a | gGeneric{|*|} a
  47 gDefault = fromRight o snd $
  48         { int=basic 0, bool=basic True, real=basic 0.0, char=basic 'a', unit=basic UNIT
  49         }
  50 where
  51         basic c = \_->Right (c, ())
  52
  53 Start = 42