old/expruniq/uexpr.icl

   1 module uexpr
   2
   3 import StdEnv
   4
   5 import Data.Functor
   6 import Data.Functor.Identity
   7 import Control.Applicative
   8 import Control.Monad => qualified join
   9 import Control.Monad.State
  10 import Control.Monad.Trans
  11 import Control.Monad.Writer
  12 import Data.Array
  13 import Data.Func
  14 import Data.List
  15 import Text
  16
  17 :: In a b = In infix 0 a b
  18
  19 class uexpr v where
  20         lit :: a -> v a | toString a
  21         (+.) infixl 6 :: (v a) (v a) -> v a | + a
  22
  23 class uvar v w where
  24         var :: (.(v .a) -> .(In .(v .a) (w b))) -> w b
  25
  26 class uarr v where
  27         arr :: *(arr a) -> *v *(arr a) | Array arr a & toString a
  28         (++.) infixr 5 :: *(v *(arr a)) *(v *(arr a)) -> *v *(arr a) | Array arr a
  29         (!.)  infixl 8 :: .(v .(arr a)) .(v Int) -> .v a | Array arr a
  30         (=.)  infixl 8 :: (v .(arr a)) (v Int, v a) -> (v .(arr a)) | Array arr a
  31
  32 :: Printer a = P (WriterT [String] (StateT Int Identity) ())
  33 runPrinter (P a) = concat $ snd $ evalState (runWriterT a) 0
  34 instance uexpr Printer where
  35         lit a = P $ tell [toString a]
  36         +. (P l) (P r) = P $ tell ["("] >>| l >>| tell ["+"] >>| r >>| tell [")"]
  37
  38 instance uvar Printer Printer where
  39         var def = P (
  40                         liftT (getState)
  41                 >>= \s->liftT (put (s+1))
  42                 >>| let (P i In P b) = def $ P $ tell $ varName s []
  43                     in  tell ["let ":varName s [" = "]] >>| i >>| tell [" in\n"] >>| b
  44                 )
  45         where
  46                 varName i c = ["v",toString i:c]
  47
  48 instance uarr Printer where
  49         arr a = P $ tell ["{",join "," [toString a\\a<-:a],"}"]
  50         ++. (P l) (P r) = P $ tell ["("] >>| l >>| tell ["+++"] >>| r >>| tell [")"]
  51         !.  (P a) (P i) = P $ a >>| tell [".["] >>| i >>| tell ["]"]
  52         =.  (P a) (P idx, P el) = P $ a >>| tell ["&"] >>| idx >>| tell ["="] >>| el
  53
  54 :: Eval a = E a
  55 runEval (E a) = a
  56 instance uexpr Eval where
  57         lit a = E $ a
  58         +. (E l) (E r) = E $ l + r
  59
  60 instance uvar Eval Eval where
  61         var def = let (i In b) = def i in b
  62
  63 instance uarr Eval where
  64         arr a = E a
  65         ++. (E l) (E r) = E (appendArr l r)
  66         !.  (E a) (E i) = E (select a i)
  67         =.  (E a) (E idx, E el) = undef//E (update a idx el)
  68
  69 runBoth (Both l r) = (runPrinter l, runEval r)
  70
  71 //Start = both (var \v=arr {!1,2,3} In v ++. arr {!4,5,6})
  72 //Start = runPrinter (var \v=arr {!1,2,3} In v ++. arr {!4,5,6})
  73 Start =
  74         ( "\n"
  75 //      , runPrinter $ var \v=arr {!1,2,3} In v ++. v ?. lit 0 =. lit 42
  76         , "\n"
  77 //      , runEval $ var \v=arr {!1,2,3} In v ++. v ?. lit 0 =. lit 42
  78         , "\n"
  79         , runPrinter $ var \v=arr {!1,2,3} In v ++. arr {!4,5,65}
  80         , "\n"
  81         , runPrinter $ var \v=arr {!1,2,3} In v ++. arr {!4,5,6}
  82         , "\n"
  83         , runEval $ var \v=arr {!1,2,3} In arr {!4,5,6} ++. v
  84         , "\n"
  85         , runPrinter $ var \v=arr {!1,2,3} In arr {!4,5,6} ++. v
  86         )
  87
  88 //i :: v Int | uexpr v
  89 //i = lit 41 +. lit 1
  90 //
  91 //ai :: v {Int} | uexpr, uarr v
  92 //ai = arr {1,2,3}
  93 //
  94 //aip :: v {Int} | uexpr, uarr v
  95 //aip = arr {1,2,3} ++. arr {4,5,6}
  96 //
  97 //aii :: v Int | uexpr, uarr v
  98 //aii = ai !. lit 41
  99 //
 100 //somearray :: *{Int}
 101 //somearray = {1,2,3}