1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-14 17:32:00 +03:00
juvix/test/Compilation/Positive.hs

374 lines
11 KiB
Haskell
Raw Normal View History

module Compilation.Positive where
import Base
import Compilation.Base
data PosTest = PosTest
{ _name :: String,
2023-01-17 11:41:07 +03:00
_dir :: Path Abs Dir,
_file :: Path Abs File,
_assertionMode :: CompileAssertionMode,
2023-01-17 11:41:07 +03:00
_expectedFile :: Path Abs File
}
2023-01-17 11:41:07 +03:00
makeLenses ''PosTest
fromTest :: PosTest -> TestTree
fromTest = mkTest . toTestDescr
root :: Path Abs Dir
root = relToProject $(mkRelDir "tests/Compilation/positive/")
toTestDescr :: PosTest -> TestDescr
toTestDescr PosTest {..} =
2023-01-17 11:41:07 +03:00
let tRoot = _dir
file' = _file
expected' = _expectedFile
in TestDescr
{ _testName = _name,
_testRoot = tRoot,
_testAssertion = Steps $ compileAssertion _assertionMode file' expected'
}
allTests :: TestTree
allTests =
testGroup
"Juvix compilation pipeline positive tests"
(map (mkTest . toTestDescr) tests)
posTest' :: CompileAssertionMode -> String -> Path Rel Dir -> Path Rel File -> Path Rel File -> PosTest
posTest' _assertionMode _name rdir rfile routfile =
2023-01-17 11:41:07 +03:00
let _dir = root <//> rdir
_file = _dir <//> rfile
_expectedFile = root <//> routfile
in PosTest {..}
posTestStdin :: String -> Path Rel Dir -> Path Rel File -> Path Rel File -> Text -> PosTest
posTestStdin _name rdir rfile routfile _stdinText =
let t = posTest _name rdir rfile routfile
in t
{ _assertionMode = CompileOnly _stdinText
}
posTest :: String -> Path Rel Dir -> Path Rel File -> Path Rel File -> PosTest
posTest = posTest' EvalAndCompile
-- tests which use large integers are only evaluated but not compiled
posTestEval :: String -> Path Rel Dir -> Path Rel File -> Path Rel File -> PosTest
posTestEval = posTest' EvalOnly
tests :: [PosTest]
tests =
2023-01-17 11:41:07 +03:00
[ posTest
"Test001: Arithmetic operators"
$(mkRelDir ".")
$(mkRelFile "test001.juvix")
$(mkRelFile "out/test001.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test002: Arithmetic operators inside lambdas"
$(mkRelDir ".")
$(mkRelFile "test002.juvix")
$(mkRelFile "out/test002.out"),
2023-01-19 12:47:12 +03:00
posTest
"Test003: Integer arithmetic"
2023-01-19 12:47:12 +03:00
$(mkRelDir ".")
$(mkRelFile "test003.juvix")
$(mkRelFile "out/test003.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test004: IO builtins"
$(mkRelDir ".")
$(mkRelFile "test004.juvix")
$(mkRelFile "out/test004.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test005: Higher-order functions"
$(mkRelDir ".")
$(mkRelFile "test005.juvix")
$(mkRelFile "out/test005.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test006: If-then-else and lazy boolean operators"
$(mkRelDir ".")
$(mkRelFile "test006.juvix")
$(mkRelFile "out/test006.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test007: Pattern matching and lambda-case"
$(mkRelDir ".")
$(mkRelFile "test007.juvix")
$(mkRelFile "out/test007.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test008: Recursion"
$(mkRelDir ".")
$(mkRelFile "test008.juvix")
$(mkRelFile "out/test008.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test009: Tail recursion"
$(mkRelDir ".")
$(mkRelFile "test009.juvix")
$(mkRelFile "out/test009.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test010: Let"
$(mkRelDir ".")
$(mkRelFile "test010.juvix")
$(mkRelFile "out/test010.out"),
posTestEval
"Test011: Tail recursion: Fibonacci numbers in linear time"
$(mkRelDir ".")
$(mkRelFile "test011.juvix")
$(mkRelFile "out/test011.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test012: Trees"
$(mkRelDir ".")
$(mkRelFile "test012.juvix")
$(mkRelFile "out/test012.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test013: Functions returning functions with variable capture"
$(mkRelDir ".")
$(mkRelFile "test013.juvix")
$(mkRelFile "out/test013.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test014: Arithmetic"
$(mkRelDir ".")
$(mkRelFile "test014.juvix")
$(mkRelFile "out/test014.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test015: Local functions with free variables"
$(mkRelDir ".")
$(mkRelFile "test015.juvix")
$(mkRelFile "out/test015.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test016: Recursion through higher-order functions"
$(mkRelDir ".")
$(mkRelFile "test016.juvix")
$(mkRelFile "out/test016.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test017: Tail recursion through higher-order functions"
$(mkRelDir ".")
$(mkRelFile "test017.juvix")
$(mkRelFile "out/test017.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test018: Higher-order functions and recursion"
$(mkRelDir ".")
$(mkRelFile "test018.juvix")
$(mkRelFile "out/test018.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test019: Self-application"
$(mkRelDir ".")
$(mkRelFile "test019.juvix")
$(mkRelFile "out/test019.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test020: Recursive functions: McCarthy's 91 function, subtraction by increments"
$(mkRelDir ".")
$(mkRelFile "test020.juvix")
$(mkRelFile "out/test020.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test021: Fast exponentiation"
$(mkRelDir ".")
$(mkRelFile "test021.juvix")
$(mkRelFile "out/test021.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test022: Lists"
$(mkRelDir ".")
$(mkRelFile "test022.juvix")
$(mkRelFile "out/test022.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test023: Mutual recursion"
$(mkRelDir ".")
$(mkRelFile "test023.juvix")
$(mkRelFile "out/test023.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test024: Nested binders with variable capture"
$(mkRelDir ".")
$(mkRelFile "test024.juvix")
$(mkRelFile "out/test024.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test025: Euclid's algorithm"
$(mkRelDir ".")
$(mkRelFile "test025.juvix")
$(mkRelFile "out/test025.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test026: Functional queues"
$(mkRelDir ".")
$(mkRelFile "test026.juvix")
$(mkRelFile "out/test026.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test027: Church numerals"
$(mkRelDir ".")
$(mkRelFile "test027.juvix")
$(mkRelFile "out/test027.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test028: Streams without memoization"
$(mkRelDir ".")
$(mkRelFile "test028.juvix")
$(mkRelFile "out/test028.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test029: Ackermann function"
$(mkRelDir ".")
$(mkRelFile "test029.juvix")
$(mkRelFile "out/test029.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test030: Ackermann function (higher-order definition)"
$(mkRelDir ".")
$(mkRelFile "test030.juvix")
$(mkRelFile "out/test030.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test031: Nested lists"
$(mkRelDir ".")
$(mkRelFile "test031.juvix")
$(mkRelFile "out/test031.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test032: Merge sort"
$(mkRelDir ".")
$(mkRelFile "test032.juvix")
$(mkRelFile "out/test032.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test033: Eta-expansion of builtins and constructors"
$(mkRelDir ".")
$(mkRelFile "test033.juvix")
$(mkRelFile "out/test033.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test034: Recursive let"
$(mkRelDir ".")
$(mkRelFile "test034.juvix")
$(mkRelFile "out/test034.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test035: Pattern matching"
$(mkRelDir ".")
$(mkRelFile "test035.juvix")
$(mkRelFile "out/test035.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test036: Eta-expansion"
$(mkRelDir ".")
$(mkRelFile "test036.juvix")
$(mkRelFile "out/test036.out"),
2023-01-17 11:41:07 +03:00
posTest
"Test037: Applications with lets and cases in function position"
$(mkRelDir ".")
$(mkRelFile "test037.juvix")
Add compilation of complex pattern matching to case (#1824) This PR adds the `match-to-case` Core transformation. This transforms pattern matching nodes to a sequence of case and let nodes. ## High level description Each branch of the match is compiled to a lambda. In the combined match Each branch of the match is compiled to a lambda. These lambdas are combined in nested lets and each lambda is called in turn as each branch gets checked. The lambda corresponding to the first branch gets called first, if the pattern match in the branch fails, the lambda corresponding to the next branch is called and so on. If no branches match then a lambda is called which returns a fail node. Conceptually: <table> <tr> <td> Core </td> <td> Transformed </td> </tr> <tr> <td> ``` match v1 .. vn { b1 b2 ... bk } ``` </td> <td> ``` λ let c0 := λ FAIL in let ck := λ {...} in ... let c1 := λ {...} in c1 v1 ... vn ``` </td> </tr> </table> The patterns on each branch are compiled to either let bindings (pattern binders) or case expressions (constructor patterns). Auxillary bindings are added in the case of nested constructor patterns. The default branch in each case expression has a call to the lambda corresponding to the next branch of the match. This is because the default branch is reached if the pattern match fails. <table> <tr> <td> Pattern match </td> <td> Transformed </td> </tr> <tr> <td> ``` suc (suc n) ↦ n ``` </td> <td> ``` case ?$0 of { suc arg_8 := case ?$0 of { suc n := let n := ?$0 in n$0; _ := ?$2 ?$1 }; _ := ?$1 ?$0 } ``` </td> </tr> </table> The body of each branch is wrapped in let bindings so that the indicies of bound variables in the body point to the correct variables in the compiled expression. This is necessary because the auxiliary bindings added for nested constructor patterns will cause the original indicies to be offset. Finally, the free variables in the match branch body need to be shifted by all the bindings we've added as part of the compilation. ## Examples ### Single wildcard <table> <tr> <td> Juvix </td> <td> Core </td> <td> Transformed Core </td> </tr> <tr> <td> ``` f : Nat -> Nat; f _ := 1; ``` </td> <td> ``` λ? match ?$0 with { _ω309 ↦ ? 1 } ``` </td> <td> ``` λ? let ? := λ? fail "Non-exhaustive patterns" in let ? := λ? let _ω309 := ?$0 in let _ω309 := ?$0 in 1 in ?$0 ?$2 ``` </td> </tr> </table> ### Single binder <table> <tr> <td> Juvix </td> <td> Core </td> <td> Transformed Core </td> </tr> <tr> <td> ``` f : Nat -> Nat; f n := n; ``` </td> <td> ``` λ? match ?$0 with { n ↦ n$0 } ``` </td> <td> ``` λ? let ? := λ? fail "Non-exhaustive patterns" in let ? := λ? let n := ?$0 in let n := ?$0 in n$0 in ?$0 ?$2 ``` </td> </tr> </table> ### Single Constructor <table> <tr> <td> Juvix </td> <td> Core </td> <td> Transformed Core </td> </tr> <tr> <td> ``` f : Nat -> Nat; f (suc n) := n; ``` </td> <td> ``` λ? match ?$0 with { suc n ↦ n$0 } ``` </td> <td> ``` λ? let ? := λ? fail "Non-exhaustive patterns" in let ? := λ? case ?$0 of { suc n := let n := ?$0 in let n := ?$0 in n$0; _ := ?$1 ?$0 } in ?$0 ?$2 ``` </td> </tr> </table> ### Nested Constructor <table> <tr> <td> Juvix </td> <td> Core </td> <td> Transformed Core </td> </tr> <tr> <td> ``` f : Nat -> Nat; f (suc (suc n)) := n; ``` </td> <td> ``` λ? match ?$0 with { suc (suc n) ↦ n$0 } ``` </td> <td> ``` λ? let ? := λ? fail "Non-exhaustive patterns" in let ? := λ? case ?$0 of { suc arg_8 := case ?$0 of { suc n := let n := ?$0 in let n := ?$0 in n$0; _ := ?$2 ?$1 }; _ := ?$1 ?$0 } in ?$0 ?$2 ``` </td> </tr> </table> ### Multiple Branches <table> <tr> <td> Juvix </td> <td> Core </td> <td> Transformed Core </td> </tr> <tr> <td> ``` f : Nat -> Nat; f (suc n) := n; f zero := 0; ``` </td> <td> ``` λ? match ?$0 with { suc n ↦ n$0; zero ↦ ? 0 } ``` </td> <td> ``` λ? let ? := λ? fail "Non-exhaustive patterns" in let ? := λ? case ?$0 of { zero := ? 0; _ := ?$1 ?$0 } in let ? := λ? case ?$0 of { suc n := let n := ?$0 in let n := ?$0 in n$0; _ := ?$1 ?$0 } in ?$0 ?$3 ``` </td> </tr> </table> ### Nested case with captured variable <table> <tr> <td> Juvix </td> <td> Core </td> <td> Transformed Core </td> </tr> <tr> <td> ``` f : Nat -> Nat -> Nat; f n m := case m | suc k := n + k; ``` </td> <td> ``` f = λ? λ? match ?$1, ?$0 with { n, m ↦ match m$0 with { suc k ↦ + n$2 k$0 } } ``` </td> <td> ``` λ? λ? let ? := λ? λ? fail "Non-exhaustive patterns" in let ? := λ? λ? let n := ?$1 in let m := ?$1 in let n := ?$1 in let m := ?$1 in let ? := λ? fail "Non-exhaustive patterns" in let ? := λ? case ?$0 of { suc k := let k := ?$0 in let k := ?$0 in + n$6 k$0; _ := ?$1 ?$0 } in ?$0 m$2 in ?$0 ?$3 ?$2 ``` </td> </tr> </table> ## Testing The `tests/Compilation/positive` tests are run up to the Core evaluator with `match-to-case` and `nat-to-int` transformations on Core turned on. --------- Co-authored-by: Lukasz Czajka <lukasz@heliax.dev>
2023-02-15 13:30:12 +03:00
$(mkRelFile "out/test037.out"),
posTest
"Test038: Simple case expression"
Add compilation of complex pattern matching to case (#1824) This PR adds the `match-to-case` Core transformation. This transforms pattern matching nodes to a sequence of case and let nodes. ## High level description Each branch of the match is compiled to a lambda. In the combined match Each branch of the match is compiled to a lambda. These lambdas are combined in nested lets and each lambda is called in turn as each branch gets checked. The lambda corresponding to the first branch gets called first, if the pattern match in the branch fails, the lambda corresponding to the next branch is called and so on. If no branches match then a lambda is called which returns a fail node. Conceptually: <table> <tr> <td> Core </td> <td> Transformed </td> </tr> <tr> <td> ``` match v1 .. vn { b1 b2 ... bk } ``` </td> <td> ``` λ let c0 := λ FAIL in let ck := λ {...} in ... let c1 := λ {...} in c1 v1 ... vn ``` </td> </tr> </table> The patterns on each branch are compiled to either let bindings (pattern binders) or case expressions (constructor patterns). Auxillary bindings are added in the case of nested constructor patterns. The default branch in each case expression has a call to the lambda corresponding to the next branch of the match. This is because the default branch is reached if the pattern match fails. <table> <tr> <td> Pattern match </td> <td> Transformed </td> </tr> <tr> <td> ``` suc (suc n) ↦ n ``` </td> <td> ``` case ?$0 of { suc arg_8 := case ?$0 of { suc n := let n := ?$0 in n$0; _ := ?$2 ?$1 }; _ := ?$1 ?$0 } ``` </td> </tr> </table> The body of each branch is wrapped in let bindings so that the indicies of bound variables in the body point to the correct variables in the compiled expression. This is necessary because the auxiliary bindings added for nested constructor patterns will cause the original indicies to be offset. Finally, the free variables in the match branch body need to be shifted by all the bindings we've added as part of the compilation. ## Examples ### Single wildcard <table> <tr> <td> Juvix </td> <td> Core </td> <td> Transformed Core </td> </tr> <tr> <td> ``` f : Nat -> Nat; f _ := 1; ``` </td> <td> ``` λ? match ?$0 with { _ω309 ↦ ? 1 } ``` </td> <td> ``` λ? let ? := λ? fail "Non-exhaustive patterns" in let ? := λ? let _ω309 := ?$0 in let _ω309 := ?$0 in 1 in ?$0 ?$2 ``` </td> </tr> </table> ### Single binder <table> <tr> <td> Juvix </td> <td> Core </td> <td> Transformed Core </td> </tr> <tr> <td> ``` f : Nat -> Nat; f n := n; ``` </td> <td> ``` λ? match ?$0 with { n ↦ n$0 } ``` </td> <td> ``` λ? let ? := λ? fail "Non-exhaustive patterns" in let ? := λ? let n := ?$0 in let n := ?$0 in n$0 in ?$0 ?$2 ``` </td> </tr> </table> ### Single Constructor <table> <tr> <td> Juvix </td> <td> Core </td> <td> Transformed Core </td> </tr> <tr> <td> ``` f : Nat -> Nat; f (suc n) := n; ``` </td> <td> ``` λ? match ?$0 with { suc n ↦ n$0 } ``` </td> <td> ``` λ? let ? := λ? fail "Non-exhaustive patterns" in let ? := λ? case ?$0 of { suc n := let n := ?$0 in let n := ?$0 in n$0; _ := ?$1 ?$0 } in ?$0 ?$2 ``` </td> </tr> </table> ### Nested Constructor <table> <tr> <td> Juvix </td> <td> Core </td> <td> Transformed Core </td> </tr> <tr> <td> ``` f : Nat -> Nat; f (suc (suc n)) := n; ``` </td> <td> ``` λ? match ?$0 with { suc (suc n) ↦ n$0 } ``` </td> <td> ``` λ? let ? := λ? fail "Non-exhaustive patterns" in let ? := λ? case ?$0 of { suc arg_8 := case ?$0 of { suc n := let n := ?$0 in let n := ?$0 in n$0; _ := ?$2 ?$1 }; _ := ?$1 ?$0 } in ?$0 ?$2 ``` </td> </tr> </table> ### Multiple Branches <table> <tr> <td> Juvix </td> <td> Core </td> <td> Transformed Core </td> </tr> <tr> <td> ``` f : Nat -> Nat; f (suc n) := n; f zero := 0; ``` </td> <td> ``` λ? match ?$0 with { suc n ↦ n$0; zero ↦ ? 0 } ``` </td> <td> ``` λ? let ? := λ? fail "Non-exhaustive patterns" in let ? := λ? case ?$0 of { zero := ? 0; _ := ?$1 ?$0 } in let ? := λ? case ?$0 of { suc n := let n := ?$0 in let n := ?$0 in n$0; _ := ?$1 ?$0 } in ?$0 ?$3 ``` </td> </tr> </table> ### Nested case with captured variable <table> <tr> <td> Juvix </td> <td> Core </td> <td> Transformed Core </td> </tr> <tr> <td> ``` f : Nat -> Nat -> Nat; f n m := case m | suc k := n + k; ``` </td> <td> ``` f = λ? λ? match ?$1, ?$0 with { n, m ↦ match m$0 with { suc k ↦ + n$2 k$0 } } ``` </td> <td> ``` λ? λ? let ? := λ? λ? fail "Non-exhaustive patterns" in let ? := λ? λ? let n := ?$1 in let m := ?$1 in let n := ?$1 in let m := ?$1 in let ? := λ? fail "Non-exhaustive patterns" in let ? := λ? case ?$0 of { suc k := let k := ?$0 in let k := ?$0 in + n$6 k$0; _ := ?$1 ?$0 } in ?$0 m$2 in ?$0 ?$3 ?$2 ``` </td> </tr> </table> ## Testing The `tests/Compilation/positive` tests are run up to the Core evaluator with `match-to-case` and `nat-to-int` transformations on Core turned on. --------- Co-authored-by: Lukasz Czajka <lukasz@heliax.dev>
2023-02-15 13:30:12 +03:00
$(mkRelDir ".")
$(mkRelFile "test038.juvix")
$(mkRelFile "out/test038.out"),
posTest
"Test039: Mutually recursive let expression"
$(mkRelDir ".")
$(mkRelFile "test039.juvix")
$(mkRelFile "out/test039.out"),
posTest
"Test040: Pattern matching nullary constructor"
$(mkRelDir ".")
$(mkRelFile "test040.juvix")
$(mkRelFile "out/test040.out"),
posTest
"Test041: Use a builtin inductive in an inductive constructor"
$(mkRelDir ".")
$(mkRelFile "test041.juvix")
$(mkRelFile "out/test041.out"),
posTest
"Test042: Builtin string-to-nat"
$(mkRelDir ".")
$(mkRelFile "test042.juvix")
$(mkRelFile "out/test042.out"),
posTest
"Test043: Builtin trace"
$(mkRelDir ".")
$(mkRelFile "test043.juvix")
$(mkRelFile "out/test043.out"),
posTestStdin
"Test044: Builtin readline"
$(mkRelDir ".")
$(mkRelFile "test044.juvix")
$(mkRelFile "out/test044.out")
"a\n",
posTest
"Test045: Implicit builtin bool"
$(mkRelDir ".")
$(mkRelFile "test045.juvix")
$(mkRelFile "out/test045.out"),
posTest
"Test046: Polymorphic type arguments"
$(mkRelDir ".")
$(mkRelFile "test046.juvix")
$(mkRelFile "out/test046.out"),
posTest
"Test047: Local Modules"
$(mkRelDir ".")
$(mkRelFile "test047.juvix")
$(mkRelFile "out/test047.out"),
posTest
"Test048: String quoting"
$(mkRelDir ".")
$(mkRelFile "test048.juvix")
Add builtin integer type to the surface language (#1948) This PR adds a builtin integer type to the surface language that is compiled to the backend integer type. ## Inductive definition The `Int` type is defined in the standard library as: ``` builtin int type Int := | --- ofNat n represents the integer n ofNat : Nat -> Int | --- negSuc n represents the integer -(n + 1) negSuc : Nat -> Int; ``` ## New builtin functions defined in the standard library ``` intToString : Int -> String; + : Int -> Int -> Int; neg : Int -> Int; * : Int -> Int -> Int; - : Int -> Int -> Int; div : Int -> Int -> Int; mod : Int -> Int -> Int; == : Int -> Int -> Bool; <= : Int -> Int -> Bool; < : Int -> Int -> Bool; ``` Additional builtins required in the definition of the other builtins: ``` negNat : Nat -> Int; intSubNat : Nat -> Nat -> Int; nonNeg : Int -> Bool; ``` ## REPL types of literals In the REPL, non-negative integer literals have the inferred type `Nat`, negative integer literals have the inferred type `Int`. ``` Stdlib.Prelude> :t 1 Nat Stdlib.Prelude> :t -1 Int :t let x : Int := 1 in x Int ``` ## The standard library Prelude The definitions of `*`, `+`, `div` and `mod` are not exported from the standard library prelude as these would conflict with the definitions from `Stdlib.Data.Nat`. Stdlib.Prelude ``` open import Stdlib.Data.Int hiding {+;*;div;mod} public; ``` * Closes https://github.com/anoma/juvix/issues/1679 * Closes https://github.com/anoma/juvix/issues/1984 --------- Co-authored-by: Lukasz Czajka <lukasz@heliax.dev>
2023-04-13 10:16:49 +03:00
$(mkRelFile "out/test048.out"),
posTest
"Test049: Builtin Int"
$(mkRelDir ".")
$(mkRelFile "test049.juvix")
$(mkRelFile "out/test049.out"),
posTest
"Test050: Pattern matching with integers"
$(mkRelDir ".")
$(mkRelFile "test050.juvix")
$(mkRelFile "out/test050.out"),
posTest
"Test051: Local recursive function using IO >>"
$(mkRelDir ".")
$(mkRelFile "test051.juvix")
$(mkRelFile "out/test051.out"),
posTest
"Test052: Simple lambda calculus"
$(mkRelDir ".")
$(mkRelFile "test052.juvix")
$(mkRelFile "out/test052.out"),
posTest
"Test053: Inlining"
$(mkRelDir ".")
$(mkRelFile "test053.juvix")
$(mkRelFile "out/test053.out"),
posTest
"Test054: Iterators"
$(mkRelDir ".")
$(mkRelFile "test054.juvix")
$(mkRelFile "out/test054.out"),
posTest
"Test055: Constructor printing"
$(mkRelDir ".")
$(mkRelFile "test055.juvix")
$(mkRelFile "out/test055.out"),
posTest
"Test056: Argument specialization"
$(mkRelDir ".")
$(mkRelFile "test056.juvix")
$(mkRelFile "out/test056.out"),
posTest
"Test057: Case folding"
$(mkRelDir ".")
$(mkRelFile "test057.juvix")
$(mkRelFile "out/test057.out"),
posTest
"Test058: Ranges"
$(mkRelDir ".")
$(mkRelFile "test058.juvix")
$(mkRelFile "out/test058.out"),
posTest
"Test059: Builtin list"
$(mkRelDir ".")
$(mkRelFile "test059.juvix")
$(mkRelFile "out/test059.out"),
posTest
"Test060: Record update"
$(mkRelDir ".")
$(mkRelFile "test060.juvix")
Traits (#2320) * Closes #1646 Implements a basic trait framework. A simple instance search mechanism is included which fails if there is more than one matching instance at any step. Example usage: ``` import Stdlib.Prelude open hiding {Show; mkShow; show}; trait type Show A := mkShow { show : A → String }; instance showStringI : Show String := mkShow (show := id); instance showBoolI : Show Bool := mkShow (show := λ{x := if x "true" "false"}); instance showNatI : Show Nat := mkShow (show := natToString); showList {A} : {{Show A}} → List A → String | nil := "nil" | (h :: t) := Show.show h ++str " :: " ++str showList t; instance showListI {A} {{Show A}} : Show (List A) := mkShow (show := showList); showMaybe {A} {{Show A}} : Maybe A → String | (just x) := "just (" ++str Show.show x ++str ")" | nothing := "nothing"; instance showMaybeI {A} {{Show A}} : Show (Maybe A) := mkShow (show := showMaybe); main : IO := printStringLn (Show.show true) >> printStringLn (Show.show false) >> printStringLn (Show.show 3) >> printStringLn (Show.show [true; false]) >> printStringLn (Show.show [1; 2; 3]) >> printStringLn (Show.show [1; 2]) >> printStringLn (Show.show [true; false]) >> printStringLn (Show.show [just true; nothing; just false]) >> printStringLn (Show.show [just [1]; nothing; just [2; 3]]) >> printStringLn (Show.show "abba") >> printStringLn (Show.show ["a"; "b"; "c"; "d"]); ``` It is possible to manually provide an instance and to match on implicit instances: ``` f {A} : {{Show A}} -> A -> String | {{mkShow s}} x -> s x; f' {A} : {{Show A}} → A → String | {{M}} x := Show.show {{M}} x; ``` The trait parameters in instance types are checked to be structurally decreasing to avoid looping in the instance search. So the following is rejected: ``` type Box A := box A; trait type T A := mkT { pp : A → A }; instance boxT {A} : {{T (Box A)}} → T (Box A) := mkT (λ{x := x}); ``` We check whether each parameter is a strict subterm of some trait parameter in the target. This ordering is included in the finite multiset extension of the subterm ordering, hence terminating.
2023-09-08 13:16:43 +03:00
$(mkRelFile "out/test060.out"),
posTest
"Test061: Traits"
$(mkRelDir ".")
$(mkRelFile "test061.juvix")
$(mkRelFile "out/test061.out"),
posTest
"Test062: Overapplication"
$(mkRelDir ".")
$(mkRelFile "test062.juvix")
$(mkRelFile "out/test062.out")
]