aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/spec
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/spec')
-rw-r--r--stdlib/source/spec/compositor.lux101
-rw-r--r--stdlib/source/spec/compositor/common.lux72
-rw-r--r--stdlib/source/spec/compositor/generation/case.lux13
-rw-r--r--stdlib/source/spec/compositor/generation/common.lux3
-rw-r--r--stdlib/source/spec/compositor/generation/function.lux5
-rw-r--r--stdlib/source/spec/compositor/generation/primitive.lux5
-rw-r--r--stdlib/source/spec/compositor/generation/reference.lux9
-rw-r--r--stdlib/source/spec/compositor/generation/structure.lux9
8 files changed, 142 insertions, 75 deletions
diff --git a/stdlib/source/spec/compositor.lux b/stdlib/source/spec/compositor.lux
index 4967c0f8c..5f46aad84 100644
--- a/stdlib/source/spec/compositor.lux
+++ b/stdlib/source/spec/compositor.lux
@@ -1,72 +1,61 @@
(.module:
[lux #*
+ ["_" test (#+ Test)]
[abstract
[monad (#+ do)]]
[control
["." io (#+ IO)]]
[data
- ["." error (#+ Error)]]
+ ["." error]]
+ [math
+ ["r" random]]
[tool
[compiler
- ["." reference]
- ["." synthesis (#+ Synthesis)]
- ["." statement]
- ["." phase
- ["." macro (#+ Expander)]
- ["." generation (#+ Operation Bundle)]
- [extension
- ["." bundle]]]
+ [phase
+ [macro (#+ Expander)]
+ [generation (#+ Bundle)]]
[default
- ["." platform (#+ Platform)]]]]])
+ [platform (#+ Platform)]]]]]
+ ["." / #_
+ ["#." common (#+ Runner Definer)]
+ ["#./" generation #_
+ ["#." primitive]
+ ["#." structure]
+ ["#." reference]
+ ["#." case]
+ ["#." function]
+ ["#." common]]])
-(type: #export Runner (-> Text Synthesis (Error Any)))
-(type: #export Definer (-> Name Synthesis (Error Any)))
+(def: (test runner definer)
+ (-> Runner Definer Test)
+ ($_ _.and
+ (/generation/primitive.spec runner)
+ (/generation/structure.spec runner)
+ (/generation/reference.spec runner definer)
+ (/generation/case.spec runner)
+ (/generation/function.spec runner)
+ (/generation/common.spec runner)
+ ))
-(type: #export (Instancer what)
+(def: #export (spec platform bundle expander program)
(All [anchor expression statement]
- (-> (Platform IO anchor expression statement)
- (generation.State+ anchor expression statement)
- what)))
-
-(def: (runner (^slots [#platform.runtime #platform.phase #platform.host]) state)
- (Instancer Runner)
- (function (_ evaluation-name expressionS)
- (do error.monad
- [expressionG (<| (phase.run state)
- generation.with-buffer
- (do phase.monad
- [_ runtime]
- (phase expressionS)))]
- (:: host evaluate! evaluation-name expressionG))))
-
-(def: (definer (^slots [#platform.runtime #platform.phase #platform.host])
- state)
- (Instancer Definer)
- (function (_ lux-name expressionS)
- (do error.monad
- [definitionG (<| (phase.run state)
- generation.with-buffer
- (do phase.monad
- [_ runtime
- expressionG (phase expressionS)
- [host-name host-value host-statement] (generation.define! lux-name expressionG)
- _ (generation.learn lux-name host-name)]
- (phase (synthesis.constant lux-name))))]
- (:: host evaluate! "definer" definitionG))))
-
-(def: #export (executors platform bundle expander program)
- (All [anchor expression statement]
- (-> (Platform IO anchor expression statement)
+ (-> (IO (Platform IO anchor expression statement))
(Bundle anchor expression statement)
Expander
(-> expression statement)
- (IO (Error [Runner Definer]))))
- (do io.monad
- [?state (platform.initialize expander platform bundle program)]
- (wrap (do error.monad
- [[bundle' state] ?state
- #let [state (get@ [#statement.generation
- #statement.state]
- state)]]
- (wrap [(..runner platform state)
- (..definer platform state)])))))
+ Test))
+ (do r.monad
+ [_ (wrap [])
+ #let [?runner,definer (<| io.run
+ (do io.monad
+ [platform platform])
+ (/common.executors platform
+ bundle
+ expander
+ program))]]
+ (case ?runner,definer
+ (#error.Success [runner definer])
+ (..test runner definer)
+
+ (#error.Failure error)
+ (_.fail error))))
diff --git a/stdlib/source/spec/compositor/common.lux b/stdlib/source/spec/compositor/common.lux
new file mode 100644
index 000000000..4967c0f8c
--- /dev/null
+++ b/stdlib/source/spec/compositor/common.lux
@@ -0,0 +1,72 @@
+(.module:
+ [lux #*
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." io (#+ IO)]]
+ [data
+ ["." error (#+ Error)]]
+ [tool
+ [compiler
+ ["." reference]
+ ["." synthesis (#+ Synthesis)]
+ ["." statement]
+ ["." phase
+ ["." macro (#+ Expander)]
+ ["." generation (#+ Operation Bundle)]
+ [extension
+ ["." bundle]]]
+ [default
+ ["." platform (#+ Platform)]]]]])
+
+(type: #export Runner (-> Text Synthesis (Error Any)))
+(type: #export Definer (-> Name Synthesis (Error Any)))
+
+(type: #export (Instancer what)
+ (All [anchor expression statement]
+ (-> (Platform IO anchor expression statement)
+ (generation.State+ anchor expression statement)
+ what)))
+
+(def: (runner (^slots [#platform.runtime #platform.phase #platform.host]) state)
+ (Instancer Runner)
+ (function (_ evaluation-name expressionS)
+ (do error.monad
+ [expressionG (<| (phase.run state)
+ generation.with-buffer
+ (do phase.monad
+ [_ runtime]
+ (phase expressionS)))]
+ (:: host evaluate! evaluation-name expressionG))))
+
+(def: (definer (^slots [#platform.runtime #platform.phase #platform.host])
+ state)
+ (Instancer Definer)
+ (function (_ lux-name expressionS)
+ (do error.monad
+ [definitionG (<| (phase.run state)
+ generation.with-buffer
+ (do phase.monad
+ [_ runtime
+ expressionG (phase expressionS)
+ [host-name host-value host-statement] (generation.define! lux-name expressionG)
+ _ (generation.learn lux-name host-name)]
+ (phase (synthesis.constant lux-name))))]
+ (:: host evaluate! "definer" definitionG))))
+
+(def: #export (executors platform bundle expander program)
+ (All [anchor expression statement]
+ (-> (Platform IO anchor expression statement)
+ (Bundle anchor expression statement)
+ Expander
+ (-> expression statement)
+ (IO (Error [Runner Definer]))))
+ (do io.monad
+ [?state (platform.initialize expander platform bundle program)]
+ (wrap (do error.monad
+ [[bundle' state] ?state
+ #let [state (get@ [#statement.generation
+ #statement.state]
+ state)]]
+ (wrap [(..runner platform state)
+ (..definer platform state)])))))
diff --git a/stdlib/source/spec/compositor/generation/case.lux b/stdlib/source/spec/compositor/generation/case.lux
index 1c398d301..880a26eae 100644
--- a/stdlib/source/spec/compositor/generation/case.lux
+++ b/stdlib/source/spec/compositor/generation/case.lux
@@ -22,7 +22,8 @@
["#/." synthesis
["." case]]
["." extension/synthesis]]]]]
- ["." ///])
+ [///
+ [common (#+ Runner)]])
(def: limit Nat 10)
@@ -93,7 +94,7 @@
))))
(def: (let-spec run)
- (-> ///.Runner Test)
+ (-> Runner Test)
(do r.monad
[value r.safe-frac]
(_.test (%name (name-of synthesis.branch/let))
@@ -104,7 +105,7 @@
(verify value)))))
(def: (if-spec run)
- (-> ///.Runner Test)
+ (-> Runner Test)
(do r.monad
[on-true r.safe-frac
on-false (|> r.safe-frac (r.filter (|>> (f/= on-true) not)))
@@ -117,7 +118,7 @@
(verify (if verdict on-true on-false))))))
(def: (case-spec run)
- (-> ///.Runner Test)
+ (-> Runner Test)
(do r.monad
[[inputS pathS] ..case
on-success r.safe-frac
@@ -240,7 +241,7 @@
## TODO: Get rid of this ASAP
(def: (special-spec run)
- (-> ///.Runner Test)
+ (-> Runner Test)
($_ _.and
(_.test "==="
(and (text@= (synthesis.%path special-path)
@@ -275,7 +276,7 @@
))
(def: #export (spec run)
- (-> ///.Runner Test)
+ (-> Runner Test)
($_ _.and
(..special-spec run)
(..let-spec run)
diff --git a/stdlib/source/spec/compositor/generation/common.lux b/stdlib/source/spec/compositor/generation/common.lux
index 16ff5aab8..c92859639 100644
--- a/stdlib/source/spec/compositor/generation/common.lux
+++ b/stdlib/source/spec/compositor/generation/common.lux
@@ -22,7 +22,8 @@
["." synthesis]]]]
["." // #_
["#." case]
- ["/#" // (#+ Runner)]])
+ [//
+ [common (#+ Runner)]]])
(def: sanitize
(-> Text Text)
diff --git a/stdlib/source/spec/compositor/generation/function.lux b/stdlib/source/spec/compositor/generation/function.lux
index c9f8f5f56..2a8b4687d 100644
--- a/stdlib/source/spec/compositor/generation/function.lux
+++ b/stdlib/source/spec/compositor/generation/function.lux
@@ -21,7 +21,8 @@
["." synthesis (#+ Synthesis)]]]]
["." // #_
["#." case]
- ["/#" //]])
+ [//
+ [common (#+ Runner)]]])
(def: max-arity Arity 10)
@@ -45,7 +46,7 @@
#synthesis.body (synthesis.variable/local local)})])))
(def: #export (spec run)
- (-> ///.Runner Test)
+ (-> Runner Test)
(do r.monad
[[arity local functionS] ..function
partial-arity (|> r.nat (:: @ map (|>> (n/% arity) (n/max 1))))
diff --git a/stdlib/source/spec/compositor/generation/primitive.lux b/stdlib/source/spec/compositor/generation/primitive.lux
index 788085836..63568fbce 100644
--- a/stdlib/source/spec/compositor/generation/primitive.lux
+++ b/stdlib/source/spec/compositor/generation/primitive.lux
@@ -17,7 +17,8 @@
[tool
[compiler
["." synthesis]]]]
- ["." ///])
+ [///
+ [common (#+ Runner)]])
(def: (f/=' reference subject)
(-> Frac Frac Bit)
@@ -26,7 +27,7 @@
(frac.not-a-number? subject))))
(def: #export (spec run)
- (-> ///.Runner Test)
+ (-> Runner Test)
(`` ($_ _.and
(~~ (template [<evaluation-name> <synthesis> <gen> <test>]
[(do r.monad
diff --git a/stdlib/source/spec/compositor/generation/reference.lux b/stdlib/source/spec/compositor/generation/reference.lux
index 35de4e8ef..066b604dc 100644
--- a/stdlib/source/spec/compositor/generation/reference.lux
+++ b/stdlib/source/spec/compositor/generation/reference.lux
@@ -13,7 +13,8 @@
["." synthesis]]]
[math
["r" random (#+ Random)]]]
- ["." ///])
+ [///
+ [common (#+ Runner Definer)]])
(def: name
(Random Name)
@@ -21,7 +22,7 @@
[(r.and name-part name-part)]))
(def: (definition define)
- (-> ///.Definer Test)
+ (-> Definer Test)
(do r.monad
[name ..name
expected r.safe-frac]
@@ -34,7 +35,7 @@
false)))))
(def: (variable run)
- (-> ///.Runner Test)
+ (-> Runner Test)
(do r.monad
[register (|> r.nat (:: @ map (n/% 100)))
expected r.safe-frac]
@@ -50,7 +51,7 @@
false)))))
(def: #export (spec runner definer)
- (-> ///.Runner ///.Definer Test)
+ (-> Runner Definer Test)
($_ _.and
(..definition definer)
(..variable runner)))
diff --git a/stdlib/source/spec/compositor/generation/structure.lux b/stdlib/source/spec/compositor/generation/structure.lux
index 00334596c..99745a819 100644
--- a/stdlib/source/spec/compositor/generation/structure.lux
+++ b/stdlib/source/spec/compositor/generation/structure.lux
@@ -20,12 +20,13 @@
[compiler
["." analysis]
["." synthesis]]]]
- ["." ///])
+ [///
+ [common (#+ Runner)]])
(import: #long java/lang/Integer)
(def: (variant run)
- (-> ///.Runner Test)
+ (-> Runner Test)
(do r.monad
[num-tags (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
tag-in (|> r.nat (:: @ map (n/% num-tags)))
@@ -60,7 +61,7 @@
false)))))
(def: (tuple run)
- (-> ///.Runner Test)
+ (-> Runner Test)
(do r.monad
[size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
tuple-in (r.list size r.i64)]
@@ -78,7 +79,7 @@
false)))))
(def: #export (spec runner)
- (-> ///.Runner Test)
+ (-> Runner Test)
($_ _.and
(..variant runner)
(..tuple runner)