aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--new-luxc/test/test/luxc/lang/analysis/type.lux93
-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
4 files changed, 96 insertions, 112 deletions
diff --git a/new-luxc/test/test/luxc/lang/analysis/type.lux b/new-luxc/test/test/luxc/lang/analysis/type.lux
deleted file mode 100644
index dc1a0fea9..000000000
--- a/new-luxc/test/test/luxc/lang/analysis/type.lux
+++ /dev/null
@@ -1,93 +0,0 @@
-(.module:
- lux
- (lux [io]
- (control [monad #+ do]
- pipe)
- (data [bit "bit/" Eq<Bit>]
- [text "text/" Eq<Text>]
- (text format
- ["l" lexer])
- [number]
- ["e" error]
- [product]
- (coll [list "list/" Functor<List> Fold<List>]))
- ["r" math/random "r/" Monad<Random>]
- [macro #+ Monad<Meta>]
- (macro [code])
- (lang [type "type/" Eq<Type>])
- test)
- (luxc ["&" lang]
- (lang ["&." module]
- ["~" analysis]
- (analysis [".A" expression]
- ["@" type]
- ["@." common])
- (translation (jvm ["@." runtime]))
- [eval]))
- (// common)
- (test/luxc common))
-
-(def: check
- (r.Random [Code Type Code])
- (with-expansions [<triples> (template [<random> <type> <code>]
- [(do r.Monad<Random>
- [value <random>]
- (wrap [(` <type>)
- <type>
- (<code> value)]))]
-
- [r.bit (+0 "#Bit" (+0)) code.bit]
- [r.nat (+0 "#Nat" (+0)) code.nat]
- [r.int (+0 "#Int" (+0)) code.int]
- [r.rev (+0 "#Rev" (+0)) code.rev]
- [r.frac (+0 "#Frac" (+0)) code.frac]
- [(r.text +5) (+0 "#Text" (+0)) code.text]
- )]
- ($_ r.either
- <triples>)))
-
-(context: "Type checking/coercion."
- (<| (times +100)
- (do @
- [[typeC codeT exprC] check]
- ($_ seq
- (test (format "Can analyse type-checking.")
- (|> (do Monad<Meta>
- [runtime-bytecode @runtime.translate]
- (&.with-scope
- (@common.with-unknown-type
- (@.analyse-check analyse eval.eval typeC exprC))))
- (&.with-current-module "")
- (macro.run (io.run init-jvm))
- (case> (#e.Success [_ [analysisT analysisA]])
- (and (type/= codeT analysisT)
- (case [exprC analysisA]
- (^template [<tag> <test>]
- [[_ (<tag> expected)] [_ (<tag> actual)]]
- (<test> expected actual))
- ([#.Bit bit/=]
- [#.Nat n/=]
- [#.Int i/=]
- [#.Rev r/=]
- [#.Frac f/=]
- [#.Text text/=])
-
- _
- #0))
-
- (#e.Error error)
- #0)))
- (test (format "Can analyse type-coercion.")
- (|> (do Monad<Meta>
- [runtime-bytecode @runtime.translate]
- (&.with-scope
- (@common.with-unknown-type
- (@.analyse-coerce analyse eval.eval typeC exprC))))
- (&.with-current-module "")
- (macro.run (io.run init-jvm))
- (case> (#e.Success [_ [analysisT analysisA]])
- (type/= codeT analysisT)
-
- (#e.Error error)
- #0)))
- ))))
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)])))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-16 20:34:12 +0000