old/expruniq/shallow.icl

   1 module shallow
   2
   3 import StdEnv
   4
   5 import Data.Array
   6 import Data.Maybe
   7
   8 :: In a b = In infix 0 a b
   9
  10 (<$>) infixl 4
  11 (<$>) f Nothing = Nothing
  12 (<$>) f (Just a) = Just (f a)
  13
  14 pure a = Just a
  15
  16 (<*>) infixl 4
  17 (<*>) Nothing _ = Nothing
  18 (<*>) (Just f) ma = f <$> ma
  19
  20 (>>=) infixl 1
  21 (>>=) (Just x) k = k x
  22 (>>=) _ _ = Nothing
  23
  24 var :: ((Maybe a) -> In a (Maybe b)) -> Maybe b
  25 var def = let (i In b) = def (pure i) in b
  26
  27 lit :: .a -> Maybe .a
  28 lit a = pure a
  29
  30 (+.) infixl 6 :: (Maybe a) (Maybe a) -> Maybe a | + a
  31 (+.) l r = (+) <$> l <*> r
  32
  33 (++.) infixr 5 :: (Maybe (arr a)) (Maybe (arr a)) -> Maybe (arr a) | Array arr a
  34 (++.) l r = appendArr <$> l <*> r
  35
  36 (!.) infixl 8 :: (Maybe (arr a)) (Maybe Int) -> Maybe a | Array arr a
  37 (!.) a i = a >>= \a->i >>= \i->if (i < 0 || i >= size a) Nothing (Just a.[i])
  38
  39 (=.) infixl 9 :: (Maybe *(arr a)) (Maybe Int, Maybe a) -> (Maybe *(arr a)) | Array arr a
  40 (=.) a (i, e) = a >>= \a->i >>= \i->if (i < 0 || i >= size a) Nothing (update a i <$> e)
  41
  42 //Start = both (var \v=arr {!1,2,3} In v ++. arr {!4,5,6})
  43 //Start = runPrinter (var \v=arr {!1,2,3} In v ++. arr {!4,5,6})
  44 Start =
  45         ( "\n"
  46 //      , var \v={!1,2,3} In v ++. v =. (lit 0, lit 42)
  47         , "\n"
  48         , var \v={!1,2,3} In v ++. lit {!4,5,6} =. (lit 0, lit 42)
  49         , "\n"
  50         , var \v={!1,2,3} In v ++. lit {!4,5,65}
  51         , "\n"
  52         , var \v={!1,2,3} In lit {!4,5,6} ++. v
  53         , "\n"
  54 //      , runMaybe (var \up0=(\a->a =. (lit 0, lit 0)) In up0 (lit {!4,5,6}))
  55         )