HaRe-0.6: tools/interp/examples.hs
--------------------------------------------------------------------
--- Haskell Weirdness.
--------------------------------------------------------------------
data RedBlack a = Red a | Black a
data OneTwo a b = One a | Two a b
instance Show a => Show (RedBlack a) where
show = \ x -> case x of
Red v -> show v
Black v -> show v
omega :: Int -> (Int,Int)
omega = \x -> if True then (omega x) else (omega x)
h0 = (\ (Red x) -> 1) (Black 99)
h1 = (\ (Red (Black x)) -> 1) (Red undefined)
h2 = (\ (Red (Two x (Black y))) -> 1) (Red (Two 1 (Black 9)))
h3 = (\ (Red (Two x (Black y))) -> 1) (Red (Two undefined (Black undefined)))
h4 :: Int
h4 = (\ (Red (Two x (Black y))) -> x) (Red (Two undefined (Black undefined)))
ex1 = case undefined of 1 -> 99 ---> undefined
ex2 = case undefined of x -> 99 ---> 99
ex3 = case undefined of (x,y) -> 99 ---> undefined
ex4 = case undefined of (Red x) -> 99 ---> undefined
-----------------------------------------------------------
-- some examples
-----------------------------------------------------------
redpat = \ x -> Pcondata "red" [(Pvar x)]
greenpat = \ x -> Pcondata "green" [(Pvar x)]
blackpat = \ x -> Pcondata "black" [(Pvar x)]
blackexp = \t -> ConApp "black" [t]
redexp = \t -> ConApp "red" [t]
greenexp = \t -> ConApp "green" [t]
pairpat = Ppair (Pvar "x") (Pvar "y")
black = \ x -> ConApp "black" [x]
red = \ x -> ConApp "red" [x]
green = \ x -> ConApp "green" [x]
--------------------------------------------------
dpat = \ x -> Pcondata "D" [(Pvar x)]
d1 = App (Abs (dpat "i") (Const 42)) Boom
--- run d1 ==> non-termination
d2 = ConApp "D" [Boom]
--- run d2 ==> "(D..." + non-termination
npat = \ x -> Pnewdata "N" (Pvar x)
n1 = App (Abs (npat "i") (Const 42)) Boom
--- run n1 ==> 42 (i.e., 'Abs (npat "i") e' behaves like 'Abs "i" e'
n2 = NewApp "N" Boom
--- run n2 ==> non-termination
--------------------------------------------------
splat phi = (deM phi (\msg -> error "hey - you're applying the empty env!"))
run le = (deM (eval le) (\msg -> error "hey - you're applying the empty env!"))
--- Important to note that abstraction is neither lazy nor strict
---
e1 = App (Abs (redpat "x") (Const 1)) (blackexp (Const 19)) ---> error
e2 = App (Abs (redpat "x") (Var "x")) (blackexp (Const 19)) ---> error
e3 = App (Abs (redpat "x") (Var "x")) (redexp (Const 19)) ---> 19
e4 = App (Abs pairpat (Const 4)) (PairExp Boom Boom) ---> 4
e5 = App (Abs (redpat "x") (Var "x")) Boom ---> non-term
e6 = App (Abs (redpat "x") (Var "x")) (ConApp "red" [Boom]) ---> non-term
e7 = App (Abs (redpat "x") (Const 1)) (ConApp "red" [Boom]) ---> 1
e8 = App (Abs pairpat (Var "x")) (PairExp (Const 1) Boom) ---> 1
l1 = Let [(Pconst 1, Const 0)] (Const 99) ---> 99
l2 = Let [(redpat "x", Undefined)] (Const 99) ---> 99
l3 = Let [(redpat "x", black Undefined)] (Const 99) ---> 99
l4 = Let [(redpat "x", black Undefined)] (Var "x") ---> red != black
l5 = Let [(redpat "x", red (Const 99))] (Var "x") ---> 99
l6 = Let [(redpat "x", black Undefined),
(redpat "y", green (Const 99))] (Var "x") ---> red != black
{-
HaskellCoreLite> let (Red x) = Black 19 in 87
87
HaskellCoreLite> let (Red x) = Black 19 in x
Program error: {v1405 (RedBlack_Black (Num_fromInt instNum_v35 19))}
-}
{-
BTW, this works with the old def'n of let
(i.e., dynamic binding with no explicit fixpoints).
-}
evenDef = Abs (Pvar "x") (Cond (Bin IntEq (Var "x") (Const 0))
Tconst
(App (Var "odd") (Bin Plus (Var "x") (Const $ -1))))
oddDef = Abs (Pvar "x") (Cond (Bin IntEq (Var "x") (Const 0))
Fconst
(App (Var "even") (Bin Plus (Var "x") (Const $ -1))))
oddeven = Let [(Pvar "even",evenDef),(Pvar "odd",oddDef)] (App (Var "even") (Const 3))
---this one demonstrates irrefutable patterns
---compare with:
--- e1 = App (Abs (redpat "x") (Const 1)) (blackexp (Const 19)) ---> error
irref0 = App (Abs (Ptilde (redpat "x")) (Const 1)) (blackexp (Const 19))
irref1 = App (Abs (Ptilde (redpat "x")) (Var "x")) (blackexp (Const 19))
v = (z + z) where z = 1
c1 = Case Undefined $ [Normal (Pvar "x") (Const 1) []] ---> 1
c2 = Case Undefined $ [Normal (Pconst 99) (Const 1) []] ---> Undefined
c3 = Case Undefined $ [Normal (redpat "x") (Const 1) []] ---> Undefined
c4 = Case (black Undefined) [Normal (redpat "x") (Const 1) []]
---> match failure
c5 = Case (red Undefined) [Normal (redpat "x") (Const 1) []]
---> 1
{- c6:
data RBG a = Red a | Black a | Green a
foo = let val = Red (Green 1)
in
case val of
(Red x) -> (case x of (Black z) -> 99)
(Red (Green y)) -> 87
-}
c6body = (Case (Var "val")
[Normal (redpat "x")
(Case (Var "x") [Normal (blackpat "z") (Const 99) []])
[],
Normal (Pcondata "red" [greenpat "y"]) (Const 87) []])
c6 = Let [(Pvar "val", redexp (greenexp (Const 1)))] c6body
--- Simple example of a guarded case statement:
{-
data Match = Guarded P [(E,E)] [D]
| Normal P E [D]
c7body = Guarded (Pconst 1)
[(Bin IntEq (Const 1) (Const 1), (Const 99))]
{- where -} [(Pvar "z",(Const 1))]
c7 = Case (Const 1) [c7body]
-}
c7 = let c7body = Guarded (Pvar "x")
[(Bin IntEq (Var "x") (Var "z"), (Const 99))]
{- where -} [(Pvar "z",(Const 1))]
in Case (Const 1) [c7body]
c8 = let c8body = Guarded (Pvar "x")
[(Bin IntEq (Var "x") (Var "z"), (Const 99))]
{- where -} [(Pvar "z",(Const 2))]
in Case (Const 1) [c8body]
c9 =
let
guardedbody = Guarded (Pvar "x")
[(Bin IntEq (Var "x") (Var "z"), (Const 99))]
[(Pvar "z",(Const 1))]
normalbody = Normal (Pvar "y") (Const 101) []
in
Case (Const 1) [guardedbody,normalbody]
c10 =
let
guardedbody = Guarded (Pvar "x")
[(Bin IntEq (Var "x") (Var "z"), (Const 99))]
[(Pvar "z",(Const 2))]
normalbody = Normal (Pvar "y") (Const 101) []
in
Case (Const 1) [guardedbody,normalbody]
projy = App (Abs (Ptuple [Pvar "x", Pvar "y", Pvar "z"])
$ Var "y")
(TupleExp [Boom, Const 2, Boom])