aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/test')
-rw-r--r--new-luxc/test/test/luxc/analyser/case.lux3
-rw-r--r--new-luxc/test/test/luxc/analyser/common.lux31
-rw-r--r--new-luxc/test/test/luxc/analyser/function.lux19
-rw-r--r--new-luxc/test/test/luxc/analyser/primitive.lux5
-rw-r--r--new-luxc/test/test/luxc/analyser/procedure/common.lux17
-rw-r--r--new-luxc/test/test/luxc/analyser/reference.lux7
-rw-r--r--new-luxc/test/test/luxc/analyser/structure.lux33
-rw-r--r--new-luxc/test/test/luxc/common.lux34
-rw-r--r--new-luxc/test/test/luxc/generator/primitive.lux58
-rw-r--r--new-luxc/test/test/luxc/generator/structure.lux105
-rw-r--r--new-luxc/test/tests.lux6
11 files changed, 250 insertions, 68 deletions
diff --git a/new-luxc/test/test/luxc/analyser/case.lux b/new-luxc/test/test/luxc/analyser/case.lux
index 218ebc0cd..3fe67b7a3 100644
--- a/new-luxc/test/test/luxc/analyser/case.lux
+++ b/new-luxc/test/test/luxc/analyser/case.lux
@@ -22,7 +22,8 @@
(analyser ["@" case]
["@;" common])
["@;" module])
- (.. common))
+ (.. common)
+ (test/luxc common))
(def: (total-weaving branchings)
(-> (List (List Code)) (List (List Code)))
diff --git a/new-luxc/test/test/luxc/analyser/common.lux b/new-luxc/test/test/luxc/analyser/common.lux
index 5e8f73fd1..9a17fbb45 100644
--- a/new-luxc/test/test/luxc/analyser/common.lux
+++ b/new-luxc/test/test/luxc/analyser/common.lux
@@ -6,33 +6,8 @@
[macro]
(macro [code]))
(luxc ["&" base]
- [analyser]))
-
-(def: compiler-version Text "0.6.0")
-
-(def: init-compiler-info
- Compiler-Info
- {#;compiler-version compiler-version
- #;compiler-mode #;Build})
-
-(def: init-type-context
- Type-Context
- {#;ex-counter +0
- #;var-counter +0
- #;var-bindings (list)})
-
-(def: #export init-compiler
- Compiler
- {#;info init-compiler-info
- #;source [dummy-cursor ""]
- #;cursor dummy-cursor
- #;modules (list)
- #;scopes (list)
- #;type-context init-type-context
- #;expected #;None
- #;seed +0
- #;scope-type-vars (list)
- #;host (:! Void [])})
+ [analyser])
+ (test/luxc common))
(def: gen-unit
(r;Random Code)
@@ -65,7 +40,7 @@
[(def: #export (<name> analysis)
(All [a] (-> (Lux a) Bool))
(|> analysis
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success _)
<on-success>
diff --git a/new-luxc/test/test/luxc/analyser/function.lux b/new-luxc/test/test/luxc/analyser/function.lux
index fe435ebf9..4957bfe06 100644
--- a/new-luxc/test/test/luxc/analyser/function.lux
+++ b/new-luxc/test/test/luxc/analyser/function.lux
@@ -21,7 +21,8 @@
(analyser ["@" function]
["@;" common])
["@;" module])
- (.. common))
+ (.. common)
+ (test/luxc common))
(def: (check-type expectedT result)
(-> Type (R;Result [Type la;Analysis]) Bool)
@@ -54,7 +55,7 @@
(def: (check-apply expectedT num-args analysis)
(-> Type Nat (Lux [Type la;Analysis]) Bool)
(|> analysis
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success [applyT applyA])
(let [[funcA argsA] (flatten-apply applyA)]
(and (Type/= expectedT applyT)
@@ -72,36 +73,36 @@
(assert "Can analyse function."
(|> (&;with-expected-type (type (All [a] (-> a outputT)))
(@;analyse-function analyse func-name arg-name outputC))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
succeeds?))
(assert "Generic functions can always be specialized."
(and (|> (&;with-expected-type (-> inputT outputT)
(@;analyse-function analyse func-name arg-name outputC))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
succeeds?)
(|> (&;with-expected-type (-> inputT inputT)
(@;analyse-function analyse func-name arg-name (code;symbol ["" arg-name])))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
succeeds?)))
(assert "Can infer function (constant output and unused input)."
(|> (@common;with-unknown-type
(@;analyse-function analyse func-name arg-name outputC))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(check-type (type (All [a] (-> a outputT))))))
(assert "Can infer function (output = input)."
(|> (@common;with-unknown-type
(@;analyse-function analyse func-name arg-name (code;symbol ["" arg-name])))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(check-type (type (All [a] (-> a a))))))
(assert "The function's name is bound to the function's type."
(|> (&;with-expected-type (type (Rec self (-> inputT self)))
(@;analyse-function analyse func-name arg-name (code;symbol ["" func-name])))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
succeeds?))
(assert "Can infer recursive types for functions."
(|> (@common;with-unknown-type
(@;analyse-function analyse func-name arg-name (code;symbol ["" func-name])))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(check-type (type (Rec self (All [a] (-> a self)))))))
))
diff --git a/new-luxc/test/test/luxc/analyser/primitive.lux b/new-luxc/test/test/luxc/analyser/primitive.lux
index 11a10088b..5e4e318a5 100644
--- a/new-luxc/test/test/luxc/analyser/primitive.lux
+++ b/new-luxc/test/test/luxc/analyser/primitive.lux
@@ -24,7 +24,8 @@
[analyser]
(analyser ["@" primitive]
["@;" common]))
- (.. common))
+ (.. common)
+ (test/luxc common))
(test: "Primitives"
[%bool% r;bool
@@ -39,7 +40,7 @@
[(assert (format "Can analyse " <desc> ".")
(|> (@common;with-unknown-type
(<analyser> <value>))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success [_type (<tag> value)])
(and (Type/= <type> _type)
(is <value> value))
diff --git a/new-luxc/test/test/luxc/analyser/procedure/common.lux b/new-luxc/test/test/luxc/analyser/procedure/common.lux
index dc4459734..9ebcf6880 100644
--- a/new-luxc/test/test/luxc/analyser/procedure/common.lux
+++ b/new-luxc/test/test/luxc/analyser/procedure/common.lux
@@ -20,14 +20,15 @@
[analyser]
(analyser ["@" procedure]
["@;" common]))
- (../.. common))
+ (../.. common)
+ (test/luxc common))
(do-template [<name> <success> <failure>]
[(def: (<name> procedure params output-type)
(-> Text (List Code) Type Bool)
(|> (&;with-expected-type output-type
(@;analyse-procedure analyse procedure params))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success _)
<success>
@@ -247,7 +248,7 @@
(@;analyse-procedure analyse "array get"
(list idxC
(code;symbol ["" var-name]))))))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success _)
true
@@ -261,7 +262,7 @@
(list idxC
elemC
(code;symbol ["" var-name]))))))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success _)
true
@@ -274,7 +275,7 @@
(@;analyse-procedure analyse "array remove"
(list idxC
(code;symbol ["" var-name]))))))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success _)
true
@@ -286,7 +287,7 @@
(&;with-expected-type Nat
(@;analyse-procedure analyse "array size"
(list (code;symbol ["" var-name]))))))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success _)
true
@@ -342,7 +343,7 @@
(&;with-expected-type elemT
(@;analyse-procedure analyse "atom read"
(list (code;symbol ["" var-name]))))))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success _)
true
@@ -356,7 +357,7 @@
(list elemC
elemC
(code;symbol ["" var-name]))))))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success _)
true
diff --git a/new-luxc/test/test/luxc/analyser/reference.lux b/new-luxc/test/test/luxc/analyser/reference.lux
index 2acec2cad..5e277b2a6 100644
--- a/new-luxc/test/test/luxc/analyser/reference.lux
+++ b/new-luxc/test/test/luxc/analyser/reference.lux
@@ -14,7 +14,8 @@
[analyser]
(analyser ["@" reference]
["@;" common]))
- (.. common))
+ (.. common)
+ (test/luxc common))
(test: "References"
[[ref-type _] gen-primitive
@@ -27,7 +28,7 @@
(&env;with-local [var-name ref-type]
(@common;with-unknown-type
(@;analyse-reference ["" var-name]))))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success [_type (#~;Relative idx)])
(Type/= ref-type _type)
@@ -40,7 +41,7 @@
[ref-type (list) (:! Void [])])]
(@common;with-unknown-type
(@;analyse-reference [module-name var-name])))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success [_type (#~;Absolute idx)])
(Type/= ref-type _type)
diff --git a/new-luxc/test/test/luxc/analyser/structure.lux b/new-luxc/test/test/luxc/analyser/structure.lux
index 801f61616..597388aa2 100644
--- a/new-luxc/test/test/luxc/analyser/structure.lux
+++ b/new-luxc/test/test/luxc/analyser/structure.lux
@@ -22,7 +22,8 @@
(analyser ["@" structure]
["@;" common])
["@;" module])
- (.. common))
+ (.. common)
+ (test/luxc common))
(def: (flatten-tuple analysis)
(-> la;Analysis (List la;Analysis))
@@ -73,7 +74,7 @@
(|> (&;with-scope
(&;with-expected-type variantT
(@;analyse-sum analyse choice valueC)))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (^multi (#R;Success [_ sumA])
[(flatten-variant sumA)
(#;Some [tag last? valueA])])
@@ -91,7 +92,7 @@
(TC;check varT variantT))]
(&;with-expected-type varT
(@;analyse-sum analyse choice valueC))))))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (^multi (#R;Success [_ sumA])
[(flatten-variant sumA)
(#;Some [tag last? valueA])])
@@ -106,7 +107,7 @@
(function [[var-id varT]]
(&;with-expected-type varT
(@;analyse-sum analyse choice valueC)))))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success _)
false
@@ -116,7 +117,7 @@
(|> (&;with-scope
(&;with-expected-type (type;ex-q +1 +variantT)
(@;analyse-sum analyse +choice +valueC)))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success _)
true
@@ -126,7 +127,7 @@
(|> (&;with-scope
(&;with-expected-type (type;univ-q +1 +variantT)
(@;analyse-sum analyse +choice +valueC)))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success _)
(not (n.= choice +choice))
@@ -148,7 +149,7 @@
(assert "Can analyse product."
(|> (&;with-expected-type (type;tuple (L/map product;left primitives))
(@;analyse-product analyse (L/map product;right primitives)))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success tupleA)
(n.= size (list;size (flatten-tuple tupleA)))
@@ -157,7 +158,7 @@
(assert "Can infer product."
(|> (@common;with-unknown-type
(@;analyse-product analyse (L/map product;right primitives)))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success [_type tupleA])
(and (Type/= (type;tuple (L/map product;left primitives))
_type)
@@ -168,7 +169,7 @@
(assert "Can analyse pseudo-product (singleton tuple)"
(|> (&;with-expected-type singletonT
(analyse (` [(~ singletonC)])))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success singletonA)
true
@@ -183,7 +184,7 @@
(TC;check varT (type;tuple (L/map product;left primitives))))]
(&;with-expected-type varT
(@;analyse-product analyse (L/map product;right primitives)))))))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success [_ tupleA])
(n.= size (list;size (flatten-tuple tupleA)))
@@ -193,7 +194,7 @@
(|> (&;with-scope
(&;with-expected-type (type;ex-q +1 +tupleT)
(@;analyse-product analyse (L/map product;right +primitives))))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success _)
true
@@ -203,7 +204,7 @@
(|> (&;with-scope
(&;with-expected-type (type;univ-q +1 +tupleT)
(@;analyse-product analyse (L/map product;right +primitives))))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (#R;Success _)
false
@@ -214,7 +215,7 @@
(def: (check-variant-inference variantT choice size analysis)
(-> Type Nat Nat (Lux [Module Scope Type la;Analysis]) Bool)
(|> analysis
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (^multi (#R;Success [_ _ sumT sumA])
[(flatten-variant sumA)
(#;Some [tag last? valueA])])
@@ -228,7 +229,7 @@
(def: (check-record-inference tupleT size analysis)
(-> Type Nat (Lux [Module Scope Type la;Analysis]) Bool)
(|> analysis
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (^multi (#R;Success [_ _ productT productA])
[(flatten-tuple productA)
membersA])
@@ -291,7 +292,7 @@
(&;with-scope
(&;with-expected-type variantT
(@;analyse-tagged-sum analyse [module-name other-choice-tag] other-choiceC)))))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (^multi (#R;Success [_ _ sumA])
[(flatten-variant sumA)
(#;Some [tag last? valueA])])
@@ -345,7 +346,7 @@
(&;with-scope
(&;with-expected-type tupleT
(@;analyse-record analyse recordC)))))
- (macro;run init-compiler)
+ (macro;run (init-compiler []))
(case> (^multi (#R;Success [_ _ productA])
[(flatten-tuple productA)
membersA])
diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux
new file mode 100644
index 000000000..6892274e4
--- /dev/null
+++ b/new-luxc/test/test/luxc/common.lux
@@ -0,0 +1,34 @@
+(;module:
+ lux
+ (lux (control pipe)
+ ["r" math/random "r/" Monad<Random>]
+ (data ["R" result])
+ [macro]
+ (macro [code]))
+ (luxc ["&" base]
+ [analyser]
+ ["&;" host]))
+
+(def: init-compiler-info
+ Compiler-Info
+ {#;compiler-version &;compiler-version
+ #;compiler-mode #;Build})
+
+(def: init-type-context
+ Type-Context
+ {#;ex-counter +0
+ #;var-counter +0
+ #;var-bindings (list)})
+
+(def: #export (init-compiler _)
+ (-> Top Compiler)
+ {#;info init-compiler-info
+ #;source [dummy-cursor ""]
+ #;cursor dummy-cursor
+ #;modules (list)
+ #;scopes (list)
+ #;type-context init-type-context
+ #;expected #;None
+ #;seed +0
+ #;scope-type-vars (list)
+ #;host (:! Void (&host;init-host []))})
diff --git a/new-luxc/test/test/luxc/generator/primitive.lux b/new-luxc/test/test/luxc/generator/primitive.lux
new file mode 100644
index 000000000..a64712e86
--- /dev/null
+++ b/new-luxc/test/test/luxc/generator/primitive.lux
@@ -0,0 +1,58 @@
+(;module:
+ lux
+ (lux [io]
+ (control monad
+ pipe)
+ (data text/format
+ ["R" result]
+ [bool "B/" Eq<Bool>]
+ [char "C/" Eq<Char>]
+ [text "T/" Eq<Text>])
+ ["r" math/random "R/" Monad<Random>]
+ [macro]
+ test)
+ (luxc (lang ["ls" synthesis])
+ [analyser]
+ [synthesizer]
+ (generator ["@" expr]
+ ["@;" eval]
+ ["@;" common]))
+ (test/luxc common))
+
+(test: "Primitives."
+ [%bool% r;bool
+ %nat% r;nat
+ %int% r;int
+ %deg% r;deg
+ %real% r;real
+ %char% r;char
+ %text% (r;text +5)]
+ (with-expansions
+ [<tests> (do-template [<desc> <type> <synthesis> <sample> <test>]
+ [(assert (format "Can generate " <desc> ".")
+ (|> (@eval;eval (@;generate (<synthesis> <sample>)))
+ (macro;run (init-compiler []))
+ (case> (#R;Success valueG)
+ (<test> <sample> (:! <type> valueG))
+
+ _
+ false)))]
+
+ ["bool" Bool #ls;Bool %bool% B/=]
+ ["nat" Nat #ls;Nat %nat% n.=]
+ ["int" Int #ls;Int %int% i.=]
+ ["deg" Deg #ls;Deg %deg% d.=]
+ ["real" Real #ls;Real %real% r.=]
+ ["char" Char #ls;Char %char% C/=]
+ ["text" Text #ls;Text %text% T/=])]
+ ($_ seq
+ (assert "Can generate unit."
+ (|> (@eval;eval (@;generate #ls;Unit))
+ (macro;run (init-compiler []))
+ (case> (#R;Success valueG)
+ (is @common;unit (:! Text valueG))
+
+ _
+ false)))
+ <tests>
+ )))
diff --git a/new-luxc/test/test/luxc/generator/structure.lux b/new-luxc/test/test/luxc/generator/structure.lux
new file mode 100644
index 000000000..ddf4f0afc
--- /dev/null
+++ b/new-luxc/test/test/luxc/generator/structure.lux
@@ -0,0 +1,105 @@
+(;module:
+ lux
+ (lux [io]
+ (control monad
+ pipe)
+ (data text/format
+ ["R" result]
+ [bool "B/" Eq<Bool>]
+ [char "C/" Eq<Char>]
+ [text "T/" Eq<Text>]
+ (coll ["a" array]
+ [list]))
+ ["r" math/random "r/" Monad<Random>]
+ [macro #+ Monad<Lux>]
+ [host #+ jvm-import]
+ test)
+ (luxc (lang ["ls" synthesis])
+ [analyser]
+ [synthesizer]
+ (generator ["@" expr]
+ ["@;" eval]
+ ["@;" runtime]
+ ["@;" common]))
+ (test/luxc common))
+
+(jvm-import java.lang.Integer)
+
+(def: gen-primitive
+ (r;Random ls;Synthesis)
+ (r;either (r;either (r;either (r/wrap #ls;Unit)
+ (r/map (|>. #ls;Bool) r;bool))
+ (r;either (r/map (|>. #ls;Nat) r;nat)
+ (r/map (|>. #ls;Int) r;int)))
+ (r;either (r;either (r/map (|>. #ls;Deg) r;deg)
+ (r/map (|>. #ls;Real) r;real))
+ (r;either (r/map (|>. #ls;Char) r;char)
+ (r/map (|>. #ls;Text) (r;text +5))))))
+
+(def: (corresponds? [prediction sample])
+ (-> [ls;Synthesis Top] Bool)
+ (case prediction
+ #ls;Unit
+ (is @common;unit (:! Text sample))
+
+ (^template [<tag> <type> <test>]
+ (<tag> prediction')
+ (case (host;try (<test> prediction' (:! <type> sample)))
+ (#R;Success result)
+ result
+
+ (#R;Error error)
+ false))
+ ([#ls;Bool Bool B/=]
+ [#ls;Nat Nat n.=]
+ [#ls;Int Int i.=]
+ [#ls;Deg Deg d.=]
+ [#ls;Real Real r.=]
+ [#ls;Char Char C/=]
+ [#ls;Text Text T/=])
+
+ _
+ false
+ ))
+
+(test: "Tuples."
+ [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2))))
+ members (r;list size gen-primitive)]
+ (assert "Can generate tuple."
+ (|> (@eval;eval (@;generate (#ls;Tuple members)))
+ (macro;run (init-compiler []))
+ (case> (#R;Success valueG)
+ (let [valueG (:! (a;Array Top) valueG)]
+ (and (n.= size (a;size valueG))
+ (list;every? corresponds? (list;zip2 members (a;to-list valueG)))))
+
+ _
+ false))))
+
+(test: "Variants."
+ [num-tags (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2))))
+ tag (|> r;nat (:: @ map (n.% num-tags)))
+ #let [last? (n.= (n.dec num-tags) tag)]
+ member gen-primitive]
+ (assert "Can generate variant."
+ (|> (do Monad<Lux>
+ [runtime-bytecode @runtime;generate]
+ (@eval;eval (@;generate (#ls;Variant tag last? member))))
+ (macro;run (init-compiler []))
+ (case> (#R;Success valueG)
+ (let [valueG (:! (a;Array Top) valueG)]
+ (and (n.= +3 (a;size valueG))
+ (let [_tag (:! Integer (assume (a;get +0 valueG)))
+ _last? (a;get +1 valueG)
+ _value (:! Top (assume (a;get +2 valueG)))]
+ (and (n.= tag (|> _tag host;i2l int-to-nat))
+ (case _last?
+ (#;Some _last?')
+ (and last? (T/= "" (:! Text _last?')))
+
+ #;None
+ (not last?))
+ (corresponds? [member _value])))))
+
+ _
+ false))))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
index 30a8ec522..92644ff48 100644
--- a/new-luxc/test/tests.lux
+++ b/new-luxc/test/tests.lux
@@ -14,9 +14,13 @@
(procedure ["_;A" common]))
(synthesizer ["_;S" primitive]
["_;S" structure]
+ ## ["_;S" case]
+ (case ["_;S" special])
["_;S" function]
["_;S" procedure]
- ["_;S" loop]))))
+ ["_;S" loop])
+ (generator ["_;G" primitive]
+ ["_;G" structure]))))
## [Program]
(program: args
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 13:11:49 +0000