Merge pull request #252 from HigherOrderCO/feature/sc-541/add-no-opti…

…mization-test-for-hvml

[sc-541] Add no-optimization test for hvml

tests/golden_tests.rs

@@ -381,3 +381,17 @@ fn io() {
     }),
   ])
 }
+
+#[test]
+fn no_optimization() {
+  run_golden_test_dir(function_name!(), &|code, path| {
+    let mut book = do_parse_book(code, path)?;
+
+    let mut compile_opts = CompileOpts::light();
+    compile_opts = compile_opts.set_no_all();
+    compile_opts.adt_encoding = AdtEncoding::Scott;
+
+    let res = compile_book(&mut book, compile_opts, DiagnosticsConfig::default(), None)?;
+    Ok(format!("{}", res.core_book))
+  })
+}

tests/golden_tests/no_optimization/bitonic_sort.hvm

@@ -0,0 +1,45 @@
+data Tree = (Leaf a) | (Both a b)
+data Error = Err
+
+// Atomic Swapper
+(Swap n a b) = switch n {
+  0: (Both a b)
+  _: (Both b a)
+}
+
+// Swaps distant values in parallel; corresponds to a Red Box
+(Warp s (Leaf a)   (Leaf b))   = (Swap (^ (> a b) s) (Leaf a) (Leaf b))
+(Warp s (Both a b) (Both c d)) = (Join (Warp s a c) (Warp s b d))
+(Warp s a b) = Err
+
+// Rebuilds the warped tree in the original order
+(Join (Both a b) (Both c d)) = (Both (Both a c) (Both b d))
+(Join a b) = Err
+
+// Recursively warps each sub-tree; corresponds to a Blue/Green Box
+(Flow s (Leaf a))   = (Leaf a)
+(Flow s (Both a b)) = (Down s (Warp s a b))
+
+// Propagates Flow downwards
+(Down s (Leaf a))   = (Leaf a)
+(Down s (Both a b)) = (Both (Flow s a) (Flow s b))
+
+// Bitonic Sort
+(Sort s (Leaf a))   = (Leaf a)
+(Sort s (Both a b)) = (Flow s (Both (Sort 0 a) (Sort 1 b)))
+
+// Generates a tree of depth `n`
+(Gen n x) = switch n {
+  0: (Leaf x)
+  _: (Both (Gen n-1 (* x 2)) (Gen n-1 (+ (* x 2) 1)))
+}
+
+// Reverses a tree
+(Rev (Leaf x))   = (Leaf x)
+(Rev (Both a b)) = (Both (Rev b) (Rev a))
+
+// Sums a tree
+(Sum (Leaf x))   = x
+(Sum (Both a b)) = (+ (Sum a) (Sum b))
+
+Main = (Sum (Sort 0 (Rev (Gen 4 0))))

tests/golden_tests/no_optimization/list_reverse.hvm

@@ -0,0 +1,9 @@
+data list = (cons h t) | nil
+
+reverse (cons h t) = (concat (reverse t) (cons h nil))
+reverse nil = nil
+
+concat (cons h t) x = (cons h (concat t x))
+concat nil x = x
+
+main = (reverse (cons 3 (cons 2 (cons 1 nil))))

tests/golden_tests/no_optimization/redex_order.hvm

@@ -0,0 +1,10 @@
+// We want the nested calls in foo to be compiled as redexes written in outer to inner order
+// So they should compile to: @foo = root_tree & a ~ ... & b ~ ... & c ~ ...
+foo = @x (a (b (c x)))
+foo2 = (a (b (c 0)))
+
+a = @x x
+b = @x x
+c = @x x
+
+main = (foo foo2)

tests/golden_tests/no_optimization/sum_tree.hvm

@@ -0,0 +1,16 @@
+data Tree = (Leaf x) | (Node x0 x1)
+
+add = λa λb (+ a b)
+
+gen = λn switch n {
+  0: (Leaf 1)
+  _: (Node (gen n-1) (gen n-1))
+}
+
+sum = λt
+  match t {
+    Leaf: t.x
+    Node: (add (sum t.x0) (sum t.x1))
+  }
+
+main = (sum (gen 8))

tests/snapshots/no_optimization__bitonic_sort.hvm.snap

