aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/test/program.lux30
-rw-r--r--new-luxc/test/test/luxc/lang/translation/reference.lux86
-rw-r--r--new-luxc/test/tests.lux28
-rw-r--r--stdlib/source/spec/compositor.lux65
-rw-r--r--stdlib/source/spec/compositor/generation/reference.lux56
5 files changed, 121 insertions, 144 deletions
diff --git a/new-luxc/source/test/program.lux b/new-luxc/source/test/program.lux
index 40eb214c2..687c8ca2a 100644
--- a/new-luxc/source/test/program.lux
+++ b/new-luxc/source/test/program.lux
@@ -7,13 +7,16 @@
["." io]
[parser
[cli (#+ program:)]]]
+ [data
+ ["." error]]
[math
["r" random]]]
[spec
- ["." compositor (#+ Runner)
+ ["." compositor (#+ Runner Definer)
[generation
["." primitive]
- ["." structure]]]]
+ ["." structure]
+ ["." reference]]]]
{1
["." /]}
## [test
@@ -21,7 +24,6 @@
## [lang
## [translation
## ## ["_.T" function]
- ## ## ["_.T" reference]
## ## ["_.T" case]
## ## ["_.T" common]
## ## ["_.T" jvm]
@@ -36,11 +38,12 @@
## ]]]]
)
-(def: (test runner)
- (-> Runner Test)
+(def: (test runner definer)
+ (-> Runner Definer Test)
($_ _.and
(primitive.spec runner)
(structure.spec runner)
+ (reference.spec runner definer)
))
(program: args
@@ -49,8 +52,15 @@
(_.times 100)
(do r.monad
[_ (wrap [])
- #let [platform (io.run /.jvm)]])
- (..test (compositor.runner platform
- /.bundle
- /.expander
- /.program))))
+ #let [?runner,definer (io.run (do io.monad
+ [platform /.jvm]
+ (compositor.executors platform
+ /.bundle
+ /.expander
+ /.program)))]]
+ (case ?runner,definer
+ (#error.Success [runner definer])
+ (..test runner definer)
+
+ (#error.Failure error)
+ (_.fail error)))))
diff --git a/new-luxc/test/test/luxc/lang/translation/reference.lux b/new-luxc/test/test/luxc/lang/translation/reference.lux
deleted file mode 100644
index 18205a560..000000000
--- a/new-luxc/test/test/luxc/lang/translation/reference.lux
+++ /dev/null
@@ -1,86 +0,0 @@
-(.module:
- [lux #*
- [control
- [monad (#+ do)]
- pipe]
- [data
- ["." number]]
- [compiler
- [default
- ["." reference]
- [phase
- ["." synthesis]]]]
- [math
- ["r" random (#+ Random)]]
- test]
- [test
- [luxc
- ["." common (#+ Runner Definer)]]]
- [//
- ["&" function]])
-
-(def: name
- (Random Name)
- (let [name-part (r.ascii/upper-alpha 5)]
- [(r.and name-part name-part)]))
-
-(def: (definitions-spec define)
- (-> Definer Test)
- (do r.Monad<Random>
- [name ..name
- value &.safe-frac]
- (test "Can refer to definitions."
- (|> (define name (synthesis.f64 value))
- (&.check value)))))
-
-(def: (variables-spec run)
- (-> Runner Test)
- (do r.Monad<Random>
- [register (|> r.nat (:: @ map (n/% 100)))
- value &.safe-frac]
- (test "Can refer to local variables/registers."
- (|> (run (synthesis.branch/let [(synthesis.f64 value)
- register
- (synthesis.variable/local register)]))
- (&.check value)))))
-
-(def: (references-spec run define)
- (-> Runner Definer Test)
- (seq (definitions-spec define)
- (variables-spec run)))
-
-(context: "[JVM] References."
- (<| (times 100)
- (references-spec common.run-jvm common.def-jvm)))
-
-## (context: "[JS] References."
-## (<| (times 100)
-## (references-spec common.run-js common.def-js)))
-
-## (context: "[Lua] References."
-## (<| (times 100)
-## (references-spec common.run-lua common.def-lua)))
-
-## (context: "[Ruby] References."
-## (<| (times 100)
-## (references-spec common.run-ruby common.def-ruby)))
-
-## (context: "[Python] References."
-## (<| (times 100)
-## (references-spec common.run-python common.def-python)))
-
-## (context: "[R] References."
-## (<| (times 100)
-## (references-spec common.run-r common.def-r)))
-
-## (context: "[Scheme] References."
-## (<| (times 100)
-## (references-spec common.run-scheme common.def-scheme)))
-
-## (context: "[Common Lisp] References."
-## (<| (times 100)
-## (references-spec common.run-common-lisp common.def-common-lisp)))
-
-## (context: "[PHP] References."
-## (<| (times 100)
-## (references-spec common.run-php common.def-php)))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
deleted file mode 100644
index 04362d4d1..000000000
--- a/new-luxc/test/tests.lux
+++ /dev/null
@@ -1,28 +0,0 @@
-(.module:
- [lux
- [cli (#+ program:)]
- ["." test]]
- [test
- [luxc
- [lang
- [translation
- ["_.T" primitive]
- ["_.T" structure]
- ["_.T" function]
- ["_.T" reference]
- ["_.T" case]
- ["_.T" common]
- ## ["_.T" jvm]
- ## ["_.T" js]
- ## ["_.T" lua]
- ## ["_.T" ruby]
- ## ["_.T" python]
- ## ["_.T" r]
- ## ["_.T" scheme]
- ## ["_.T" common-lisp]
- ## ["_.T" php]
- ]]]]
- )
-
-(program: args
- (test.run))
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)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 03:06:29 +0000