aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/spec/compositor.lux31
-rw-r--r--stdlib/source/spec/compositor/analysis/type.lux67
-rw-r--r--stdlib/source/spec/compositor/common.lux17
3 files changed, 96 insertions, 19 deletions
diff --git a/stdlib/source/spec/compositor.lux b/stdlib/source/spec/compositor.lux
index 5f46aad84..75818c3cf 100644
--- a/stdlib/source/spec/compositor.lux
+++ b/stdlib/source/spec/compositor.lux
@@ -11,6 +11,8 @@
["r" random]]
[tool
[compiler
+ ["." analysis]
+ ["." statement]
[phase
[macro (#+ Expander)]
[generation (#+ Bundle)]]
@@ -18,6 +20,8 @@
[platform (#+ Platform)]]]]]
["." / #_
["#." common (#+ Runner Definer)]
+ ["#./" analysis #_
+ ["#." type]]
["#./" generation #_
["#." primitive]
["#." structure]
@@ -26,9 +30,10 @@
["#." function]
["#." common]]])
-(def: (test runner definer)
- (-> Runner Definer Test)
+(def: (test runner definer state expander)
+ (-> Runner Definer analysis.State+ Expander Test)
($_ _.and
+ (/analysis/type.spec expander state)
(/generation/primitive.spec runner)
(/generation/structure.spec runner)
(/generation/reference.spec runner definer)
@@ -46,16 +51,18 @@
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)
+ #let [?state,runner,definer (<| io.run
+ (do io.monad
+ [platform platform])
+ (/common.executors platform
+ bundle
+ expander
+ program))]]
+ (case ?state,runner,definer
+ (#error.Success [[statement-bundle statement-state] runner definer])
+ (..test runner definer
+ (get@ [#statement.analysis #statement.state] statement-state)
+ expander)
(#error.Failure error)
(_.fail error))))
diff --git a/stdlib/source/spec/compositor/analysis/type.lux b/stdlib/source/spec/compositor/analysis/type.lux
new file mode 100644
index 000000000..a6105bbde
--- /dev/null
+++ b/stdlib/source/spec/compositor/analysis/type.lux
@@ -0,0 +1,67 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ ["." type ("#@." equivalence)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ [pipe (#+ case>)]
+ ["." io]]
+ [data
+ ["." error]
+ ["." bit ("#@." equivalence)]
+ ["." text ("#@." equivalence)]]
+ [math
+ ["r" random (#+ Random)]]
+ [macro
+ ["." code]]
+ [tool
+ [compiler
+ [analysis (#+ State+)]
+ ["." phase
+ [macro (#+ Expander)]
+ ["." analysis
+ ["#/." scope]
+ ["#/." type]]]]]])
+
+(def: (check-success+ expander state extension params output-type)
+ (-> Expander State+ Text (List Code) Type Bit)
+ (|> (analysis/scope.with-scope ""
+ (analysis/type.with-type output-type
+ (analysis.phase expander (` ((~ (code.text extension)) (~+ params))))))
+ (phase.run state)
+ (case> (#error.Success _)
+ true
+
+ (#error.Failure error)
+ false)))
+
+(def: check
+ (Random [Code Type Code])
+ (`` ($_ r.either
+ (~~ (template [<random> <type> <code>]
+ [(do r.monad
+ [value <random>]
+ (wrap [(` <type>)
+ <type>
+ (<code> value)]))]
+
+ [r.bit (0 "#Bit" (0)) code.bit]
+ [r.nat (0 "#I64" (1 (0 "#Nat" (0)) (0))) code.nat]
+ [r.int (0 "#I64" (1 (0 "#Int" (0)) (0))) code.int]
+ [r.rev (0 "#I64" (1 (0 "#Rev" (0)) (0))) code.rev]
+ [r.safe-frac (0 "#Frac" (0)) code.frac]
+ [(r.ascii/upper-alpha 5) (0 "#Text" (0)) code.text]
+ )))))
+
+(def: #export (spec expander state)
+ (-> Expander State+ Test)
+ (do r.monad
+ [[typeC exprT exprC] ..check
+ [other-typeC other-exprT other-exprC] ..check]
+ ($_ _.and
+ (_.test "lux check"
+ (check-success+ expander state "lux check" (list typeC exprC) exprT))
+ (_.test "lux coerce"
+ (check-success+ expander state "lux coerce" (list typeC other-exprC) exprT))
+ )))
diff --git a/stdlib/source/spec/compositor/common.lux b/stdlib/source/spec/compositor/common.lux
index 4967c0f8c..df332df57 100644
--- a/stdlib/source/spec/compositor/common.lux
+++ b/stdlib/source/spec/compositor/common.lux
@@ -60,13 +60,16 @@
(Bundle anchor expression statement)
Expander
(-> expression statement)
- (IO (Error [Runner Definer]))))
+ (IO (Error [(statement.State+ anchor expression statement)
+ 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)])))))
+ [[statement-bundle statement-state] ?state
+ #let [generation-state (get@ [#statement.generation
+ #statement.state]
+ statement-state)]]
+ (wrap [[statement-bundle statement-state]
+ (..runner platform generation-state)
+ (..definer platform generation-state)])))))