diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/test/test/lux/lang/analysis/function.lux | 111 | ||||
| -rw-r--r-- | stdlib/test/test/lux/lang/analysis/structure.lux | 2 |
2 files changed, 112 insertions, 1 deletions
diff --git a/stdlib/test/test/lux/lang/analysis/function.lux b/stdlib/test/test/lux/lang/analysis/function.lux new file mode 100644 index 000000000..97ab808a0 --- /dev/null +++ b/stdlib/test/test/lux/lang/analysis/function.lux @@ -0,0 +1,111 @@ +(.module: + lux + (lux [io] + (control [monad #+ do] + pipe) + (data ["e" error] + [maybe] + [product] + [text "text/" Eq<Text>] + text/format + (coll [list "list/" Functor<List>])) + ["r" math/random "r/" Monad<Random>] + [macro] + (macro [code]) + [lang] + (lang [type "type/" Eq<Type>] + [".L" init] + [".L" analysis #+ Analysis] + (analysis [".A" type] + [".A" expression] + ["/" function])) + test) + (// ["_." primitive] + ["_." structure])) + +(def: analyse (expressionA.analyser (:! lang.Eval []))) + +(def: (check-apply expectedT num-args analysis) + (-> Type Nat (Meta Analysis) Bool) + (|> analysis + (typeA.with-type expectedT) + (macro.run (initL.compiler [])) + (case> (#e.Success applyA) + (let [[funcA argsA] (analysisL.application applyA)] + (n/= num-args (list.size argsA))) + + (#e.Error error) + false))) + +(context: "Function definition." + (<| (times +100) + (do @ + [func-name (r.unicode +5) + arg-name (|> (r.unicode +5) (r.filter (|>> (text/= func-name) not))) + [outputT outputC] _primitive.primitive + [inputT _] _primitive.primitive + #let [g!arg (code.local-symbol arg-name)]] + ($_ seq + (test "Can analyse function." + (and (|> (typeA.with-type (All [a] (-> a outputT)) + (/.function ..analyse func-name arg-name outputC)) + _structure.check-succeeds) + (|> (typeA.with-type (All [a] (-> a a)) + (/.function ..analyse func-name arg-name g!arg)) + _structure.check-succeeds))) + (test "Generic functions can always be specialized." + (and (|> (typeA.with-type (-> inputT outputT) + (/.function ..analyse func-name arg-name outputC)) + _structure.check-succeeds) + (|> (typeA.with-type (-> inputT inputT) + (/.function ..analyse func-name arg-name g!arg)) + _structure.check-succeeds))) + (test "The function's name is bound to the function's type." + (|> (typeA.with-type (Rec self (-> inputT self)) + (/.function ..analyse func-name arg-name (code.local-symbol func-name))) + _structure.check-succeeds)) + )))) + +(context: "Function application." + (<| (times +100) + (do @ + [full-args (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) + partial-args (|> r.nat (:: @ map (n/% full-args))) + var-idx (|> r.nat (:: @ map (|>> (n/% full-args) (n/max +1)))) + inputsTC (r.list full-args _primitive.primitive) + #let [inputsT (list/map product.left inputsTC) + inputsC (list/map product.right inputsTC)] + [outputT outputC] _primitive.primitive + #let [funcT (type.function inputsT outputT) + partialT (type.function (list.drop partial-args inputsT) outputT) + varT (#.Bound +1) + polyT (<| (type.univ-q +1) + (type.function (list.concat (list (list.take var-idx inputsT) + (list varT) + (list.drop (inc var-idx) inputsT)))) + varT) + poly-inputT (maybe.assume (list.nth var-idx inputsT)) + partial-poly-inputsT (list.drop (inc var-idx) inputsT) + partial-polyT1 (<| (type.function partial-poly-inputsT) + poly-inputT) + partial-polyT2 (<| (type.univ-q +1) + (type.function (#.Cons varT partial-poly-inputsT)) + varT) + dummy-function (#analysisL.Function (list) (#analysisL.Variable (#analysisL.Local +1)))]] + ($_ seq + (test "Can analyse monomorphic type application." + (|> (/.apply ..analyse funcT dummy-function inputsC) + (check-apply outputT full-args))) + (test "Can partially apply functions." + (|> (/.apply ..analyse funcT dummy-function (list.take partial-args inputsC)) + (check-apply partialT partial-args))) + (test "Can apply polymorphic functions." + (|> (/.apply ..analyse polyT dummy-function inputsC) + (check-apply poly-inputT full-args))) + (test "Polymorphic partial application propagates found type-vars." + (|> (/.apply ..analyse polyT dummy-function (list.take (inc var-idx) inputsC)) + (check-apply partial-polyT1 (inc var-idx)))) + (test "Polymorphic partial application preserves quantification for type-vars." + (|> (/.apply ..analyse polyT dummy-function (list.take var-idx inputsC)) + (check-apply partial-polyT2 var-idx))) + )))) diff --git a/stdlib/test/test/lux/lang/analysis/structure.lux b/stdlib/test/test/lux/lang/analysis/structure.lux index 5bebe5325..ad6691287 100644 --- a/stdlib/test/test/lux/lang/analysis/structure.lux +++ b/stdlib/test/test/lux/lang/analysis/structure.lux @@ -29,7 +29,7 @@ (def: analyse (expressionA.analyser (:! lang.Eval []))) (do-template [<name> <on-success> <on-error>] - [(def: <name> + [(def: #export <name> (All [a] (-> (Meta a) Bool)) (|>> (macro.run (initL.compiler [])) (case> (#e.Success _) |