tests/Symantic/Semantics/LetInserterSpec.hs

   1 {-# LANGUAGE BlockArguments #-}
   2 {-# LANGUAGE TemplateHaskellQuotes #-}
   3 {-# LANGUAGE NoMonomorphismRestriction #-}
   4
   5 module Symantic.Semantics.LetInserterSpec where
   6
   7 import Data.Function (($), (.))
   8 import Data.Functor.Identity (Identity (..))
   9 import Data.Int (Int)
  10 import Data.Maybe (Maybe (..))
  11 import Data.Semigroup (Semigroup (..))
  12 import Debug.Trace (trace)
  13 import Language.Haskell.TH.Syntax qualified as TH
  14 import Symantic.Semantics.LetInserter
  15 import Symantic.Semantics.Viewer
  16 import Symantic.Syntaxes.Classes (Abstractable (..), Constantable, Equalable (..), IfThenElseable (..), Instantiable (..), LetRecable (..), Letable (..), int, unit, (==))
  17 import Test.Syd
  18 import Test.Syd.Validity
  19 import Text.Show (show)
  20 import Prelude qualified as P
  21
  22 import Symantic.Syntaxes.Extras
  23
  24 -- import Debug.Trace (traceShow)
  25
  26 p12 ::
  27   Addable sem =>
  28   Instantiable sem =>
  29   Constantable Int sem =>
  30   sem Int
  31 p12 = int 1 + int 2
  32
  33 {-
  34 t1 ::
  35   Abstractable sem =>
  36   Instantiable sem =>
  37   Multiplicable sem =>
  38   Addable sem =>
  39   Constantable Int sem =>
  40   --GHC.Num.Num (sem Int) =>
  41   sem Int -> sem Int
  42 -}
  43 t1 = (\x -> x * (x + int 1))
  44 c1 = t1 p12
  45
  46 t2 x = let_ x (\y -> y * (y + int 1))
  47 c2 = t2 p12
  48 ft1 t x = lam (\u -> t x + t (x + u))
  49 c3 = ft1 t2 p12
  50
  51 p12l loc = genLetAt loc (int 1 + int 2)
  52 c1l = withLocus \loc -> p12l loc
  53
  54 ft11 loc = \t -> \x -> lam (\u -> t x + t (genLetAt loc (x + u)))
  55 c3l1 = withLocus \loc -> ft11 loc t1 (p12l loc)
  56
  57 ft12 = \t -> \x -> lam (\u -> withLocus \loc -> t x + t (genLetAt loc (x + u)))
  58 c3l2 = withLocus \loc -> ft12 t1 (p12l loc)
  59
  60 r12 :: Int
  61 r12 = runIdentity (runLetInserter p12)
  62 runLII = runIdentity . runLetInserter
  63
  64 {-
  65 -- letrec (fun self m -> lam @@ fun n ->
  66 --   if_ (m =. int 0) (n + (int 1)) @@
  67 --      if_ (n =. int 0) (self / (m - int 1) / int 1) @@
  68 --          self / (m - int 1) / (self / m / (n - int 1))
  69 --   ) @@ fun ack -> ack / int 2
  70 fib =
  71   letR
  72     (\self ->
  73       \n ->
  74         ifThenElse (n == int 0) (log "n==0" (int 1)) $
  75         ifThenElse (n == int 1) (log "n==1" (int 2)) $
  76         self .@ int 2
  77     )
  78     (\res -> res)
  79 let sac2 = sack 2
  80 ;;
  81 ack2 =
  82   letR
  83     (\self -> \m ->
  84       lam $ \n ->
  85         ifThenElse (m == int 0) (n + int 1) $
  86         ifThenElse (n == int 0) (self .@ (m - int 1) .@ int 1) $
  87         self .@ (m - int 1) .@ (self .@ m .@ (n - int 1))
  88     )
  89     (\res -> res .@ int 2)
  90
  91 let fibonacci n =
  92   let rec loop n (x,y) =·
  93     if n = 0 then x else if n = 1 then y else·
  94     .< .~(loop (n-1) (x,y)) + .~(loop (n-2) (x,y)) >.
  95   in .< fun x y -> .~(loop n (.< x >. , .< y >.)) >.
  96
  97 -}
  98
  99 -- derive
 100 quote :: LetInserter (AnnotatedCode code) a -> LetInserter (AnnotatedCode code) a
 101 -- quote :: sem a -> a
 102 quote = P.id
 103
 104 -- liftDerived
 105 unquote :: a -> sem a
 106 unquote = P.undefined
 107
 108 -- unQ ::
 109
 110 {-
 111 fibonacci ::
 112   ( P.Eq (sem Int)
 113   , P.Num (sem Int)
 114   , Substractable sem
 115   , Instantiable sem
 116   ) =>
 117   sem Int -> sem2 Int -> sem3 Int
 118 fibonacci ::
 119   ( Addable code
 120   , Abstractable (LetInserter (AnnotatedCode code))
 121   , Instantiable code
 122   ) => Int -> LetInserter (AnnotatedCode code) (Int -> Int -> Int)
 123 fibonacci m =
 124   let loop n (x,y) =
 125         if n P.== 0 then x else
 126         if n P.== 1 then y else
 127         quote (loop (n P.-1) (x, y) + loop (n P.-2) (x, y))
 128   in quote (lam $ \x -> lam $ \y -> loop m (x, y))
 129 -}
 130
 131 {-
 132 (* Specialized to m. Without memoization, it diverges *)
 133 let sack m =
 134   with_locus_rec @@ fun l ->
 135   let g = mkgenlet l (=) in
 136   let rec loop m =
 137     if m = 0 then .<fun n -> n + 1>. else
 138     .<fun n -> if n = 0 then .~(g loop (m-1)) 1
 139     else .~(g loop (m-1)) (.~(g loop m) (n-1))>.
 140   in g loop m
 141 ;;
 142 -}
 143 -- https://en.wikipedia.org/wiki/Ackermann_function
 144 -- Specialized to m. Without memoization, it diverges
 145 sack ::
 146   Abstractable code =>
 147   Addable code =>
 148   Constantable Int code =>
 149   Equalable code =>
 150   IfThenElseable code =>
 151   Instantiable code =>
 152   LetRecable Int code =>
 153   Letable code =>
 154   Substractable code =>
 155   Int ->
 156   LetInserter code (Int -> Int)
 157 sack m0 =
 158   withLocusRec $ \l ->
 159     let
 160       memoLoop k = genLetMemoRec l (P.fromIntegral k) (loop k)
 161       loop 0 =
 162         traceShow (["sack", "loop"], ("m", 0 :: Int)) $
 163           lam $
 164             \n -> n + int 1
 165       loop m =
 166         traceShow (["sack", "loop"], ("m", m)) $
 167           lam $ \n ->
 168             ifThenElse
 169               (n == int 0)
 170               (memoLoop (m P.- 1) .@ int 1)
 171               (memoLoop (m P.- 1) .@ (memoLoop m .@ (n - int 1)))
 172     in
 173       memoLoop m0
 174
 175 -- https://simple.wikipedia.org/wiki/Fibonacci_number
 176 fibonacci ::
 177   Addable code =>
 178   Abstractable code =>
 179   Letable code =>
 180   Instantiable code =>
 181   LetRecable Int code =>
 182   Int ->
 183   LetInserter code (Int -> Int -> Int)
 184 fibonacci m =
 185   withLocusRec $ \loc ->
 186     let
 187       memoLoop k = genLetMemoRec loc (P.fromIntegral k) (loop k)
 188       loop n =
 189         if n P.== 0
 190           then lam $ \x -> lam $ \_y -> x
 191           else
 192             if n P.== 1
 193               then lam $ \_x -> lam $ \y -> y
 194               else lam $ \x -> lam $ \y ->
 195                 add
 196                   .@ (memoLoop (n P.- 1) .@ x .@ y)
 197                   .@ (memoLoop (n P.- 2) .@ x .@ y)
 198     in
 199       loop m
 200
 201 -- (int -> int -> int) code =
 202 -- .< fun x_1 -> fun y_2 -> (((y_2 + x_1) + y_2) + (y_2 + x_1)) + ((y_2 + x_1) + y_2)>.
 203 tfib :: TH.Quote m => Int -> TH.Code m (Int -> Int -> Int)
 204 tfib m =
 205   let loop n (x, y) =
 206         if n P.== 0
 207           then x
 208           else
 209             if n P.== 1
 210               then y
 211               else [||$$(loop (n P.- 1) (x, y)) P.+ $$(loop (n P.- 2) (x, y))||]
 212   in [||\x y -> $$(loop m ([||x||], [||y||]))||]
 213
 214 {-
 215 acs :: Int -> LetInserter (AnnotatedCode Viewer) (Int -> Int)
 216 acs m =
 217   withLocusRec $ \l ->
 218   letR
 219     (\self -> --lam $ \mm ->
 220       lam $ \n ->
 221         --if (runIdentity m P.== 0) then (n + int 1) else
 222         ifThenElse (n == int 0) n $
 223           --genLetMemoRec l m
 224           (self .@ int m) .@ (n - int 1)
 225         --ifThenElse (m == int 0) (n + int 1) $
 226         --ifThenElse (n == int 0) (self .@ (m - int 1) .@ int 1) $
 227         --genLetMemo l m $ self .@ (m - int 1) .@ (self .@ m .@ (n - int 1))
 228     )
 229     (\self -> genLetMemoRec l (2) (self .@ int 2))
 230 -}
 231 ack :: Int -> Int -> Int
 232 ack 0 n = trace ("ack 0 " <> show n) $ n P.+ 1
 233 ack m 0 = trace ("ack " <> show m <> " 0") $ ack (m P.- 1) 1
 234 ack m n = trace ("ack " <> show n <> " " <> show m) $ ack (m P.- 1) (ack m (n P.- 1))
 235
 236 spec :: Spec
 237 spec = do
 238   describe "let_" do
 239     it "can bind a literal" do
 240       view (runLetInserter (let_ (int 3) (\v -> int 4 + v)))
 241         `shouldBe` "let x1 = 3 in 4 + x1"
 242     it "can bind an expression of literals" do
 243       view (runLetInserter (let_ (int 1 + int 2) (\v -> int 4 + v)))
 244         `shouldBe` "let x1 = 1 + 2 in 4 + x1"
 245     it "can bind a variable" do
 246       view (runLetInserter (lam (\x -> let_ x (\v -> int 4 + v))))
 247         `shouldBe` "\\x1 -> let x2 = x1 in 4 + x2"
 248     it "can bind an expression with a variable" do
 249       view (runLetInserter (lam (\x -> let_ (x + int 1) (\v -> int 4 + v))))
 250         `shouldBe` "\\x1 -> let x2 = x1 + 1 in 4 + x2"
 251   describe "genLet" do
 252     it "can bind" do
 253       let exp = int 1 + genLet (int 2)
 254       view (runLetInserter exp) `shouldBe` "let x1 = 2 in 1 + x1"
 255       runIdentity (runLetInserter exp) `shouldBe` 3
 256     it "can bind a literal across a lambda" do
 257       let exp = lam (\x -> x + genLet (int 2))
 258       view (runLetInserter exp) `shouldBe` "let x1 = 2 in \\x2 -> x2 + x1"
 259       runIdentity (runLetInserter exp) 1 `shouldBe` 3
 260     it "can bind an operation across a lambda" do
 261       let exp = lam (\x -> x + genLet (int 1 + int 2))
 262       view (runLetInserter exp) `shouldBe` "let x1 = 1 + 2 in \\x2 -> x2 + x1"
 263       runIdentity (runLetInserter exp) 1 `shouldBe` 4
 264     it "can wrap a variable" do
 265       let exp = lam (\x -> withLocus (\l -> x + genLetAt l x))
 266       view (runLetInserter exp) `shouldBe` "\\x1 -> let x2 = x1 in x1 + x2"
 267       runIdentity (runLetInserter exp) 1 `shouldBe` 2
 268     -- This must not raise a lookupVar failure for var=([1])  env=[]
 269     it "cannot cause a scope extrusion using withLocus" do
 270       view (runLetInserter (withLocus (\l -> lam (\x -> x + genLetAt l x))))
 271         `shouldBe` "\\x1 -> let x2 = x1 in x1 + x2"
 272     -- Check that 'lam' limits the scope extrusion:
 273     -- as soon as that passing a virtual binding would
 274     -- make a variable extrude its scope, this virtual binding is bound.
 275     it "has its locus limited by lam when wrapping its variable" do
 276       let exp = lam (\x -> x + genLet x)
 277       view (runLetInserter exp) `shouldBe` "\\x1 -> let x2 = x1 in x1 + x2"
 278       runIdentity (runLetInserter exp) 1 `shouldBe` 2
 279     it "does not have its locus limited by lam when not wrapping its variable" do
 280       let exp = lam (\x -> x + genLet (int 1))
 281       view (runLetInserter exp) `shouldBe` "let x1 = 1 in \\x2 -> x2 + x1"
 282       runIdentity (runLetInserter exp) 1 `shouldBe` 2
 283     it "can wrap let_" do
 284       let exp = lam (\x -> x + genLet (let_ (int 1) (\y -> y)))
 285       view (runLetInserter exp) `shouldBe` "let x1 = let x2 = 1 in x2 in \\x2 -> x2 + x1"
 286       runIdentity (runLetInserter exp) 1 `shouldBe` 2
 287     it "can have its locus limited by withLocus" do
 288       let exp = lam (\x -> withLocus (\l -> x + genLetAt l (let_ (int 1) (\y -> y))))
 289       view (runLetInserter exp) `shouldBe` "\\x1 -> let x2 = let x3 = 1 in x3 in x1 + x2"
 290       runIdentity (runLetInserter exp) 1 `shouldBe` 2
 291     it "can wrap lam and a variable" do
 292       let exp = lam (\x -> x + genLet (lam (\_y -> x)) .@ unit)
 293       view (runLetInserter exp) `shouldBe` "\\x1 -> let x2 = \\x3 -> x1 in x1 + x2 ()"
 294       runIdentity (runLetInserter exp) 1 `shouldBe` 2
 295     it "can wrap lam and be called" do
 296       let exp = lam (\x -> x + genLet (lam (\y -> y + int 2)) .@ x)
 297       view (runLetInserter exp) `shouldBe` "let x1 = \\x2 -> x2 + 2 in \\x2 -> x2 + x1 x2"
 298       runIdentity (runLetInserter exp) 1 `shouldBe` 4
 299     it "can wrap a variable in an operation" do
 300       let exp = lam (\x -> x + genLet (x + int 1))
 301       view (runLetInserter exp) `shouldBe` "\\x1 -> let x2 = x1 + 1 in x1 + x2"
 302       runIdentity (runLetInserter exp) 1 `shouldBe` 3
 303     it "can wrap literals inside an expression with two variables" do
 304       let exp = lam (\x -> lam (\y -> x + y + genLet (int 2 + int 3)))
 305       view (runLetInserter exp) `shouldBe` "let x1 = 2 + 3 in \\x2 -> \\x3 -> x2 + x3 + x1"
 306       runIdentity (runLetInserter exp) 1 4 `shouldBe` 10
 307     it "can wrap the farthest variable inside two lam" do
 308       let exp = lam (\x -> lam (\y -> x + y + genLet x))
 309       view (runLetInserter exp) `shouldBe` "\\x1 -> let x2 = x1 in \\x3 -> x1 + x3 + x2"
 310       runIdentity (runLetInserter exp) 1 4 `shouldBe` 6
 311     it "can wrap another variable inside two lam" do
 312       let exp = lam (\x -> lam (\y -> x + y + genLet y))
 313       view (runLetInserter exp) `shouldBe` "\\x1 -> \\x2 -> let x3 = x2 in x1 + x2 + x3"
 314       runIdentity (runLetInserter exp) 1 4 `shouldBe` 9
 315     it "can wrap another variable inside two lam" do
 316       let exp = lam (\x -> lam (\y -> x + y + genLet y))
 317       view (runLetInserter exp) `shouldBe` "\\x1 -> \\x2 -> let x3 = x2 in x1 + x2 + x3"
 318       runIdentity (runLetInserter exp) 1 4 `shouldBe` 9
 319     it "can wrap the farthest variable in an expression inside two lam" do
 320       let exp = lam (\x -> lam (\y -> x + y + genLet (x + int 1)))
 321       view (runLetInserter exp) `shouldBe` "\\x1 -> let x2 = x1 + 1 in \\x3 -> x1 + x3 + x2"
 322       runIdentity (runLetInserter exp) 1 4 `shouldBe` 7
 323     it "can wrap the closest variable in an expression inside two lam" do
 324       let exp = lam (\x -> lam (\y -> x + y + genLet (y + int 1)))
 325       view (runLetInserter exp) `shouldBe` "\\x1 -> \\x2 -> let x3 = x2 + 1 in x1 + x2 + x3"
 326       runIdentity (runLetInserter exp) 1 4 `shouldBe` 10
 327     it "can wrap both variables in an expression inside two lam" do
 328       let exp = lam (\x -> lam (\y -> x + y + genLet (y + int 1 + x)))
 329       view (runLetInserter exp) `shouldBe` "\\x1 -> \\x2 -> let x3 = x2 + 1 + x1 in x1 + x2 + x3"
 330       runIdentity (runLetInserter exp) 1 4 `shouldBe` 11
 331     it "can be nested" do
 332       let exp = lam (\x -> lam (\y -> x + y + genLet (genLet (y + int 1 + x))))
 333       view (runLetInserter exp) `shouldBe` "\\x1 -> \\x2 -> let x3 = x2 + 1 + x1 in let x4 = x3 in x1 + x2 + x4"
 334       runIdentity (runLetInserter exp) 1 4 `shouldBe` 11
 335     it "can be nested within an expression of literals" do
 336       let exp = lam (\x -> lam (\y -> x + y + genLet (y + genLet (int 1 + int 2))))
 337       view (runLetInserter exp) `shouldBe` "let x1 = 1 + 2 in \\x2 -> \\x3 -> let x4 = x3 + x1 in x2 + x3 + x4"
 338       runIdentity (runLetInserter exp) 1 4 `shouldBe` 12
 339     it "can be nested within an expression with a variable" do
 340       let exp = lam (\x -> lam (\y -> x + y + genLet (y + genLet (int 1 + x))))
 341       view (runLetInserter exp) `shouldBe` "\\x1 -> let x2 = 1 + x1 in \\x3 -> let x4 = x3 + x2 in x1 + x3 + x4"
 342       runIdentity (runLetInserter exp) 1 4 `shouldBe` 11
 343     it "can be nested within an expression with two variables" do
 344       let exp = lam (\x -> lam (\y -> x + y + genLet (y + genLet (int 1 + x + y))))
 345       view (runLetInserter exp) `shouldBe` "\\x1 -> \\x2 -> let x3 = 1 + x1 + x2 in let x4 = x2 + x3 in x1 + x2 + x4"
 346       runIdentity (runLetInserter exp) 1 4 `shouldBe` 15
 347     it "can be nested within another expression with two variables" do
 348       let exp = lam (\x -> lam (\y -> x + y + genLet (x + genLet (int 1 + x + y))))
 349       view (runLetInserter exp) `shouldBe` "\\x1 -> \\x2 -> let x3 = 1 + x1 + x2 in let x4 = x1 + x3 in x1 + x2 + x4"
 350       runIdentity (runLetInserter exp) 1 4 `shouldBe` 12
 351     it "can be nested within an expression of literals and one variable" do
 352       let exp = lam (\x -> lam (\y -> x + y + genLet (int 1 + genLet (int 1 + x + int 2))))
 353       view (runLetInserter exp) `shouldBe` "\\x1 -> let x2 = 1 + x1 + 2 in let x3 = 1 + x2 in \\x4 -> x1 + x4 + x3"
 354       runIdentity (runLetInserter exp) 1 4 `shouldBe` 10
 355     it "can be nested within an expression of literals" do
 356       let exp = lam (\x -> lam (\y -> x + y + genLet (int 1 + genLet (int 1 + int 2 + int 3))))
 357       view (runLetInserter exp) `shouldBe` "let x1 = 1 + 2 + 3 in let x2 = 1 + x1 in \\x3 -> \\x4 -> x3 + x4 + x2"
 358       runIdentity (runLetInserter exp) 1 4 `shouldBe` 12
 359     it "duplicates literals when used with host-let" do
 360       let exp = let x = genLet (int 1 + int 2) in x + x
 361       view (runLetInserter exp) `shouldBe` "let x1 = 1 + 2 in let x2 = 1 + 2 in x1 + x2"
 362       runIdentity (runLetInserter exp) `shouldBe` 6
 363     it "duplicates literals when using host-let and no specific memo key" do
 364       let exp =
 365             let x = genLet (int 1 + int 2)
 366             in let y = genLet (int 1 + x)
 367                in x + y
 368       view (runLetInserter exp) `shouldBe` "let x1 = 1 + 2 in let x2 = 1 + 2 in let x3 = 1 + x2 in x1 + x3"
 369       runIdentity (runLetInserter exp) `shouldBe` 7
 370     it "does not duplicate host-let when using a specific memo key" do
 371       let exp =
 372             let x = genLetMemoAtMaybe (Just 0) Nothing (int 1 + int 2)
 373             in let y = genLet (int 1 + x)
 374                in x + y
 375       view (runLetInserter exp) `shouldBe` "let x1 = 1 + 2 in let x2 = 1 + x1 in x1 + x2"
 376       runIdentity (runLetInserter exp) `shouldBe` 7
 377     it "does not duplicate host-lets when using specific memo keys" do
 378       let exp =
 379             let x = genLetMemoAtMaybe (Just 0) Nothing (int 1 + int 2)
 380             in let y = genLetMemoAtMaybe (Just 1) Nothing (int 1 + x)
 381                in let z = genLet (int 1 + y)
 382                   in x + z + y
 383       view (runLetInserter exp) `shouldBe` "let x1 = 1 + 2 in let x2 = 1 + x1 in let x3 = 1 + x2 in x1 + x3 + x2"
 384       runIdentity (runLetInserter exp) `shouldBe` 12
 385     it "does not duplicate host-let when using a specific memo key, inside a lam" do
 386       let exp =
 387             lam $ \u ->
 388               let x = genLetMemoAtMaybe (Just 0) Nothing (int 1 + int 2)
 389               in let y = genLet (u + x)
 390                  in x + y
 391       view (runLetInserter exp) `shouldBe` "let x1 = 1 + 2 in \\x2 -> let x3 = x2 + x1 in x1 + x3"
 392       runIdentity (runLetInserter exp) 2 `shouldBe` 8
 393     it "does not duplicate host-let when using a specific memo key, inside a lam and using its variable" do
 394       let exp =
 395             lam $ \u ->
 396               let x = genLetMemoAtMaybe (Just 0) Nothing (u + int 2)
 397               in let y = genLet (int 1 + x)
 398                  in x + y
 399       view (runLetInserter exp) `shouldBe` "\\x1 -> let x2 = x1 + 2 in let x3 = 1 + x2 in x2 + x3"
 400       runIdentity (runLetInserter exp) 2 `shouldBe` 9
 401     it "does not duplicate host-lets when using specific memo keys, inside a lam and using its variable" do
 402       let exp =
 403             lam $ \u ->
 404               let x = genLetMemoAtMaybe (Just 0) Nothing (u + int 2)
 405               in let y = genLetMemoAtMaybe (Just 1) Nothing (int 1 + x)
 406                  in let z = genLetMemoAtMaybe (Just 2) Nothing (int 1 + y)
 407                     in x + z + y + z
 408       view (runLetInserter exp) `shouldBe` "\\x1 -> let x2 = x1 + 2 in let x3 = 1 + x2 in let x4 = 1 + x3 in x2 + x4 + x3 + x4"
 409       runIdentity (runLetInserter exp) 2 `shouldBe` 21
 410   describe "Ex0" do
 411     it "p12" do
 412       runLII p12 `shouldBe` 3
 413     it "p12" do
 414       view (runLetInserter p12)
 415         `shouldBe` "1 + 2"
 416     it "c1" do
 417       view (runLetInserter c1)
 418         `shouldBe` "(1 + 2) * (1 + 2 + 1)"
 419     it "c2" do
 420       view (runLetInserter c2)
 421         `shouldBe` "let x1 = 1 + 2 in x1 * (x1 + 1)"
 422     it "c3" do
 423       view (runLetInserter c3)
 424         `shouldBe` "\\x1 -> (let x2 = 1 + 2 in x2 * (x2 + 1)) + (let x2 = 1 + 2 + x1 in x2 * (x2 + 1))"
 425   describe "Ex1" do
 426     it "c1l" do
 427       view (runLetInserter c1l)
 428         `shouldBe` "let x1 = 1 + 2 in x1"
 429     -- , it "c3l1" do -- expected scope extrusion
 430     --     view (runLetInserter c3l1) `shouldBe` ""
 431     it "c3l2" do
 432       -- serious duplication
 433       view (runLetInserter c3l2)
 434         `shouldBe` "let x1 = 1 + 2 in let x2 = 1 + 2 in let x3 = 1 + 2 in let x4 = 1 + 2 in \\x5 -> let x6 = x3 + x5 in let x7 = x4 + x5 in x1 * (x2 + 1) + x6 * (x7 + 1)"
 435     it "let x1 = 1 in let x2 = 2 in x1 + x2" do
 436       let exp = withLocus $ \loc -> genLetAt loc (int 1) + genLetAt loc (int 2)
 437       view (runLetInserter exp)
 438         `shouldBe` "let x1 = 1 in let x2 = 2 in x1 + x2"
 439     it "let_ (genLetAt loc (int 1 + int 2)) (\\x -> x + x)" do
 440       let exp = withLocus $ \loc ->
 441             let_ (genLetAt loc (int 1 + int 2)) $ \x ->
 442               x + x
 443       view (runLetInserter exp)
 444         `shouldBe` "let x1 = 1 + 2 in let x2 = x1 in x2 + x2"
 445     it "withLocus does not cause a scope extrusion" do
 446       let exp = withLocus $ \loc1 ->
 447             withLocus $ \loc2 ->
 448               genLetAt
 449                 loc1 -- expected scope extrusion if it's not bound at loc2 instead of loc1
 450                 (int 1 + genLetAt loc2 (int 2))
 451                 * int 3
 452       view (runLetInserter exp)
 453         `shouldBe` "let x1 = 2 in let x2 = 1 + x1 in x2 * 3"
 454     it "let x1 = 1 + 2 in let x2 = 1 + 2 in let x3 = 1 + x2 in x1 + x3" do
 455       let exp = withLocus $ \loc ->
 456             let x = (genLetAt loc (int 1 + int 2))
 457             in let y = (genLetAt loc (int 1 + x))
 458                in x + y
 459       view (runLetInserter exp)
 460         `shouldBe` "let x1 = 1 + 2 in let x2 = 1 + 2 in let x3 = 1 + x2 in x1 + x3"
 461     -- , it "let x1 = 1 + 2 in let x2 = 1 + x1 in x1 + x2" do
 462     --    let exp = withLocus $ \loc ->
 463     --                let__ (genLetAt loc (int 1 + int 2)) $ \x ->
 464     --                let__ (genLetAt loc (int 1 + x)) $ \y ->
 465     --                x + y
 466     --    view (runLetInserter exp) `shouldBe`
 467     --      "let x1 = 1 + 2 in let x2 = 1 + x1 in x1 + x2"
 468     it "let x1 = 1 + 2 in let x2 = x1 in let x3 = 1 + x2 in let x4 = x3 in x2 + x4" do
 469       let exp = withLocus $ \loc ->
 470             let_ (genLetAt loc (int 1 + int 2)) $ \x ->
 471               withLocus $ \locX ->
 472                 let_ (genLetAt locX (int 1 + x)) $ \y ->
 473                   x + y
 474       view (runLetInserter exp)
 475         `shouldBe` "let x1 = 1 + 2 in let x2 = x1 in let x3 = 1 + x2 in let x4 = x3 in x2 + x4"
 476   describe "Fibonacci" do
 477     it "fib 2" do
 478       view (runLetInserter (fibonacci 2))
 479         `shouldBe` "letRec [u1 = \\x2 -> \\x3 -> x3,u2 = \\x2 -> \\x3 -> x2] in \\x3 -> \\x4 -> u1 x3 x4 + u2 x3 x4"
 480     it "fib 5" do
 481       view (runLetInserter (fibonacci 5))
 482         `shouldBe` "letRec [u1 = \\x2 -> \\x3 -> u2 x2 x3 + u3 x2 x3,u2 = \\x2 -> \\x3 -> u3 x2 x3 + u4 x2 x3,u3 = \\x2 -> \\x3 -> u4 x2 x3 + u5 x2 x3,u4 = \\x2 -> \\x3 -> x3,u5 = \\x2 -> \\x3 -> x2] in \\x6 -> \\x7 -> u1 x6 x7 + u2 x6 x7"
 483     it "fib 2" do
 484       runIdentity (runLetInserter (fibonacci 2)) 0 1 `shouldBe` 1
 485     it "fib 5" do
 486       runIdentity (runLetInserter (fibonacci 5)) 0 1 `shouldBe` 5
 487     it "fib 10" do
 488       runIdentity (runLetInserter (fibonacci 10)) 0 1 `shouldBe` 55
 489   describe "Ackermann" do
 490     it "sack 2 3" do
 491       view (runLetInserter (sack 2))
 492         `shouldBe` "letRec [u1 = \\x2 -> if x2 == 0 then u2 1 else u2 (u1 (x2 - 1)),u2 = \\x2 -> if x2 == 0 then u3 1 else u3 (u2 (x2 - 1)),u3 = \\x2 -> x2 + 1] in u1"
 493     it "sack 2 3" do
 494       runLII (sack 2) 3 `shouldBe` 9
 495     it "sack 3 4" do
 496       runLII (sack 3) 4 `shouldBe` 125
 497
 498 --  {-
 499 --    it "fib 0" do
 500 --      runLII (fib .@ int 0) `shouldBe` 1
 501 --  , it "fib 1" do
 502 --      runLII (fib .@ int 1) `shouldBe` 2
 503 --  , it "fib 2" do
 504 --      runLII (fib .@ int 2) `shouldBe` 42
 505 --    it "fib 1" do
 506 --      runIdentity (fib .@ int 1) `shouldBe` 2
 507 --  , it "sack 3" do
 508 --      runIdentity (sack .@ int 3) `shouldBe` 9
 509 --  ,  it "acs" do
 510 --      view (runLetInserter acs) `shouldBe` ""
 511 --  -}