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 where
  24         var :: (u:(v .a) -> v:(In u:(v .a) u:(v b))) -> u:(v b), [v <= u]
  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 9 :: (v .(arr a)) (v Int) -> v a | Array arr a
  30
  31 :: Printer a = P (WriterT [String] (StateT Int Identity) ())
  32 runPrinter (P a) = concat $ snd $ evalState (runWriterT a) 0
  33 instance uexpr Printer where
  34         lit a = P $ tell [toString a]
  35         +. (P l) (P r) = P $ tell ["("] >>| l >>| tell ["+"] >>| r >>| tell [")"]
  36
  37 instance uvar Printer where
  38         var def = P (
  39                         liftT (getState)
  40                 >>= \s->liftT (put (s+1))
  41                 >>| let (P i In P b) = def $ P $ tell $ varName s []
  42                     in  tell ["let ":varName s [" = "]] >>| i >>| tell [" in\n"] >>| b
  43                 )
  44         where
  45                 varName i c = ["v",toString i:c]
  46
  47 instance uarr Printer where
  48         arr a = P $ tell ["{",join "," [toString a\\a<-:a],"}"]
  49         ++. (P l) (P r) = P $ tell ["("] >>| l >>| tell ["+++"] >>| r >>| tell [")"]
  50         !. (P l) (P r) = P $ l >>| tell [".["] >>| r >>| tell ["]"]
  51
  52 :: Eval a = E a
  53 runEval (E a) = a
  54 instance uexpr Eval where
  55         lit a = E $ pure a
  56         +. (E l) (E r) = E $ l + r
  57
  58 //instance uvar Eval where
  59 //      var def = let (i In b) = def i in b
  60
  61 instance uarr Eval where
  62         arr a = E a
  63         ++. (E l) (E r) = E (appendArr l r)
  64         !. (E l) (E r) = E (select l r)
  65
  66 appendArr :: .(arr a) .(arr a) -> .arr a | Array arr a
  67 appendArr l r = {if (i < size l) l.[i] r.[i rem size l]\\i<-[0..size l + size r - 1]}
  68
  69 //Start = both (var \v=arr {!1,2,3} In v ++. arr {!4,5,6})
  70 Start = runPrinter (var \v=arr {!1,2,3} In v ++. arr {!4,5,6})
  71
  72 //both :: (A.v: v a | uexpr, uarr, uvar v) -> (String, a)
  73 //both f = (runPrinter f, runEval f)
  74
  75 //i :: v Int | uexpr v
  76 //i = lit 41 +. lit 1
  77 //
  78 //ai :: v {Int} | uexpr, uarr v
  79 //ai = arr {1,2,3}
  80 //
  81 //aip :: v {Int} | uexpr, uarr v
  82 //aip = arr {1,2,3} ++. arr {4,5,6}
  83 //
  84 //aii :: v Int | uexpr, uarr v
  85 //aii = ai !. lit 41
  86 //
  87 //somearray :: *{Int}
  88 //somearray = {1,2,3}