@@ -0,0 +1,66 @@
+---
+source: tests/golden_tests.rs
+input_file: tests/golden_tests/no_optimization/bitonic_sort.hvm
+---
+@Both = (a (b (* ((a (b c)) c))))
+
+@Down = ({17 a b} (((c d) ((e (f g)) h)) h))
+  & @Both ~ (i (j g))
+  & @Flow ~ (b (f j))
+  & @Flow ~ (a (e i))
+  & @Leaf ~ (c d)
+
+@Err = (a a)
+
+@Flow = ({15 a b} (((c d) ((e (f g)) h)) h))
+  & @Down ~ (a (i g))
+  & @Warp ~ (b (e (f i)))
+  & @Leaf ~ (c d)
+
+@Gen = (?<a ({21 b c} d) e> ({19 f {19 <* #2 g> <* #2 <+ #1 h>>}} e))
+  & @Gen ~ (c (h i))
+  & @Both ~ (j (i d))
+  & @Gen ~ (b (g j))
+  & @Leaf ~ (f a)
+
+@Join = (((* @Err) ((a (b c)) d)) (((* @Err) ((e (f g)) c)) d))
+  & @Both ~ (h (i g))
+  & @Both ~ (b (f i))
+  & @Both ~ (a (e h))
+
+@Leaf = (a ((a b) (* b)))
+
+@Rev = (((a b) ((c (d e)) f)) f)
+  & @Both ~ (g (h e))
+  & @Rev ~ (c h)
+  & @Rev ~ (d g)
+  & @Leaf ~ (a b)
+
+@Sort = (a (((b c) ((d (e f)) g)) g))
+  & @Flow ~ (a (h f))
+  & @Both ~ (i (j h))
+  & @Sort ~ (#1 (e j))
+  & @Sort ~ (#0 (d i))
+  & @Leaf ~ (b c)
+
+@Sum = (((a a) ((b (c d)) e)) e)
+  & @Sum ~ (b <+ f d>)
+  & @Sum ~ (c f)
+
+@Swap = (?<a (* b) c> ({3 d e} ({5 f g} c)))
+  & @Both ~ (g (e b))
+  & @Both ~ (d (f a))
+
+@Warp = ({7 a {7 b c}} ((({11 <> d <^ a e>> f} g) ((h (i j)) k)) ({9 (({13 d l} m) ((* (* @Err)) g)) ((* @Err) ((n (o p)) j))} k)))
+  & @Join ~ (q (r p))
+  & @Warp ~ (c (i (o r)))
+  & @Warp ~ (b (h (n q)))
+  & @Swap ~ (e (s (t m)))
+  & @Leaf ~ (l t)
+  & @Leaf ~ (f s)
+
+@main = a
+  & @Sum ~ (b a)
+  & @Sort ~ (#0 (c b))
+  & @Rev ~ (d c)
+  & @Gen ~ (#4 (#0 d))

tests/snapshots/no_optimization__list_reverse.hvm.snap

@@ -0,0 +1,22 @@
+---
+source: tests/golden_tests.rs
+input_file: tests/golden_tests/no_optimization/list_reverse.hvm
+---
+@concat = (((a (b c)) (d e)) ({3 f d} e))
+  & @concat ~ (b (f g))
+  & @cons ~ (a (g c))
+
+@cons = (a (b ((a (b c)) (* c))))
+
+@main = a
+  & @reverse ~ (b a)
+  & @cons ~ (#3 (c b))
+  & @cons ~ (#2 (d c))
+  & @cons ~ (#1 (@nil d))
+
+@nil = (* (a a))
+
+@reverse = (((a (b c)) (@nil d)) d)
+  & @concat ~ (e (f c))
+  & @cons ~ (a (@nil f))
+  & @reverse ~ (b e)

tests/snapshots/no_optimization__redex_order.hvm.snap

@@ -0,0 +1,22 @@
+---
+source: tests/golden_tests.rs
+input_file: tests/golden_tests/no_optimization/redex_order.hvm
+---
+@a = (a a)
+
+@b = (a a)
+
+@c = (a a)
+
+@foo = (a b)
+  & @a ~ (c b)
+  & @b ~ (d c)
+  & @c ~ (a d)
+
+@foo2 = a
+  & @a ~ (b a)
+  & @b ~ (c b)
+  & @c ~ (#0 c)
+
+@main = a
+  & @foo ~ (@foo2 a)

tests/snapshots/no_optimization__sum_tree.hvm.snap

@@ -0,0 +1,24 @@
+---
+source: tests/golden_tests.rs
+input_file: tests/golden_tests/no_optimization/sum_tree.hvm
+---
+@Leaf = (a ((a b) (* b)))
+
+@Node = (a (b (* ((a (b c)) c))))
+
+@add = (<+ a b> (a b))
+
+@gen = (?<a ({3 b c} d) e> e)
+  & @Node ~ (f (g d))
+  & @gen ~ (c g)
+  & @gen ~ (b f)
+  & @Leaf ~ (#1 a)
+
+@main = a
+  & @sum ~ (b a)
+  & @gen ~ (#8 b)
+
+@sum = (((a a) ((b (c d)) e)) e)
+  & @add ~ (f (g d))
+  & @sum ~ (c g)
+  & @sum ~ (b f)