diff options
author | Péter Diviánszky <divipp@gmail.com> | 2016-06-03 15:52:55 +0200 |
---|---|---|
committer | Péter Diviánszky <divipp@gmail.com> | 2016-06-03 15:52:55 +0200 |
commit | 85dbc0c083fef4801c64a2810dd8021bdd8fa2ac (patch) | |
tree | 225db04d10739d82b2a4a50b7f63d949bbe47f83 /prototypes/LamMachine.hs | |
parent | fd11435229b4d763ac6c152e72f00331fc9df2aa (diff) |
add dedicated Let constructor
Diffstat (limited to 'prototypes/LamMachine.hs')
-rw-r--r-- | prototypes/LamMachine.hs | 17 |
1 files changed, 13 insertions, 4 deletions
diff --git a/prototypes/LamMachine.hs b/prototypes/LamMachine.hs index 4d30a927..a3e620e7 100644 --- a/prototypes/LamMachine.hs +++ b/prototypes/LamMachine.hs | |||
@@ -31,6 +31,7 @@ data Exp_ | |||
31 | = Var_ | 31 | = Var_ |
32 | | Int_ !Int -- ~ constructor with 0 args | 32 | | Int_ !Int -- ~ constructor with 0 args |
33 | | Lam_ String{-for pretty print-} !Exp | 33 | | Lam_ String{-for pretty print-} !Exp |
34 | | Let_ String{-for pretty print-} !Exp !Exp | ||
34 | | Op1_ !Op1 !Exp | 35 | | Op1_ !Op1 !Exp |
35 | | Con_ String{-for pretty print-} !Int [Exp] | 36 | | Con_ String{-for pretty print-} !Int [Exp] |
36 | | Case_ [String]{-for pretty print-} !Exp ![Exp] -- TODO: simplify? | 37 | | Case_ [String]{-for pretty print-} !Exp ![Exp] -- TODO: simplify? |
@@ -134,9 +135,9 @@ pattern Con a b i <- Exp_ u (Con_ a b (map (upp u) -> i)) | |||
134 | pattern Case a b c <- Exp_ u (Case_ a (upp u -> b) (map (upp u) -> c)) | 135 | pattern Case a b c <- Exp_ u (Case_ a (upp u -> b) (map (upp u) -> c)) |
135 | where Case cn a b = Exp_ s $ Case_ cn az bz where (s, az: bz) = deltas $ a: b | 136 | where Case cn a b = Exp_ s $ Case_ cn az bz where (s, az: bz) = deltas $ a: b |
136 | 137 | ||
137 | pattern Let n i x <- App (Lam n x) i | 138 | pattern Let n i x <- Exp_ u (Let_ n (upp u -> i) (upp (incFV u) -> x)) |
138 | where Let _ i (down 0 -> Just x) = x | 139 | where Let _ _ (down 0 -> Just x) = x |
139 | Let n i x = App (Lam n x) i | 140 | Let n a b = Exp_ s (Let_ n a' b') where (s, a', Lam _ b') = delta2 a $ Lam n b |
140 | 141 | ||
141 | pattern InHNF a <- (getHNF -> Just a) | 142 | pattern InHNF a <- (getHNF -> Just a) |
142 | where InHNF a@Int{} = a | 143 | where InHNF a@Int{} = a |
@@ -307,7 +308,6 @@ instance ViewShow Exp where | |||
307 | case {-if vi then Exp_ (selfContract fv) x else-} e of | 308 | case {-if vi then Exp_ (selfContract fv) x else-} e of |
308 | Var (Nat i) -> DVar i | 309 | Var (Nat i) -> DVar i |
309 | Let n a b -> shLet n (pShow a) $ pShow b | 310 | Let n a b -> shLet n (pShow a) $ pShow b |
310 | Seq a b -> DOp "`seq`" (Infix 1) (pShow a) (pShow b) | ||
311 | Lam n e -> shLam n $ pShow e | 311 | Lam n e -> shLam n $ pShow e |
312 | Con s i xs -> foldl DApp (text s) $ pShow <$> xs | 312 | Con s i xs -> foldl DApp (text s) $ pShow <$> xs |
313 | Int i -> pShow' i | 313 | Int i -> pShow' i |
@@ -325,6 +325,7 @@ shCase cn e xs = DPreOp (-20) (ComplexAtom "case" (-10) e (SimpleAtom "of")) | |||
325 | $ foldr1 DSemi [DArr_ "->" (text a) b | (a, b) <- zip cn xs] | 325 | $ foldr1 DSemi [DArr_ "->" (text a) b | (a, b) <- zip cn xs] |
326 | 326 | ||
327 | shOp2 AppOp x y = DApp x y | 327 | shOp2 AppOp x y = DApp x y |
328 | shOp2 SeqOp a b = DOp "`seq`" (Infix 1) a b | ||
328 | shOp2 EqInt x y = DOp "==" (Infix 4) x y | 329 | shOp2 EqInt x y = DOp "==" (Infix 4) x y |
329 | shOp2 Add x y = DOp "+" (InfixL 6) x y | 330 | shOp2 Add x y = DOp "+" (InfixL 6) x y |
330 | shOp2 o x y = text (show o) `DApp` x `DApp` y | 331 | shOp2 o x y = text (show o) `DApp` x `DApp` y |
@@ -447,8 +448,16 @@ primes = 2:3: filter (\n -> and $ map (\p -> n `mod` p /= 0) (takeWhile (\x -> x | |||
447 | main = primes !! 3000 | 448 | main = primes !! 3000 |
448 | -} | 449 | -} |
449 | 450 | ||
451 | twice = Lam "f" $ Lam "x" $ Var 1 `App` (Var 1 `App` Var 0) | ||
452 | twice2 = Lam "f" $ Lam "x" $ Var 1 `sApp` (Var 1 `App` Var 0) | ||
453 | |||
454 | inc = Lam "n" $ Op2 Add (Var 0) (Int 1) | ||
455 | |||
450 | test'' = Lam "f" (Int 4) `App` Int 3 | 456 | test'' = Lam "f" (Int 4) `App` Int 3 |
451 | 457 | ||
458 | twiceTest = twice `App` twice `App` twice `App` twice `App` inc `App` Int 0 | ||
459 | twiceTest2 = twice2 `App` twice2 `App` twice2 `App` twice2 `App` inc `App` Int 0 | ||
460 | |||
452 | tests | 461 | tests |
453 | = hnf test == hnf (Int 13) | 462 | = hnf test == hnf (Int 13) |
454 | && hnf test' == hnf (Int 14) | 463 | && hnf test' == hnf (Int 14) |