aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/spec/compositor.lux65
-rw-r--r--stdlib/source/spec/compositor/generation/reference.lux56
2 files changed, 101 insertions, 20 deletions
diff --git a/stdlib/source/spec/compositor.lux b/stdlib/source/spec/compositor.lux
index bb90b0cdf..a62d2efa9 100644
--- a/stdlib/source/spec/compositor.lux
+++ b/stdlib/source/spec/compositor.lux
@@ -8,6 +8,7 @@
["." error (#+ Error)]]
[tool
[compiler
+ ["." reference]
["." synthesis (#+ Synthesis)]
["." statement]
["." phase
@@ -21,28 +22,11 @@
(type: #export Runner (-> Text Synthesis (Error Any)))
(type: #export Definer (-> Name Synthesis (Error Any)))
-(def: #export (runner platform bundle expander program)
+(type: #export (Instancer what)
(All [anchor expression statement]
(-> (Platform IO anchor expression statement)
- (Bundle anchor expression statement)
- Expander
- (-> expression statement)
- Runner))
- (function (_ evaluation-name expressionS)
- (io.run
- (do io.monad
- [?state (platform.initialize expander platform bundle program)]
- (wrap (do error.monad
- [[bundle' state] ?state
- expressionG (<| (phase.run (get@ [#statement.generation
- #statement.state]
- state))
- (do phase.monad
- [_ (get@ #platform.runtime platform)]
- ((get@ #platform.phase platform) expressionS)))]
- (:: (get@ #platform.host platform) evaluate! evaluation-name
- expressionG)))))
- ))
+ (generation.State+ anchor expression statement)
+ what)))
## (def: #export (runner generate-runtime translate bundle state)
## (-> (Operation Any) Phase Bundle (IO State)
@@ -55,6 +39,16 @@
## translation.with-buffer
## (phase.run [bundle (io.run state)]))))
+(def: (runner (^slots [#platform.runtime #platform.phase #platform.host]) state)
+ (Instancer Runner)
+ (function (_ evaluation-name expressionS)
+ (do error.monad
+ [expressionG (<| (phase.run state)
+ (do phase.monad
+ [_ runtime]
+ (phase expressionS)))]
+ (:: host evaluate! evaluation-name expressionG))))
+
## (def: #export (definer generate-runtime translate bundle state)
## (-> (Operation Any) Phase Bundle (IO State) Definer)
## (function (_ lux-name valueS)
@@ -67,3 +61,34 @@
## (translation.evaluate! "definer" program))
## translation.with-buffer
## (phase.run [bundle (io.run state)]))))
+
+(def: (definer (^slots [#platform.runtime #platform.phase #platform.host])
+ state)
+ (Instancer Definer)
+ (function (_ lux-name expressionS)
+ (do error.monad
+ [definitionG (<| (phase.run state)
+ (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/reference.lux b/stdlib/source/spec/compositor/generation/reference.lux
new file mode 100644
index 000000000..35de4e8ef
--- /dev/null
+++ b/stdlib/source/spec/compositor/generation/reference.lux
@@ -0,0 +1,56 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ [pipe (#+ case>)]]
+ [data
+ ["." error]]
+ [tool
+ [compiler
+ ["." reference]
+ ["." synthesis]]]
+ [math
+ ["r" random (#+ Random)]]]
+ ["." ///])
+
+(def: name
+ (Random Name)
+ (let [name-part (r.ascii/upper-alpha 5)]
+ [(r.and name-part name-part)]))
+
+(def: (definition define)
+ (-> ///.Definer Test)
+ (do r.monad
+ [name ..name
+ expected r.safe-frac]
+ (_.test "Definitions."
+ (|> (define name (synthesis.f64 expected))
+ (case> (#error.Success actual)
+ (f/= expected (:coerce Frac actual))
+
+ (#error.Failure error)
+ false)))))
+
+(def: (variable run)
+ (-> ///.Runner Test)
+ (do r.monad
+ [register (|> r.nat (:: @ map (n/% 100)))
+ expected r.safe-frac]
+ (_.test "Local variables."
+ (|> (synthesis.branch/let [(synthesis.f64 expected)
+ register
+ (synthesis.variable/local register)])
+ (run "variable")
+ (case> (#error.Success actual)
+ (f/= expected (:coerce Frac actual))
+
+ (#error.Failure error)
+ false)))))
+
+(def: #export (spec runner definer)
+ (-> ///.Runner ///.Definer Test)
+ ($_ _.and
+ (..definition definer)
+ (..variable runner)))