aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux/control.lux41
-rw-r--r--stdlib/source/test/lux/control/concurrency/actor.lux17
-rw-r--r--stdlib/source/test/lux/control/function/memo.lux88
-rw-r--r--stdlib/source/test/lux/control/function/mixin.lux135
-rw-r--r--stdlib/source/test/lux/tool.lux11
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux (renamed from stdlib/source/test/lux/tool/compiler/phase/analysis.lux)0
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux (renamed from stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux)31
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux (renamed from stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux)35
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux (renamed from stdlib/source/test/lux/tool/compiler/phase/analysis/primitive.lux)30
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux (renamed from stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux)26
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux (renamed from stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux)64
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux (renamed from stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux)15
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux (renamed from stdlib/source/test/lux/tool/compiler/phase/synthesis.lux)0
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux (renamed from stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux)22
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux (renamed from stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux)35
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux (renamed from stdlib/source/test/lux/tool/compiler/phase/synthesis/primitive.lux)12
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux (renamed from stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux)16
-rw-r--r--stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux (renamed from stdlib/source/test/lux/tool/compiler/default/syntax.lux)2
18 files changed, 402 insertions, 178 deletions
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index 5c7f7b9ef..56be46610 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -3,34 +3,34 @@
["_" test (#+ Test)]]
["." / #_
["#." concatenative]
+ [concurrency
+ ["#." actor]
+ ["#." atom]
+ ["#." frp]
+ ["#." process]
+ ["#." promise]
+ ["#." semaphore]
+ ["#." stm]]
["#." continuation]
["#." exception]
["#." function
+ ["#/." contract]
["#/." memo]
- ["#/." contract]]
+ ["#/." mixin]]
["#." try]
["#." io]
- ["#." parser]
+ ["#." parser
+ ["#/." text]
+ ["#/." cli]]
["#." pipe]
["#." reader]
["#." region]
["#." remember]
+ [security
+ ["#." policy]]
["#." state]
["#." thread]
- ["#." writer]
- [concurrency
- ["#." actor]
- ["#." atom]
- ["#." frp]
- ["#." process]
- ["#." promise]
- ["#." semaphore]
- ["#." stm]]
- ["#." parser #_
- ["#/." text]
- ["#/." cli]]
- [security
- ["#." policy]]])
+ ["#." writer]])
(def: concurrency
Test
@@ -48,8 +48,9 @@
Test
($_ _.and
/function.test
- /function/memo.test
/function/contract.test
+ /function/memo.test
+ /function/mixin.test
))
(def: parser
@@ -70,19 +71,19 @@
Test
($_ _.and
/concatenative.test
+ ..concurrency
/continuation.test
/exception.test
..function
- /try.test
/io.test
..parser
/pipe.test
/reader.test
/region.test
/remember.test
+ ..security
/state.test
/thread.test
+ /try.test
/writer.test
- ..concurrency
- ..security
))
diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux
index fe9362b07..f63de1509 100644
--- a/stdlib/source/test/lux/control/concurrency/actor.lux
+++ b/stdlib/source/test/lux/control/concurrency/actor.lux
@@ -84,14 +84,15 @@
(promise.promise []))]
(:: random.monad wrap
(do promise.monad
- [result (promise.future (do io.monad
- [actor (/.spawn {#/.handle (function (_ message state self)
- (message state self))
- #/.end (function (_ cause state)
- (promise.future (write cause)))}
- write)
- _ (/.poison actor)]
- (promise.poll read)))]
+ [_ (promise.future (do io.monad
+ [actor (/.spawn {#/.handle (function (_ message state self)
+ (message state self))
+ #/.end (function (_ cause state)
+ (promise.future (write cause)))}
+ write)]
+ (/.poison actor)))
+ _ (promise.wait 100)
+ result (promise.future (promise.poll read))]
(_.claim [/.poisoned]
(case result
(#.Some error)
diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux
index 5b5c91271..a00b8bc58 100644
--- a/stdlib/source/test/lux/control/function/memo.lux
+++ b/stdlib/source/test/lux/control/function/memo.lux
@@ -1,16 +1,20 @@
(.module:
[lux #*
["_" test (#+ Test)]
- [abstract/monad (#+ do)]
- ["%" data/text/format (#+ format)]
+ [abstract
+ [monad (#+ do)]]
[control
["." io (#+ IO)]
- ["." state ("#@." monad)]]
+ ["." state (#+ State) ("#@." monad)]]
[math
- ["r" random]]
+ ["." random]]
[data
+ ["." product]
[number
- ["n" nat]]]
+ ["n" nat]]
+ [collection
+ ["." dictionary (#+ Dictionary)]
+ ["." list ("#@." functor fold)]]]
[time
["." instant]
["." duration (#+ Duration)]]]
@@ -19,14 +23,14 @@
["/#" // #_
["#" mixin]]]})
-(def: (fibonacci fibonacci input)
+(def: (fibonacci recur input)
(/.Memo Nat Nat)
(case input
0 (state@wrap 0)
1 (state@wrap 1)
_ (do state.monad
- [output-1 (fibonacci (n.- 1 input))
- output-2 (fibonacci (n.- 2 input))]
+ [output-1 (recur (n.- 1 input))
+ output-2 (recur (n.- 2 input))]
(wrap (n.+ output-1 output-2)))))
(def: (time function input)
@@ -38,20 +42,58 @@
(wrap [(instant.span before after)
output])))
+(def: milli-seconds
+ (-> Duration Nat)
+ (|>> (duration.query duration.milli-second) .nat))
+
(def: #export test
Test
- (<| (_.context (%.name (name-of /.memoization)))
- (let [fast (/.closed n.hash fibonacci)
- slow (/.none n.hash ..fibonacci)]
- (do r.monad
- [input (wrap 30)
- #let [prefix (format (%.name (name-of /.memoization)) " => " (%.nat input) " => ")]]
- (_.test "Memoization makes certain computations faster."
- (io.run
- (do io.monad
- [[fast-time fast-output] (..time fast input)
- [slow-time slow-output] (..time slow input)
- #let [_ (log! (format prefix " memoized = " (%.duration fast-time)))
- _ (log! (format prefix "non-memoized = " (%.duration slow-time)))]]
- (wrap (and (n.= fast-output slow-output)
- (:: duration.order < slow-time fast-time))))))))))
+ (<| (_.covering /._)
+ (do {@ random.monad}
+ [input (|> random.nat (:: @ map (|>> (n.% 6) (n.+ 20))))])
+ (_.with-cover [/.Memo])
+ ($_ _.and
+ (_.cover [/.closed /.none]
+ (io.run
+ (do io.monad
+ [#let [slow (/.none n.hash ..fibonacci)
+ fast (/.closed n.hash fibonacci)]
+ [slow-time slow-output] (..time slow input)
+ [fast-time fast-output] (..time fast input)]
+ (wrap (and (n.= slow-output
+ fast-output)
+ (n.< (milli-seconds slow-time)
+ (milli-seconds fast-time)))))))
+ (_.cover [/.open]
+ (io.run
+ (do io.monad
+ [#let [none (/.none n.hash ..fibonacci)
+ memory (dictionary.new n.hash)
+ open (/.open fibonacci)]
+ [none-time none-output] (..time none input)
+ [open-time [memory open-output]] (..time open [memory input])
+ [open-time/+1 _] (..time open [memory (inc input)])]
+ (wrap (and (n.= none-output
+ open-output)
+ (n.< (milli-seconds none-time)
+ (milli-seconds open-time))
+ (n.< (milli-seconds open-time)
+ (milli-seconds open-time/+1)))))))
+ (_.cover [/.memoization]
+ (let [memo (<| //.mixin
+ (//.inherit /.memoization)
+ (: (//.Mixin (-> Nat (State (Dictionary Nat Nat) Nat)))
+ (function (factorial delegate recur input)
+ (case input
+ (^or 0 1) (:: state.monad wrap 1)
+ _ (do state.monad
+ [output' (recur (dec input))]
+ (wrap (n.* input output')))))))
+ expected (|> (list.indices input)
+ (list@map inc)
+ (list@fold n.* 1))
+ actual (|> (memo input)
+ (state.run (dictionary.new n.hash))
+ product.right)]
+ (n.= expected actual)))
+ )))
diff --git a/stdlib/source/test/lux/control/function/mixin.lux b/stdlib/source/test/lux/control/function/mixin.lux
new file mode 100644
index 000000000..b9f2e766f
--- /dev/null
+++ b/stdlib/source/test/lux/control/function/mixin.lux
@@ -0,0 +1,135 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [equivalence (#+ Equivalence)]
+ [predicate (#+ Predicate)]
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ ["$." monoid]]}]
+ [control
+ ["." state (#+ State)]]
+ [data
+ ["." product]
+ [number
+ ["n" nat]]
+ [collection
+ ["." list ("#@." functor fold)]]]
+ [math
+ ["." random (#+ Random)]]]
+ {1
+ ["." /]})
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (do {@ random.monad}
+ [input (|> random.nat (:: @ map (|>> (n.% 6) (n.+ 20))))
+ dummy random.nat
+ shift (|> random.nat (random.filter (|>> (n.= dummy) not)))
+ #let [equivalence (: (Equivalence (/.Mixin (-> Nat Nat)))
+ (structure
+ (def: (= left right)
+ (n.= ((/.mixin left) input)
+ ((/.mixin right) input)))))
+ generator (: (Random (/.Mixin (-> Nat Nat)))
+ (do @
+ [output random.nat]
+ (wrap (function (_ delegate recur input)
+ output))))
+ expected (|> (list.indices input)
+ (list@map inc)
+ (list@fold n.* 1))]])
+ ($_ _.and
+ (_.with-cover [/.Mixin]
+ ($_ _.and
+ (_.with-cover [/.monoid]
+ ($monoid.spec equivalence /.monoid generator))
+
+ (_.cover [/.mixin]
+ (let [factorial (/.mixin
+ (function (_ delegate recur input)
+ (case input
+ (^or 0 1) 1
+ _ (n.* input (recur (dec input))))))]
+ (n.= expected
+ (factorial input))))
+ (_.cover [/.inherit]
+ (let [bottom (: (/.Mixin (-> Nat Nat))
+ (function (_ delegate recur input)
+ (case input
+ (^or 0 1) 1
+ _ (delegate input))))
+ multiplication (: (/.Mixin (-> Nat Nat))
+ (function (_ delegate recur input)
+ (n.* input (recur (dec input)))))
+ factorial (/.mixin (/.inherit bottom multiplication))]
+ (n.= expected
+ (factorial input))))
+ (_.cover [/.nothing]
+ (let [loop (: (/.Mixin (-> Nat Nat))
+ (function (_ delegate recur input)
+ (case input
+ (^or 0 1) 1
+ _ (n.* input (delegate (dec input))))))
+ left (/.mixin (/.inherit /.nothing loop))
+ right (/.mixin (/.inherit loop /.nothing))]
+ (and (n.= expected
+ (left input))
+ (n.= expected
+ (right input)))))
+ (_.cover [/.advice]
+ (let [bottom (: (/.Mixin (-> Nat Nat))
+ (function (_ delegate recur input)
+ 1))
+ bottom? (: (Predicate Nat)
+ (function (_ input)
+ (case input
+ (^or 0 1) true
+ _ false)))
+ multiplication (: (/.Mixin (-> Nat Nat))
+ (function (_ delegate recur input)
+ (n.* input (recur (dec input)))))
+ factorial (/.mixin (/.inherit (/.advice bottom? bottom)
+ multiplication))]
+ (n.= expected
+ (factorial input))))
+ (_.cover [/.before]
+ (let [implant (: (-> Nat (State Nat []))
+ (function (_ input)
+ (function (_ state)
+ [shift []])))
+ meld (: (/.Mixin (-> Nat (State Nat Nat)))
+ (function (_ delegate recur input)
+ (function (_ state)
+ [state (n.+ state input)])))
+ function (/.mixin (/.inherit (/.before state.monad implant)
+ meld))]
+ (n.= (n.+ shift input)
+ (|> input function (state.run dummy) product.right))))
+ (_.cover [/.after]
+ (let [implant (: (-> Nat Nat (State Nat []))
+ (function (_ input output)
+ (function (_ state)
+ [shift []])))
+ meld (: (/.Mixin (-> Nat (State Nat Nat)))
+ (function (_ delegate recur input)
+ (function (_ state)
+ [state (n.+ state input)])))
+ function (/.mixin (/.inherit (/.after state.monad implant)
+ meld))]
+ (n.= (n.+ dummy input)
+ (|> input function (state.run dummy) product.right))))
+ ))
+ (_.with-cover [/.Recursive]
+ (_.cover [/.from-recursive]
+ (let [factorial (/.mixin
+ (/.from-recursive
+ (function (_ recur input)
+ (case input
+ (^or 0 1) 1
+ _ (n.* input (recur (dec input)))))))]
+ (n.= expected
+ (factorial input)))))
+ )))
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index 7d1c2676e..5452fbb65 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -3,11 +3,12 @@
["_" test (#+ Test)]]
["." / #_
[compiler
- [default
- ["#." syntax]]
- [phase
- ["#." analysis]
- ["#." synthesis]]]])
+ [language
+ [lux
+ ["#." syntax]
+ [phase
+ ["#." analysis]
+ ["#." synthesis]]]]]])
(def: #export test
Test
diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux
index 06b09fbf9..06b09fbf9 100644
--- a/stdlib/source/test/lux/tool/compiler/phase/analysis.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux
diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux
index 1ca4718c1..71c523649 100644
--- a/stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux
@@ -29,9 +29,13 @@
["/#" //
["#." module]
["#." type]
- ["/#" //
+ ["/#" // #_
["/#" //
- ["#." analysis (#+ Analysis Variant Tag Operation)]]]]]})
+ ["#." analysis (#+ Analysis Variant Tag Operation)]
+ [///
+ ["." phase]
+ [meta
+ ["." archive]]]]]]]})
(def: (exhaustive-weaving branchings)
(-> (List (List Code)) (List (List Code)))
@@ -152,17 +156,18 @@
inputC (input variant-tags+ record-tags+ primitivesC)
[outputT outputC] (r.filter (|>> product.left (is? Any) not)
_primitive.primitive)
- #let [analyse-pm (|>> (/.case _primitive.phase inputC)
- (//type.with-type outputT)
- ////analysis.with-scope
- (do ///.monad
- [_ (//module.declare-tags variant-tags false
- (#.Named [module-name variant-name]
- (type.variant primitivesT)))
- _ (//module.declare-tags record-tags false
- (#.Named [module-name record-name]
- (type.tuple primitivesT)))])
- (//module.with-module 0 module-name))]
+ #let [analyse-pm (function (_ branches)
+ (|> (/.case _primitive.phase branches archive.empty inputC)
+ (//type.with-type outputT)
+ ////analysis.with-scope
+ (do phase.monad
+ [_ (//module.declare-tags variant-tags false
+ (#.Named [module-name variant-name]
+ (type.variant primitivesT)))
+ _ (//module.declare-tags record-tags false
+ (#.Named [module-name record-name]
+ (type.tuple primitivesT)))])
+ (//module.with-module 0 module-name)))]
exhaustive-patterns (exhaustive-branches true variantTC inputC)
#let [exhaustive-branchesC (list@map (branch outputC)
exhaustive-patterns)]]
diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux
index fc07f8963..3dbacc0e2 100644
--- a/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux
@@ -1,6 +1,7 @@
(.module:
[lux #*
- [abstract ["." monad (#+ do)]]
+ [abstract
+ ["." monad (#+ do)]]
[data
["%" text/format (#+ format)]
["." name ("#@." equivalence)]]
@@ -28,16 +29,20 @@
["/#" //
["#." module]
["#." type]
- ["/#" //
+ ["/#" // #_
["/#" //
- ["#." reference]
- ["#." analysis (#+ Analysis Operation)]]]]]})
+ ["#." analysis (#+ Analysis Operation)]
+ [///
+ ["#." reference]
+ ["." phase]
+ [meta
+ ["." archive]]]]]]]})
(def: (check-apply expectedT num-args analysis)
(-> Type Nat (Operation Analysis) Bit)
(|> analysis
(//type.with-type expectedT)
- (///.run _primitive.state)
+ (phase.run _primitive.state)
(case> (#try.Success applyA)
(let [[funcA argsA] (////analysis.application applyA)]
(n.= num-args (list.size argsA)))
@@ -56,21 +61,21 @@
($_ _.and
(_.test "Can analyse function."
(and (|> (//type.with-type (All [a] (-> a outputT))
- (/.function _primitive.phase func-name arg-name outputC))
+ (/.function _primitive.phase func-name arg-name archive.empty outputC))
_structure.check-succeeds)
(|> (//type.with-type (All [a] (-> a a))
- (/.function _primitive.phase func-name arg-name g!arg))
+ (/.function _primitive.phase func-name arg-name archive.empty g!arg))
_structure.check-succeeds)))
(_.test "Generic functions can always be specialized."
(and (|> (//type.with-type (-> inputT outputT)
- (/.function _primitive.phase func-name arg-name outputC))
+ (/.function _primitive.phase func-name arg-name archive.empty outputC))
_structure.check-succeeds)
(|> (//type.with-type (-> inputT inputT)
- (/.function _primitive.phase func-name arg-name g!arg))
+ (/.function _primitive.phase func-name arg-name archive.empty g!arg))
_structure.check-succeeds)))
(_.test "The function's name is bound to the function's type."
(|> (//type.with-type (Rec self (-> inputT self))
- (/.function _primitive.phase func-name arg-name (code.local-identifier func-name)))
+ (/.function _primitive.phase func-name arg-name archive.empty (code.local-identifier func-name)))
_structure.check-succeeds))
))))
@@ -102,19 +107,19 @@
(<| (_.context (%.name (name-of /.apply)))
($_ _.and
(_.test "Can analyse monomorphic type application."
- (|> (/.apply _primitive.phase funcT dummy-function (' []) inputsC)
+ (|> (/.apply _primitive.phase inputsC funcT dummy-function archive.empty (' []))
(check-apply outputT full-args)))
(_.test "Can partially apply functions."
- (|> (/.apply _primitive.phase funcT dummy-function (' []) (list.take partial-args inputsC))
+ (|> (/.apply _primitive.phase (list.take partial-args inputsC) funcT dummy-function archive.empty (' []))
(check-apply partialT partial-args)))
(_.test "Can apply polymorphic functions."
- (|> (/.apply _primitive.phase polyT dummy-function (' []) inputsC)
+ (|> (/.apply _primitive.phase inputsC polyT dummy-function archive.empty (' []))
(check-apply poly-inputT full-args)))
(_.test "Polymorphic partial application propagates found type-vars."
- (|> (/.apply _primitive.phase polyT dummy-function (' []) (list.take (inc var-idx) inputsC))
+ (|> (/.apply _primitive.phase (list.take (inc var-idx) inputsC) polyT dummy-function archive.empty (' []))
(check-apply partial-polyT1 (inc var-idx))))
(_.test "Polymorphic partial application preserves quantification for type-vars."
- (|> (/.apply _primitive.phase polyT dummy-function (' []) (list.take var-idx inputsC))
+ (|> (/.apply _primitive.phase (list.take var-idx inputsC) polyT dummy-function archive.empty (' []))
(check-apply partial-polyT2 var-idx)))
))))
diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux
index 57c3152d9..d2864e6a1 100644
--- a/stdlib/source/test/lux/tool/compiler/phase/analysis/primitive.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux
@@ -1,7 +1,8 @@
(.module:
[lux (#- primitive)
["@" target]
- [abstract ["." monad (#+ do)]]
+ [abstract
+ ["." monad (#+ do)]]
[data
["%" text/format (#+ format)]
["." name]]
@@ -18,22 +19,25 @@
["." /
["/#" //
["#." type]
- ["/#" //
- [macro (#+ Expander)]
+ ["/#" // #_
[extension
["." bundle]
["#." analysis]]
- ["/#" //
- ["#." analysis (#+ Analysis Operation)]
- [default
- [evaluation (#+ Eval)]
- ["." init]]]]]]})
+ ["/#" // #_
+ ["." version]
+ ["#." analysis (#+ Analysis Operation)
+ [macro (#+ Expander)]
+ [evaluation (#+ Eval)]]
+ [///
+ ["." phase]
+ [meta
+ ["." archive]]]]]]]})
(def: #export (expander macro inputs state)
Expander
(#try.Failure "NOPE"))
-(def: #export (eval count type expression)
+(def: #export (eval archive count type expression)
Eval
(function (_ state)
(#try.Failure "NO!")))
@@ -45,7 +49,7 @@
(def: #export state
////analysis.State+
[(///analysis.bundle ..eval bundle.empty)
- (////analysis.state (init.info @.jvm) [])])
+ (////analysis.state (////analysis.info version.version @.jvm))])
(def: #export primitive
(Random [Type Code])
@@ -71,7 +75,7 @@
(-> Type (Operation Analysis) (Try Analysis))
(|> analysis
//type.with-inference
- (///.run ..state)
+ (phase.run ..state)
(case> (#try.Success [inferred-type output])
(if (is? expected-type inferred-type)
(#try.Success output)
@@ -84,7 +88,7 @@
(<| (_.context (name.module (name-of /._)))
(`` ($_ _.and
(_.test (%.name (name-of #////analysis.Unit))
- (|> (infer Any (..phase (' [])))
+ (|> (infer Any (..phase archive.empty (' [])))
(case> (^ (#try.Success (#////analysis.Primitive (#////analysis.Unit output))))
(is? [] output)
@@ -94,7 +98,7 @@
[(do r.monad
[sample <random>]
(_.test (%.name (name-of <tag>))
- (|> (infer <type> (..phase (<constructor> sample)))
+ (|> (infer <type> (..phase archive.empty (<constructor> sample)))
(case> (#try.Success (#////analysis.Primitive (<tag> output)))
(is? sample output)
diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux
index 9cb0c1170..7197dbca6 100644
--- a/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux
@@ -23,10 +23,14 @@
["#." scope]
["#." module]
["#." type]
- ["/#" //
+ ["/#" // #_
["/#" //
- ["#." reference]
- ["#." analysis (#+ Analysis Variant Tag Operation)]]]]]})
+ ["#." analysis (#+ Analysis Variant Tag Operation)]
+ [///
+ ["#." reference]
+ ["." phase]
+ [meta
+ ["." archive]]]]]]]})
(type: Check (-> (Try Any) Bit))
@@ -45,7 +49,7 @@
(def: (reach-test var-name [export? def-module] [import? dependent-module] check!)
(-> Text [Bit Text] [Bit Text] Check Bit)
- (|> (do {@ ///.monad}
+ (|> (do {@ phase.monad}
[_ (//module.with-module 0 def-module
(//module.define var-name (#.Right [export? Any (' {}) []])))]
(//module.with-module 0 dependent-module
@@ -54,8 +58,8 @@
(//module.import def-module)
(wrap []))]
(//type.with-inference
- (_primitive.phase (code.identifier [def-module var-name]))))))
- (///.run _primitive.state)
+ (_primitive.phase archive.empty (code.identifier [def-module var-name]))))))
+ (phase.run _primitive.state)
check!))
(def: #export test
@@ -72,8 +76,8 @@
(|> (//scope.with-scope scope-name
(//scope.with-local [var-name expectedT]
(//type.with-inference
- (_primitive.phase (code.local-identifier var-name)))))
- (///.run _primitive.state)
+ (_primitive.phase archive.empty (code.local-identifier var-name)))))
+ (phase.run _primitive.state)
(case> (^ (#try.Success [inferredT (#////analysis.Reference (////reference.local var))]))
(and (type@= expectedT inferredT)
(n.= 0 var))
@@ -82,12 +86,12 @@
false)))
(_.test "Can analyse definition (in the same module)."
(let [def-name [def-module var-name]]
- (|> (do ///.monad
+ (|> (do phase.monad
[_ (//module.define var-name (#.Right [false expectedT (' {}) []]))]
(//type.with-inference
- (_primitive.phase (code.identifier def-name))))
+ (_primitive.phase archive.empty (code.identifier def-name))))
(//module.with-module 0 def-module)
- (///.run _primitive.state)
+ (phase.run _primitive.state)
(case> (^ (#try.Success [_ inferredT (#////analysis.Reference (////reference.constant constant-name))]))
(and (type@= expectedT inferredT)
(name@= def-name constant-name))
diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux
index 05461adf6..fb3c1fe60 100644
--- a/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux
@@ -30,14 +30,18 @@
["/#" //
["#." module]
["#." type]
- ["/#" //
+ ["/#" // #_
["/#" //
- ["#." analysis (#+ Analysis Variant Tag Operation)]]]]]})
+ ["#." analysis (#+ Analysis Variant Tag Operation)]
+ [///
+ ["." phase]
+ [meta
+ ["." archive]]]]]]]})
(template [<name> <on-success> <on-error>]
[(def: #export <name>
(All [a] (-> (Operation a) Bit))
- (|>> (///.run _primitive.state)
+ (|>> (phase.run _primitive.state)
(case> (#try.Success _)
<on-success>
@@ -65,7 +69,7 @@
(-> Type Tag Nat (Operation Analysis) Bit)
(|> analysis
(//type.with-type type)
- (///.run _primitive.state)
+ (phase.run _primitive.state)
(case> (^ (#try.Success (////analysis.variant variant)))
(check-sum' tag size variant)
@@ -74,7 +78,7 @@
(def: (with-tags module tags type)
(All [a] (-> Text (List //module.Tag) Type (Operation a) (Operation [Module a])))
- (|>> (do ///.monad
+ (|>> (do phase.monad
[_ (//module.declare-tags tags false type)])
(//module.with-module 0 module)))
@@ -83,7 +87,7 @@
(|> analysis
(with-tags module tags variantT)
(//type.with-type expectedT)
- (///.run _primitive.state)
+ (phase.run _primitive.state)
(case> (^ (#try.Success [_ (////analysis.variant variant)]))
(check-sum' tag (list.size tags) variant)
@@ -105,7 +109,7 @@
(|> analysis
(with-tags module tags recordT)
(//type.with-type expectedT)
- (///.run _primitive.state)
+ (phase.run _primitive.state)
(case> (#try.Success [_ productA])
(correct-size? size productA)
@@ -131,36 +135,36 @@
($_ _.and
(_.test "Can analyse."
(check-sum variantT choice size
- (/.sum _primitive.phase choice valueC)))
+ (/.sum _primitive.phase choice archive.empty valueC)))
(_.test "Can analyse through bound type-vars."
- (|> (do ///.monad
+ (|> (do phase.monad
[[_ varT] (//type.with-env check.var)
_ (//type.with-env
(check.check varT variantT))]
(//type.with-type varT
- (/.sum _primitive.phase choice valueC)))
- (///.run _primitive.state)
+ (/.sum _primitive.phase choice archive.empty valueC)))
+ (phase.run _primitive.state)
(case> (^ (#try.Success (////analysis.variant variant)))
(check-sum' choice size variant)
_
false)))
(_.test "Cannot analyse through unbound type-vars."
- (|> (do ///.monad
+ (|> (do phase.monad
[[_ varT] (//type.with-env check.var)]
(//type.with-type varT
- (/.sum _primitive.phase choice valueC)))
+ (/.sum _primitive.phase choice archive.empty valueC)))
check-fails))
(_.test "Can analyse through existential quantification."
(|> (//type.with-type (type.ex-q 1 +variantT)
- (/.sum _primitive.phase +choice +valueC))
+ (/.sum _primitive.phase +choice archive.empty +valueC))
check-succeeds))
(_.test "Can analyse through universal quantification."
(let [check-outcome (if (not (n.= choice +choice))
check-succeeds
check-fails)]
(|> (//type.with-type (type.univ-q 1 +variantT)
- (/.sum _primitive.phase +choice +valueC))
+ (/.sum _primitive.phase +choice archive.empty +valueC))
check-outcome)))
))))
@@ -180,8 +184,8 @@
($_ _.and
(_.test "Can analyse."
(|> (//type.with-type tupleT
- (/.product _primitive.phase (list@map product.right primitives)))
- (///.run _primitive.state)
+ (/.product archive.empty _primitive.phase (list@map product.right primitives)))
+ (phase.run _primitive.state)
(case> (#try.Success tupleA)
(correct-size? size tupleA)
@@ -189,8 +193,8 @@
false)))
(_.test "Can infer."
(|> (//type.with-inference
- (/.product _primitive.phase (list@map product.right primitives)))
- (///.run _primitive.state)
+ (/.product archive.empty _primitive.phase (list@map product.right primitives)))
+ (phase.run _primitive.state)
(case> (#try.Success [_type tupleA])
(and (check.checks? tupleT _type)
(correct-size? size tupleA))
@@ -199,16 +203,16 @@
false)))
(_.test "Can analyse singleton."
(|> (//type.with-type singletonT
- (_primitive.phase (` [(~ singletonC)])))
+ (_primitive.phase archive.empty (` [(~ singletonC)])))
check-succeeds))
(_.test "Can analyse through bound type-vars."
- (|> (do ///.monad
+ (|> (do phase.monad
[[_ varT] (//type.with-env check.var)
_ (//type.with-env
(check.check varT (type.tuple (list@map product.left primitives))))]
(//type.with-type varT
- (/.product _primitive.phase (list@map product.right primitives))))
- (///.run _primitive.state)
+ (/.product archive.empty _primitive.phase (list@map product.right primitives))))
+ (phase.run _primitive.state)
(case> (#try.Success tupleA)
(correct-size? size tupleA)
@@ -216,11 +220,11 @@
false)))
(_.test "Can analyse through existential quantification."
(|> (//type.with-type (type.ex-q 1 +tupleT)
- (/.product _primitive.phase (list@map product.right +primitives)))
+ (/.product archive.empty _primitive.phase (list@map product.right +primitives)))
check-succeeds))
(_.test "Cannot analyse through universal quantification."
(|> (//type.with-type (type.univ-q 1 +tupleT)
- (/.product _primitive.phase (list@map product.right +primitives)))
+ (/.product archive.empty _primitive.phase (list@map product.right +primitives)))
check-fails))
))))
@@ -248,23 +252,23 @@
(<| (_.context (%.name (name-of /.tagged-sum)))
($_ _.and
(_.test "Can infer."
- (|> (/.tagged-sum _primitive.phase [module-name choice-tag] choiceC)
+ (|> (/.tagged-sum _primitive.phase [module-name choice-tag] archive.empty choiceC)
(check-variant module-name tags
monoT (with-name monoT)
choice)))
(_.test "Inference retains universal quantification when type-vars are not bound."
- (|> (/.tagged-sum _primitive.phase [module-name other-choice-tag] other-choiceC)
+ (|> (/.tagged-sum _primitive.phase [module-name other-choice-tag] archive.empty other-choiceC)
(check-variant module-name tags
polyT (with-name polyT)
other-choice)))
(_.test "Can specialize."
(|> (//type.with-type monoT
- (/.tagged-sum _primitive.phase [module-name other-choice-tag] other-choiceC))
+ (/.tagged-sum _primitive.phase [module-name other-choice-tag] archive.empty other-choiceC))
(check-variant module-name tags
monoT (with-name polyT)
other-choice)))
(_.test "Specialization when type-vars get bound."
- (|> (/.tagged-sum _primitive.phase [module-name choice-tag] choiceC)
+ (|> (/.tagged-sum _primitive.phase [module-name choice-tag] archive.empty choiceC)
(check-variant module-name tags
monoT (with-name polyT)
choice)))
@@ -291,7 +295,7 @@
(#.Named [module-name type-name]))]]
(<| (_.context (%.name (name-of /.record)))
(_.test "Can infer."
- (|> (/.record _primitive.phase recordC)
+ (|> (/.record archive.empty _primitive.phase recordC)
(check-record module-name tags monoT monoT size))))))
(def: #export test
diff --git a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux
index df4e5a7e5..a7686e0f2 100644
--- a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux
@@ -1,6 +1,7 @@
(.module:
[lux (#- i64 int primitive)
- [abstract ["." monad (#+ do)]]
+ [abstract
+ ["." monad (#+ do)]]
[data
["%" text/format (#+ format)]
["." name]]
@@ -22,18 +23,22 @@
["_." primitive]]]
{1
["." /
- ["///#" ////
+ ["///#" //// #_
[analysis
["#." scope]
- ["#." type]]]]})
+ ["#." type]]
+ [////
+ ["." phase]
+ [meta
+ ["." archive]]]]]})
(template [<name> <success> <failure>]
[(def: (<name> procedure params output-type)
(-> Text (List Code) Type Bit)
(|> (////scope.with-scope ""
(////type.with-type output-type
- (_primitive.phase (` ((~ (code.text procedure)) (~+ params))))))
- (////.run _primitive.state)
+ (_primitive.phase archive.empty (` ((~ (code.text procedure)) (~+ params))))))
+ (phase.run _primitive.state)
(case> (#try.Success _)
<success>
diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux
index da9937862..da9937862 100644
--- a/stdlib/source/test/lux/tool/compiler/phase/synthesis.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux
diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux
index 263f5e4a7..5f9f14321 100644
--- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux
@@ -15,13 +15,17 @@
{1
["." /
["/#" //
- ["/#" //
+ ["/#" // #_
[extension
["#." bundle]]
["/#" //
- ["#." reference]
["#." analysis (#+ Branch Analysis)]
- ["#." synthesis (#+ Synthesis)]]]]]})
+ ["#." synthesis (#+ Synthesis)]
+ [///
+ ["#." reference]
+ ["." phase]
+ [meta
+ ["." archive]]]]]]]})
(def: dummy-vars
Test
@@ -35,8 +39,8 @@
(list)]])]]
(_.test "Dummy variables created to mask expressions get eliminated during synthesis."
(|> maskA
- //.phase
- (///.run [///bundle.empty ////synthesis.init])
+ (//.phase archive.empty)
+ (phase.run [///bundle.empty ////synthesis.init])
(try@map (//primitive.corresponds? maskedA))
(try.default false)))))
@@ -53,8 +57,8 @@
(list)]])]]
(_.test "Can detect and reify simple 'let' expressions."
(|> letA
- //.phase
- (///.run [///bundle.empty ////synthesis.init])
+ (//.phase archive.empty)
+ (phase.run [///bundle.empty ////synthesis.init])
(case> (^ (#try.Success (////synthesis.branch/let [inputS registerS outputS])))
(and (n.= registerA registerS)
(//primitive.corresponds? inputA inputS)
@@ -81,8 +85,8 @@
(////analysis.control/case [inputA [elseB (list thenB)]]))]]
(_.test "Can detect and reify simple 'if' expressions."
(|> ifA
- //.phase
- (///.run [///bundle.empty ////synthesis.init])
+ (//.phase archive.empty)
+ (phase.run [///bundle.empty ////synthesis.init])
(case> (^ (#try.Success (////synthesis.branch/if [inputS thenS elseS])))
(and (//primitive.corresponds? inputA inputS)
(//primitive.corresponds? thenA thenS)
diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux
index 1a4993c92..799a8a526 100644
--- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux
@@ -1,6 +1,7 @@
(.module:
[lux #*
- [abstract ["." monad (#+ do)]]
+ [abstract
+ ["." monad (#+ do)]]
[data
["." name]]
["r" math/random (#+ Random) ("#@." monad)]
@@ -22,14 +23,18 @@
{1
["." /
["/#" //
- ["/#" //
+ ["/#" // #_
[extension
["#." bundle]]
["/#" //
- [arity (#+ Arity)]
- ["#." reference (#+ Variable) ("variable@." equivalence)]
["#." analysis (#+ Analysis)]
- ["#." synthesis (#+ Synthesis)]]]]]})
+ ["#." synthesis (#+ Synthesis)]
+ [///
+ [arity (#+ Arity)]
+ ["#." reference (#+ Variable) ("variable@." equivalence)]
+ ["." phase]
+ [meta
+ ["." archive]]]]]]]})
(def: constant-function
(Random [Arity Analysis Analysis])
@@ -117,8 +122,8 @@
($_ _.and
(_.test "Nested functions will get folded together."
(|> function//constant
- //.phase
- (///.run [///bundle.empty ////synthesis.init])
+ (//.phase archive.empty)
+ (phase.run [///bundle.empty ////synthesis.init])
(case> (^ (#try.Success (////synthesis.function/abstraction [environment arity output])))
(and (n.= arity//constant arity)
(//primitive.corresponds? prediction//constant output))
@@ -127,8 +132,8 @@
(n.= 0 arity//constant))))
(_.test "Folded functions provide direct access to environment variables."
(|> function//environment
- //.phase
- (///.run [///bundle.empty ////synthesis.init])
+ (//.phase archive.empty)
+ (phase.run [///bundle.empty ////synthesis.init])
(case> (^ (#try.Success (////synthesis.function/abstraction [environment arity (#////synthesis.Reference (////reference.variable output))])))
(and (n.= arity//environment arity)
(variable@= prediction//environment output))
@@ -137,8 +142,8 @@
#0)))
(_.test "Folded functions properly offset local variables."
(|> function//local
- //.phase
- (///.run [///bundle.empty ////synthesis.init])
+ (//.phase archive.empty)
+ (phase.run [///bundle.empty ////synthesis.init])
(case> (^ (#try.Success (////synthesis.function/abstraction [environment arity (#////synthesis.Reference (////reference.variable output))])))
(and (n.= arity//local arity)
(variable@= prediction//local output))
@@ -156,8 +161,8 @@
($_ _.and
(_.test "Can synthesize function application."
(|> (////analysis.apply [funcA argsA])
- //.phase
- (///.run [///bundle.empty ////synthesis.init])
+ (//.phase archive.empty)
+ (phase.run [///bundle.empty ////synthesis.init])
(case> (^ (#try.Success (////synthesis.function/apply [funcS argsS])))
(and (//primitive.corresponds? funcA funcS)
(list.every? (product.uncurry //primitive.corresponds?)
@@ -167,8 +172,8 @@
#0)))
(_.test "Function application on no arguments just synthesizes to the function itself."
(|> (////analysis.apply [funcA (list)])
- //.phase
- (///.run [///bundle.empty ////synthesis.init])
+ (//.phase archive.empty)
+ (phase.run [///bundle.empty ////synthesis.init])
(case> (#try.Success funcS)
(//primitive.corresponds? funcA funcS)
diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux
index d9d24ea21..cd7fe54eb 100644
--- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/primitive.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux
@@ -12,12 +12,16 @@
{1
["." / #_
["/#" //
- ["/#" //
+ ["/#" // #_
[extension
["#." bundle]]
["/#" //
["#." analysis (#+ Analysis)]
- ["#." synthesis (#+ Synthesis)]]]]]})
+ ["#." synthesis (#+ Synthesis)]
+ [///
+ ["." phase]
+ [meta
+ ["." archive]]]]]]]})
(def: #export primitive
(Random Analysis)
@@ -63,8 +67,8 @@
[expected <generator>]
(_.test (%.name (name-of <synthesis>))
(|> (#////analysis.Primitive (<analysis> expected))
- //.phase
- (///.run [///bundle.empty ////synthesis.init])
+ (//.phase archive.empty)
+ (phase.run [///bundle.empty ////synthesis.init])
(case> (#try.Success (#////synthesis.Primitive (<synthesis> actual)))
(is? expected actual)
diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux
index d59065782..7dea796fc 100644
--- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux
@@ -21,12 +21,16 @@
{1
["." / #_
["/#" //
- ["/#" //
+ ["/#" // #_
[extension
["#." bundle]]
["/#" //
["#." analysis (#+ Analysis)]
- ["#." synthesis (#+ Synthesis)]]]]]})
+ ["#." synthesis (#+ Synthesis)]
+ [///
+ ["." phase]
+ [meta
+ ["." archive]]]]]]]})
(def: variant
Test
@@ -40,8 +44,8 @@
memberA //primitive.primitive]
(_.test "Can synthesize variants."
(|> (////analysis.variant [lefts right? memberA])
- //.phase
- (///.run [///bundle.empty ////synthesis.init])
+ (//.phase archive.empty)
+ (phase.run [///bundle.empty ////synthesis.init])
(case> (^ (#try.Success (////synthesis.variant [leftsS right?S valueS])))
(let [tagS (if right?S (inc leftsS) leftsS)]
(and (n.= tagA tagS)
@@ -58,8 +62,8 @@
membersA (r.list size //primitive.primitive)]
(_.test "Can synthesize tuple."
(|> (////analysis.tuple membersA)
- //.phase
- (///.run [///bundle.empty ////synthesis.init])
+ (//.phase archive.empty)
+ (phase.run [///bundle.empty ////synthesis.init])
(case> (^ (#try.Success (////synthesis.tuple membersS)))
(and (n.= size (list.size membersS))
(list.every? (product.uncurry //primitive.corresponds?)
diff --git a/stdlib/source/test/lux/tool/compiler/default/syntax.lux b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux
index 4baa57891..103dc069e 100644
--- a/stdlib/source/test/lux/tool/compiler/default/syntax.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux
@@ -91,7 +91,7 @@
(:: code.equivalence = parsed sample)))
(do @
[other code^]
- (_.test "Can parse Lux multiple code nodes."
+ (_.test "Can parse multiple Lux code nodes."
(let [source-code (format (%.code sample) " " (%.code other))
source-code//size (text.size source-code)]
(case (/.parse "" (dictionary.new text.hash) source-code//size