aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test/test
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/test/test')
-rw-r--r--new-luxc/test/test/luxc/analyser/case.lux175
-rw-r--r--new-luxc/test/test/luxc/analyser/common.lux56
-rw-r--r--new-luxc/test/test/luxc/analyser/function.lux155
-rw-r--r--new-luxc/test/test/luxc/analyser/procedure/common.lux396
-rw-r--r--new-luxc/test/test/luxc/analyser/struct.lux48
-rw-r--r--new-luxc/test/test/luxc/analyser/structure.lux365
-rw-r--r--new-luxc/test/test/luxc/parser.lux12
7 files changed, 1137 insertions, 70 deletions
diff --git a/new-luxc/test/test/luxc/analyser/case.lux b/new-luxc/test/test/luxc/analyser/case.lux
new file mode 100644
index 000000000..f43625825
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/case.lux
@@ -0,0 +1,175 @@
+(;module:
+ lux
+ (lux [io]
+ (control monad
+ pipe)
+ (data [bool "B/" Eq<Bool>]
+ ["R" result]
+ [product]
+ [text "T/" Eq<Text>]
+ text/format
+ (coll [list "L/" Monad<List>]
+ ["S" set]))
+ ["r" math/random "r/" Monad<Random>]
+ [type "Type/" Eq<Type>]
+ (type ["TC" check])
+ [macro #+ Monad<Lux>]
+ (macro [code])
+ test)
+ (luxc ["&" base]
+ (lang ["la" analysis])
+ [analyser]
+ (analyser ["@" case]
+ ["@;" common])
+ ["@;" module])
+ (.. common))
+
+(def: (total-weaving branchings)
+ (-> (List (List Code)) (List (List Code)))
+ (case branchings
+ #;Nil
+ #;Nil
+
+ (#;Cons head+ #;Nil)
+ (L/map (|>. list) head+)
+
+ (#;Cons head+ tail++)
+ (do list;Monad<List>
+ [tail+ (total-weaving tail++)
+ head head+]
+ (wrap (#;Cons head tail+)))))
+
+(def: (total-branches-for variantTC inputC)
+ (-> (List [Code Code]) Code (r;Random (List Code)))
+ (case inputC
+ [_ (#;Bool _)]
+ (r/wrap (list (' true) (' false)))
+
+ (^template [<tag> <gen> <wrapper>]
+ [_ (<tag> _)]
+ (do r;Monad<Random>
+ [?sample (r;maybe <gen>)]
+ (case ?sample
+ (#;Some sample)
+ (do @
+ [else (total-branches-for variantTC inputC)]
+ (wrap (list& (<wrapper> sample) else)))
+
+ #;None
+ (wrap (list (' _))))))
+ ([#;Nat r;nat code;nat]
+ [#;Int r;int code;int]
+ [#;Deg r;deg code;deg]
+ [#;Real r;real code;real]
+ [#;Char r;char code;char]
+ [#;Text (r;text +5) code;text])
+
+ (^ [_ (#;Tuple (list))])
+ (r/wrap (list (' [])))
+
+ (^ [_ (#;Record (list))])
+ (r/wrap (list (' {})))
+
+ [_ (#;Tuple members)]
+ (do r;Monad<Random>
+ [member-wise-patterns (mapM @ (total-branches-for variantTC) members)]
+ (wrap (|> member-wise-patterns
+ total-weaving
+ (L/map code;tuple))))
+
+ [_ (#;Record kvs)]
+ (do r;Monad<Random>
+ [#let [ks (L/map product;left kvs)
+ vs (L/map product;right kvs)]
+ member-wise-patterns (mapM @ (total-branches-for variantTC) vs)]
+ (wrap (|> member-wise-patterns
+ total-weaving
+ (L/map (|>. (list;zip2 ks) code;record)))))
+
+ (^ [_ (#;Form (list [_ (#;Tag _)] _))])
+ (do r;Monad<Random>
+ [bundles (mapM @
+ (function [[_tag _code]]
+ (do @
+ [v-branches (total-branches-for variantTC _code)]
+ (wrap (L/map (function [pattern] (` ((~ _tag) (~ pattern))))
+ v-branches))))
+ variantTC)]
+ (wrap (L/join bundles)))
+
+ _
+ (r/wrap (list))
+ ))
+
+(def: (gen-input variant-tags record-tags primitivesC)
+ (-> (List Code) (List Code) (List Code) (r;Random Code))
+ (r;rec
+ (function [gen-input]
+ ($_ r;either
+ (r/map product;right gen-simple-primitive)
+ (do r;Monad<Random>
+ [choice (|> r;nat (:: @ map (n.% (list;size variant-tags))))
+ #let [choiceT (assume (list;nth choice variant-tags))
+ choiceC (assume (list;nth choice primitivesC))]]
+ (wrap (` ((~ choiceT) (~ choiceC)))))
+ (do r;Monad<Random>
+ [size (|> r;nat (:: @ map (n.% +3)))
+ elems (r;list size gen-input)]
+ (wrap (code;tuple elems)))
+ (r/wrap (code;record (list;zip2 record-tags primitivesC)))
+ ))))
+
+(test: "Pattern-matching."
+ #seed +9253409297339902486
+ [module-name (r;text +5)
+ variant-name (r;text +5)
+ record-name (|> (r;text +5) (r;filter (|>. (T/= variant-name) not)))
+ size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2))))
+ variant-tags (|> (r;set text;Hash<Text> size (r;text +5)) (:: @ map S;to-list))
+ record-tags (|> (r;set text;Hash<Text> size (r;text +5)) (:: @ map S;to-list))
+ primitivesTC (r;list size gen-simple-primitive)
+ #let [primitivesT (L/map product;left primitivesTC)
+ primitivesC (L/map product;right primitivesTC)
+ variant-tags+ (L/map (|>. [module-name] code;tag) variant-tags)
+ record-tags+ (L/map (|>. [module-name] code;tag) record-tags)
+ variantTC (list;zip2 variant-tags+ primitivesC)]
+ inputC (gen-input variant-tags+ record-tags+ primitivesC)
+ [outputT outputC] gen-simple-primitive
+ total-patterns (total-branches-for variantTC inputC)
+ #let [total-branchesC (L/map (function [pattern] [pattern outputC])
+ total-patterns)
+ non-total-branchesC (list;take (n.dec (list;size total-branchesC))
+ total-branchesC)]]
+ ($_ seq
+ (assert "Will reject empty pattern-matching (no branches)."
+ (|> (&;with-scope
+ (&;with-expected-type outputT
+ (@;analyse-case analyse inputC (list))))
+ check-failure))
+ (assert "Can analyse total pattern-matching."
+ (|> (@module;with-module +0 module-name
+ (do Monad<Lux>
+ [_ (@module;declare-tags variant-tags false
+ (#;Named [module-name variant-name]
+ (type;variant primitivesT)))
+ _ (@module;declare-tags record-tags false
+ (#;Named [module-name record-name]
+ (type;tuple primitivesT)))]
+ (&;with-scope
+ (&;with-expected-type outputT
+ (@;analyse-case analyse inputC total-branchesC)))))
+ check-success))
+ (assert "Will reject non-total pattern-matching."
+ (|> (@module;with-module +0 module-name
+ (do Monad<Lux>
+ [_ (@module;declare-tags variant-tags false
+ (#;Named [module-name variant-name]
+ (type;variant primitivesT)))
+ _ (@module;declare-tags record-tags false
+ (#;Named [module-name record-name]
+ (type;tuple primitivesT)))]
+ (&;with-scope
+ (&;with-expected-type outputT
+ (@;analyse-case analyse inputC non-total-branchesC)))))
+ check-failure))
+ ))
diff --git a/new-luxc/test/test/luxc/analyser/common.lux b/new-luxc/test/test/luxc/analyser/common.lux
index 9e3db3513..5d1dcf55e 100644
--- a/new-luxc/test/test/luxc/analyser/common.lux
+++ b/new-luxc/test/test/luxc/analyser/common.lux
@@ -1,7 +1,12 @@
(;module:
lux
- (lux ["R" math/random "R/" Monad<Random>]
- (macro [code])))
+ (lux (control pipe)
+ ["r" math/random "r/" Monad<Random>]
+ (data ["R" result])
+ [macro]
+ (macro [code]))
+ (luxc ["&" base]
+ [analyser]))
(def: compiler-version Text "0.6.0")
@@ -30,24 +35,43 @@
#;host (:! Void [])})
(def: gen-unit
- (R;Random Code)
- (R/wrap (' [])))
+ (r;Random Code)
+ (r/wrap (' [])))
(def: #export gen-simple-primitive
- (R;Random [Type Code])
+ (r;Random [Type Code])
(with-expansions
[<generators> (do-template [<type> <code-wrapper> <value-gen>]
- [(R;seq (R/wrap <type>) (R/map <code-wrapper> <value-gen>))]
-
- [Unit code;tuple (R;list +0 gen-unit)]
- [Bool code;bool R;bool]
- [Nat code;nat R;nat]
- [Int code;int R;int]
- [Deg code;deg R;deg]
- [Real code;real R;real]
- [Char code;char R;char]
- [Text code;text (R;text +5)]
+ [(r;seq (r/wrap <type>) (r/map <code-wrapper> <value-gen>))]
+
+ [Unit code;tuple (r;list +0 gen-unit)]
+ [Bool code;bool r;bool]
+ [Nat code;nat r;nat]
+ [Int code;int r;int]
+ [Deg code;deg r;deg]
+ [Real code;real r;real]
+ [Char code;char r;char]
+ [Text code;text (r;text +5)]
)]
- ($_ R;either
+ ($_ r;either
<generators>
)))
+
+(def: #export analyse
+ &;Analyser
+ (analyser;analyser (:!! [])))
+
+(do-template [<name> <on-success> <on-failure>]
+ [(def: #export (<name> analysis)
+ (All [a] (-> (Lux a) Bool))
+ (|> analysis
+ (macro;run init-compiler)
+ (case> (#R;Success _)
+ <on-success>
+
+ (#R;Error error)
+ <on-failure>)))]
+
+ [check-success true false]
+ [check-failure false true]
+ )
diff --git a/new-luxc/test/test/luxc/analyser/function.lux b/new-luxc/test/test/luxc/analyser/function.lux
new file mode 100644
index 000000000..fc203ca2d
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/function.lux
@@ -0,0 +1,155 @@
+(;module:
+ lux
+ (lux [io]
+ (control monad
+ pipe)
+ (data ["R" result]
+ [product]
+ [text "T/" Eq<Text>]
+ text/format
+ (coll [list "L/" Functor<List>]
+ ["S" set]))
+ ["r" math/random "r/" Monad<Random>]
+ [type "Type/" Eq<Type>]
+ (type ["TC" check])
+ [macro #+ Monad<Lux>]
+ (macro [code])
+ test)
+ (luxc ["&" base]
+ (lang ["la" analysis])
+ [analyser]
+ (analyser ["@" function]
+ ["@;" common])
+ ["@;" module])
+ (.. common))
+
+(def: (check-type expectedT result)
+ (-> Type (R;Result [Type la;Analysis]) Bool)
+ (case result
+ (#R;Success [exprT exprA])
+ (Type/= expectedT exprT)
+
+ _
+ false))
+
+(def: (succeeds? result)
+ (All [a] (-> (R;Result a) Bool))
+ (case result
+ (#R;Success _)
+ true
+
+ (#R;Error _)
+ false))
+
+(def: (flatten-apply analysis)
+ (-> la;Analysis [la;Analysis (List la;Analysis)])
+ (case analysis
+ (#la;Apply head func)
+ (let [[func' tail] (flatten-apply func)]
+ [func' (#;Cons head tail)])
+
+ _
+ [analysis (list)]))
+
+(def: (check-apply expectedT num-args analysis)
+ (-> Type Nat (Lux [Type la;Analysis]) Bool)
+ (|> analysis
+ (macro;run init-compiler)
+ (case> (#R;Success [applyT applyA])
+ (let [[funcA argsA] (flatten-apply applyA)]
+ (and (Type/= expectedT applyT)
+ (n.= num-args (list;size argsA))))
+
+ (#R;Error error)
+ false)))
+
+(test: "Function definition."
+ [func-name (r;text +5)
+ arg-name (|> (r;text +5) (r;filter (|>. (T/= func-name) not)))
+ [outputT outputC] gen-simple-primitive
+ [inputT _] gen-simple-primitive]
+ ($_ seq
+ (assert "Can analyse function."
+ (|> (&;with-expected-type (type (All [a] (-> a outputT)))
+ (@;analyse-function analyse func-name arg-name outputC))
+ (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)
+ succeeds?)
+ (|> (&;with-expected-type (-> inputT inputT)
+ (@;analyse-function analyse func-name arg-name (code;symbol ["" arg-name])))
+ (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)
+ (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)
+ (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)
+ 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)
+ (check-type (type (Rec self (All [a] (-> a self)))))))
+ ))
+
+(test: "Function application."
+ [full-args (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2))))
+ partial-args (|> r;nat (:: @ map (n.% full-args)))
+ var-idx (|> r;nat (:: @ map (|>. (n.% full-args) (n.max +1))))
+ inputsTC (r;list full-args gen-simple-primitive)
+ #let [inputsT (L/map product;left inputsTC)
+ inputsC (L/map product;right inputsTC)]
+ [outputT outputC] gen-simple-primitive
+ #let [funcT (type;function inputsT outputT)
+ partialT (type;function (list;drop partial-args inputsT) outputT)
+ varT (#;Bound +1)
+ polyT (<| (type;univ-q +1)
+ (type;function (list;concat (list (list;take var-idx inputsT)
+ (list varT)
+ (list;drop (n.inc var-idx) inputsT))))
+ varT)
+ poly-inputT (assume (list;nth var-idx inputsT))
+ partial-poly-inputsT (list;drop (n.inc var-idx) inputsT)
+ partial-polyT1 (<| (type;function partial-poly-inputsT)
+ poly-inputT)
+ partial-polyT2 (<| (type;univ-q +1)
+ (type;function (#;Cons varT partial-poly-inputsT))
+ varT)]]
+ ($_ seq
+ (assert "Can analyse monomorphic type application."
+ (|> (@common;with-unknown-type
+ (@;analyse-apply analyse funcT (#la;Unit) inputsC))
+ (check-apply outputT full-args)))
+ (assert "Can partially apply functions."
+ (|> (@common;with-unknown-type
+ (@;analyse-apply analyse funcT (#la;Unit)
+ (list;take partial-args inputsC)))
+ (check-apply partialT partial-args)))
+ (assert "Can apply polymorphic functions."
+ (|> (@common;with-unknown-type
+ (@;analyse-apply analyse polyT (#la;Unit) inputsC))
+ (check-apply poly-inputT full-args)))
+ (assert "Polymorphic partial application propagates found type-vars."
+ (|> (@common;with-unknown-type
+ (@;analyse-apply analyse polyT (#la;Unit)
+ (list;take (n.inc var-idx) inputsC)))
+ (check-apply partial-polyT1 (n.inc var-idx))))
+ (assert "Polymorphic partial application preserves quantification for type-vars."
+ (|> (@common;with-unknown-type
+ (@;analyse-apply analyse polyT (#la;Unit)
+ (list;take var-idx inputsC)))
+ (check-apply partial-polyT2 var-idx)))
+ ))
diff --git a/new-luxc/test/test/luxc/analyser/procedure/common.lux b/new-luxc/test/test/luxc/analyser/procedure/common.lux
new file mode 100644
index 000000000..14edcf516
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/procedure/common.lux
@@ -0,0 +1,396 @@
+(;module:
+ lux
+ (lux [io]
+ (control monad
+ pipe)
+ (concurrency [atom])
+ (data text/format
+ ["R" result]
+ [product]
+ (coll [array]))
+ ["r" math/random "r/" Monad<Random>]
+ [type "Type/" Eq<Type>]
+ [macro #+ Monad<Lux>]
+ (macro [code])
+ test)
+ (luxc ["&" base]
+ ["&;" env]
+ ["&;" module]
+ (lang ["~" analysis])
+ [analyser]
+ (analyser ["@" procedure]
+ ["@;" common]))
+ (../.. 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)
+ (case> (#R;Success _)
+ <success>
+
+ (#R;Error _)
+ <failure>)))]
+
+ [check-success+ true false]
+ [check-failure+ false true]
+ )
+
+(test: "Lux procedures"
+ [[primT primC] gen-simple-primitive
+ [antiT antiC] (|> gen-simple-primitive
+ (r;filter (|>. product;left (Type/= primT) not)))]
+ ($_ seq
+ (assert "Can test for reference equality."
+ (check-success+ "lux is" (list primC primC) Bool))
+ (assert "Reference equality must be done with elements of the same type."
+ (check-failure+ "lux is" (list primC antiC) Bool))
+ (assert "Can 'try' risky IO computations."
+ (check-success+ "lux try"
+ (list (` ((~' _lux_function) (~' _) (~' _) (~ primC))))
+ (type (Either Text primT))))
+ ))
+
+(test: "Bit procedures"
+ [subjectC (|> r;nat (:: @ map code;nat))
+ signedC (|> r;int (:: @ map code;int))
+ paramC (|> r;nat (:: @ map code;nat))]
+ ($_ seq
+ (assert "Can count the number of 1 bits in a bit pattern."
+ (check-success+ "bit count" (list subjectC) Nat))
+ (assert "Can perform bit 'and'."
+ (check-success+ "bit and" (list subjectC paramC) Nat))
+ (assert "Can perform bit 'or'."
+ (check-success+ "bit or" (list subjectC paramC) Nat))
+ (assert "Can perform bit 'xor'."
+ (check-success+ "bit xor" (list subjectC paramC) Nat))
+ (assert "Can shift bit pattern to the left."
+ (check-success+ "bit shift-left" (list subjectC paramC) Nat))
+ (assert "Can shift bit pattern to the right."
+ (check-success+ "bit unsigned-shift-right" (list subjectC paramC) Nat))
+ (assert "Can shift signed bit pattern to the right."
+ (check-success+ "bit shift-right" (list signedC paramC) Int))
+ ))
+
+(test: "Nat procedures"
+ [subjectC (|> r;nat (:: @ map code;nat))
+ paramC (|> r;nat (:: @ map code;nat))]
+ ($_ seq
+ (assert "Can add natural numbers."
+ (check-success+ "nat +" (list subjectC paramC) Nat))
+ (assert "Can subtract natural numbers."
+ (check-success+ "nat -" (list subjectC paramC) Nat))
+ (assert "Can multiply natural numbers."
+ (check-success+ "nat *" (list subjectC paramC) Nat))
+ (assert "Can divide natural numbers."
+ (check-success+ "nat /" (list subjectC paramC) Nat))
+ (assert "Can calculate remainder of natural numbers."
+ (check-success+ "nat %" (list subjectC paramC) Nat))
+ (assert "Can test equality of natural numbers."
+ (check-success+ "nat =" (list subjectC paramC) Bool))
+ (assert "Can compare natural numbers."
+ (check-success+ "nat <" (list subjectC paramC) Bool))
+ (assert "Can obtain minimum natural number."
+ (check-success+ "nat min" (list) Nat))
+ (assert "Can obtain maximum natural number."
+ (check-success+ "nat max" (list) Nat))
+ (assert "Can convert natural number to integer."
+ (check-success+ "nat to-int" (list subjectC) Int))
+ (assert "Can convert natural number to text."
+ (check-success+ "nat to-text" (list subjectC) Text))
+ ))
+
+(test: "Int procedures"
+ [subjectC (|> r;int (:: @ map code;int))
+ paramC (|> r;int (:: @ map code;int))]
+ ($_ seq
+ (assert "Can add integers."
+ (check-success+ "int +" (list subjectC paramC) Int))
+ (assert "Can subtract integers."
+ (check-success+ "int -" (list subjectC paramC) Int))
+ (assert "Can multiply integers."
+ (check-success+ "int *" (list subjectC paramC) Int))
+ (assert "Can divide integers."
+ (check-success+ "int /" (list subjectC paramC) Int))
+ (assert "Can calculate remainder of integers."
+ (check-success+ "int %" (list subjectC paramC) Int))
+ (assert "Can test equality of integers."
+ (check-success+ "int =" (list subjectC paramC) Bool))
+ (assert "Can compare integers."
+ (check-success+ "int <" (list subjectC paramC) Bool))
+ (assert "Can obtain minimum integer."
+ (check-success+ "int min" (list) Int))
+ (assert "Can obtain maximum integer."
+ (check-success+ "int max" (list) Int))
+ (assert "Can convert integer to natural number."
+ (check-success+ "int to-nat" (list subjectC) Nat))
+ (assert "Can convert integer to real number."
+ (check-success+ "int to-real" (list subjectC) Real))
+ ))
+
+(test: "Deg procedures"
+ [subjectC (|> r;deg (:: @ map code;deg))
+ paramC (|> r;deg (:: @ map code;deg))
+ natC (|> r;nat (:: @ map code;nat))]
+ ($_ seq
+ (assert "Can add degrees."
+ (check-success+ "deg +" (list subjectC paramC) Deg))
+ (assert "Can subtract degrees."
+ (check-success+ "deg -" (list subjectC paramC) Deg))
+ (assert "Can multiply degrees."
+ (check-success+ "deg *" (list subjectC paramC) Deg))
+ (assert "Can divide degrees."
+ (check-success+ "deg /" (list subjectC paramC) Deg))
+ (assert "Can calculate remainder of degrees."
+ (check-success+ "deg %" (list subjectC paramC) Deg))
+ (assert "Can test equality of degrees."
+ (check-success+ "deg =" (list subjectC paramC) Bool))
+ (assert "Can compare degrees."
+ (check-success+ "deg <" (list subjectC paramC) Bool))
+ (assert "Can obtain minimum degree."
+ (check-success+ "deg min" (list) Deg))
+ (assert "Can obtain maximum degree."
+ (check-success+ "deg max" (list) Deg))
+ (assert "Can convert degree to real number."
+ (check-success+ "deg to-real" (list subjectC) Real))
+ (assert "Can scale degree."
+ (check-success+ "deg scale" (list subjectC natC) Deg))
+ (assert "Can calculate the reciprocal of a natural number."
+ (check-success+ "deg reciprocal" (list natC) Deg))
+ ))
+
+(test: "Real procedures"
+ [subjectC (|> r;real (:: @ map code;real))
+ paramC (|> r;real (:: @ map code;real))
+ encodedC (|> (r;text +5) (:: @ map code;text))]
+ ($_ seq
+ (assert "Can add real numbers."
+ (check-success+ "real +" (list subjectC paramC) Real))
+ (assert "Can subtract real numbers."
+ (check-success+ "real -" (list subjectC paramC) Real))
+ (assert "Can multiply real numbers."
+ (check-success+ "real *" (list subjectC paramC) Real))
+ (assert "Can divide real numbers."
+ (check-success+ "real /" (list subjectC paramC) Real))
+ (assert "Can calculate remainder of real numbers."
+ (check-success+ "real %" (list subjectC paramC) Real))
+ (assert "Can test equality of real numbers."
+ (check-success+ "real =" (list subjectC paramC) Bool))
+ (assert "Can compare real numbers."
+ (check-success+ "real <" (list subjectC paramC) Bool))
+ (assert "Can obtain minimum real number."
+ (check-success+ "real min" (list) Real))
+ (assert "Can obtain maximum real number."
+ (check-success+ "real max" (list) Real))
+ (assert "Can obtain smallest real number."
+ (check-success+ "real smallest" (list) Real))
+ (assert "Can obtain not-a-number."
+ (check-success+ "real not-a-number" (list) Real))
+ (assert "Can obtain positive infinity."
+ (check-success+ "real positive-infinity" (list) Real))
+ (assert "Can obtain negative infinity."
+ (check-success+ "real negative-infinity" (list) Real))
+ (assert "Can convert real number to integer."
+ (check-success+ "real to-int" (list subjectC) Int))
+ (assert "Can convert real number to degree."
+ (check-success+ "real to-deg" (list subjectC) Deg))
+ (assert "Can convert real number to text."
+ (check-success+ "real to-text" (list subjectC) Text))
+ (assert "Can convert text to real number."
+ (check-success+ "real from-text" (list encodedC) (type (Maybe Real))))
+ ))
+
+(test: "Text procedures"
+ [subjectC (|> (r;text +5) (:: @ map code;text))
+ paramC (|> (r;text +5) (:: @ map code;text))
+ replacementC (|> (r;text +5) (:: @ map code;text))
+ fromC (|> r;nat (:: @ map code;nat))
+ toC (|> r;nat (:: @ map code;nat))]
+ ($_ seq
+ (assert "Can test text equality."
+ (check-success+ "text =" (list subjectC paramC) Bool))
+ (assert "Compare texts in lexicographical order."
+ (check-success+ "text <" (list subjectC paramC) Bool))
+ (assert "Can prepend one text to another."
+ (check-success+ "text prepend" (list subjectC paramC) Text))
+ (assert "Can find the index of a piece of text inside a larger one that (may) contain it."
+ (check-success+ "text index" (list subjectC paramC fromC) (type (Maybe Nat))))
+ (assert "Can query the size/length of a text."
+ (check-success+ "text size" (list subjectC) Nat))
+ (assert "Can calculate a hash code for text."
+ (check-success+ "text hash" (list subjectC) Nat))
+ (assert "Can replace a text inside of a larger one (once)."
+ (check-success+ "text replace-once" (list subjectC paramC replacementC) Text))
+ (assert "Can replace a text inside of a larger one (all times)."
+ (check-success+ "text replace-all" (list subjectC paramC replacementC) Text))
+ (assert "Can obtain the character code of a text at a given index."
+ (check-success+ "text char" (list subjectC fromC) Nat))
+ (assert "Can clip a piece of text between 2 indices."
+ (check-success+ "text clip" (list subjectC fromC toC) Text))
+ ))
+
+(test: "Array procedures"
+ [[elemT elemC] gen-simple-primitive
+ sizeC (|> r;nat (:: @ map code;nat))
+ idxC (|> r;nat (:: @ map code;nat))
+ var-name (r;text +5)
+ #let [arrayT (type (array;Array elemT))]]
+ ($_ seq
+ (assert "Can create arrays."
+ (check-success+ "array new" (list sizeC) arrayT))
+ (assert "Can get a value inside an array."
+ (|> (&env;with-scope ""
+ (&env;with-local [var-name arrayT]
+ (&;with-expected-type elemT
+ (@;analyse-procedure analyse "array get"
+ (list idxC
+ (code;symbol ["" var-name]))))))
+ (macro;run init-compiler)
+ (case> (#R;Success _)
+ true
+
+ (#R;Error _)
+ false)))
+ (assert "Can put a value inside an array."
+ (|> (&env;with-scope ""
+ (&env;with-local [var-name arrayT]
+ (&;with-expected-type arrayT
+ (@;analyse-procedure analyse "array put"
+ (list idxC
+ elemC
+ (code;symbol ["" var-name]))))))
+ (macro;run init-compiler)
+ (case> (#R;Success _)
+ true
+
+ (#R;Error _)
+ false)))
+ (assert "Can remove a value from an array."
+ (|> (&env;with-scope ""
+ (&env;with-local [var-name arrayT]
+ (&;with-expected-type arrayT
+ (@;analyse-procedure analyse "array remove"
+ (list idxC
+ (code;symbol ["" var-name]))))))
+ (macro;run init-compiler)
+ (case> (#R;Success _)
+ true
+
+ (#R;Error _)
+ false)))
+ (assert "Can query the size of an array."
+ (|> (&env;with-scope ""
+ (&env;with-local [var-name arrayT]
+ (&;with-expected-type Nat
+ (@;analyse-procedure analyse "array size"
+ (list (code;symbol ["" var-name]))))))
+ (macro;run init-compiler)
+ (case> (#R;Success _)
+ true
+
+ (#R;Error _)
+ false)))
+ ))
+
+(test: "Math procedures"
+ [subjectC (|> r;real (:: @ map code;real))
+ paramC (|> r;real (:: @ map code;real))]
+ (with-expansions [<unary> (do-template [<proc> <desc>]
+ [(assert (format "Can calculate " <desc> ".")
+ (check-success+ <proc> (list subjectC) Real))]
+
+ ["math cos" "cosine"]
+ ["math sin" "sine"]
+ ["math tan" "tangent"]
+ ["math acos" "inverse/arc cosine"]
+ ["math asin" "inverse/arc sine"]
+ ["math atan" "inverse/arc tangent"]
+ ["math cosh" "hyperbolic cosine"]
+ ["math sinh" "hyperbolic sine"]
+ ["math tanh" "hyperbolic tangent"]
+ ["math exp" "exponentiation"]
+ ["math log" "logarithm"]
+ ["math root2" "square root"]
+ ["math root3" "cubic root"]
+ ["math ceil" "ceiling"]
+ ["math floor" "floor"]
+ ["math round" "rounding"])
+ <binary> (do-template [<proc> <desc>]
+ [(assert (format "Can calculate " <desc> ".")
+ (check-success+ <proc> (list subjectC paramC) Real))]
+
+ ["math atan2" "inverse/arc tangent (with 2 arguments)"]
+ ["math pow" "power"])]
+ ($_ seq
+ <unary>
+ <binary>)))
+
+(test: "Atom procedures"
+ [[elemT elemC] gen-simple-primitive
+ sizeC (|> r;nat (:: @ map code;nat))
+ idxC (|> r;nat (:: @ map code;nat))
+ var-name (r;text +5)
+ #let [atomT (type (atom;Atom elemT))]]
+ ($_ seq
+ (assert "Can create atomic reference."
+ (check-success+ "atom new" (list elemC) atomT))
+ (assert "Can read the value of an atomic reference."
+ (|> (&env;with-scope ""
+ (&env;with-local [var-name atomT]
+ (&;with-expected-type elemT
+ (@;analyse-procedure analyse "atom read"
+ (list (code;symbol ["" var-name]))))))
+ (macro;run init-compiler)
+ (case> (#R;Success _)
+ true
+
+ (#R;Error _)
+ false)))
+ (assert "Can swap the value of an atomic reference."
+ (|> (&env;with-scope ""
+ (&env;with-local [var-name atomT]
+ (&;with-expected-type Bool
+ (@;analyse-procedure analyse "atom compare-and-swap"
+ (list elemC
+ elemC
+ (code;symbol ["" var-name]))))))
+ (macro;run init-compiler)
+ (case> (#R;Success _)
+ true
+
+ (#R;Error _)
+ false)))
+ ))
+
+(test: "Process procedures"
+ [[primT primC] gen-simple-primitive
+ timeC (|> r;nat (:: @ map code;nat))]
+ ($_ seq
+ (assert "Can query the level of concurrency."
+ (check-success+ "process concurrency-level" (list) Nat))
+ (assert "Can run an IO computation concurrently."
+ (check-success+ "process future"
+ (list (` ((~' _lux_function) (~' _) (~' _) (~ primC))))
+ Unit))
+ (assert "Can schedule an IO computation to run concurrently at some future time."
+ (check-success+ "process schedule"
+ (list timeC
+ (` ((~' _lux_function) (~' _) (~' _) (~ primC))))
+ Unit))
+ ))
+
+(test: "IO procedures"
+ [logC (|> (r;text +5) (:: @ map code;text))
+ exitC (|> r;nat (:: @ map code;nat))]
+ ($_ seq
+ (assert "Can log messages to standard output."
+ (check-success+ "io log" (list logC) Unit))
+ (assert "Can log messages to standard output."
+ (check-success+ "io error" (list logC) Bottom))
+ (assert "Can log messages to standard output."
+ (check-success+ "io exit" (list exitC) Bottom))
+ (assert "Can query the current time (as milliseconds since epoch)."
+ (check-success+ "io current-time" (list) Int))
+ ))
diff --git a/new-luxc/test/test/luxc/analyser/struct.lux b/new-luxc/test/test/luxc/analyser/struct.lux
deleted file mode 100644
index 8bf7957b5..000000000
--- a/new-luxc/test/test/luxc/analyser/struct.lux
+++ /dev/null
@@ -1,48 +0,0 @@
-(;module:
- lux
- (lux [io]
- (control monad
- pipe)
- (data ["R" result]
- [product]
- (coll [list "L/" Functor<List>]))
- ["r" math/random "R/" Monad<Random>]
- [type "Type/" Eq<Type>]
- [macro #+ Monad<Lux>]
- test)
- (luxc ["&" base]
- (lang ["la" analysis])
- [analyser]
- (analyser ["@" struct]
- ["@;" common]))
- (.. common))
-
-(def: analyse
- &;Analyser
- (analyser;analyser (:!! [])))
-
-(def: (flatten-tuple analysis)
- (-> la;Analysis (List la;Analysis))
- (case analysis
- (#la;Product left right)
- (#;Cons left (flatten-tuple right))
-
- _
- (list analysis)))
-
-(test: "Tuples"
- [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2))))
- primitives (r;list size gen-simple-primitive)]
- ($_ seq
- (assert "Can analyse tuple."
- (|> (@common;with-unknown-type
- (@;analyse-product analyse (L/map product;right primitives)))
- (macro;run init-compiler)
- (case> (#R;Success [_type tupleA])
- (and (Type/= (type;tuple (L/map product;left primitives))
- _type)
- (n.= size (list;size (flatten-tuple tupleA))))
-
- _
- false))
- )))
diff --git a/new-luxc/test/test/luxc/analyser/structure.lux b/new-luxc/test/test/luxc/analyser/structure.lux
new file mode 100644
index 000000000..b38a904c3
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/structure.lux
@@ -0,0 +1,365 @@
+(;module:
+ lux
+ (lux [io]
+ (control monad
+ pipe)
+ (data [bool "B/" Eq<Bool>]
+ ["R" result]
+ [product]
+ [text]
+ text/format
+ (coll [list "L/" Functor<List>]
+ ["S" set]))
+ ["r" math/random "r/" Monad<Random>]
+ [type "Type/" Eq<Type>]
+ (type ["TC" check])
+ [macro #+ Monad<Lux>]
+ (macro [code])
+ test)
+ (luxc ["&" base]
+ (lang ["la" analysis])
+ [analyser]
+ (analyser ["@" structure]
+ ["@;" common])
+ ["@;" module])
+ (.. common))
+
+(def: (flatten-tuple analysis)
+ (-> la;Analysis (List la;Analysis))
+ (case analysis
+ (#la;Product left right)
+ (#;Cons left (flatten-tuple right))
+
+ _
+ (list analysis)))
+
+(def: (flatten-variant analysis)
+ (-> la;Analysis (Maybe [Nat Bool la;Analysis]))
+ (case analysis
+ (#la;Sum variant)
+ (loop [so-far +0
+ variantA variant]
+ (case variantA
+ (#;Left valueA)
+ (case valueA
+ (#la;Sum choice)
+ (recur (n.inc so-far) choice)
+
+ _
+ (#;Some [so-far false valueA]))
+
+ (#;Right valueA)
+ (#;Some [(n.inc so-far) true valueA])))
+
+ _
+ #;None))
+
+(test: "Sums"
+ [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2))))
+ choice (|> r;nat (:: @ map (n.% size)))
+ primitives (r;list size gen-simple-primitive)
+ +choice (|> r;nat (:: @ map (n.% (n.inc size))))
+ [_ +valueC] gen-simple-primitive
+ #let [variantT (type;variant (L/map product;left primitives))
+ [valueT valueC] (assume (list;nth choice primitives))
+ +size (n.inc size)
+ +primitives (list;concat (list (list;take choice primitives)
+ (list [(#;Bound +1) +valueC])
+ (list;drop choice primitives)))
+ [+valueT +valueC] (assume (list;nth +choice +primitives))
+ +variantT (type;variant (L/map product;left +primitives))]]
+ ($_ seq
+ (assert "Can analyse sum."
+ (|> (&;with-scope
+ (&;with-expected-type variantT
+ (@;analyse-sum analyse choice valueC)))
+ (macro;run init-compiler)
+ (case> (^multi (#R;Success [_ sumA])
+ [(flatten-variant sumA)
+ (#;Some [tag last? valueA])])
+ (and (n.= tag choice)
+ (B/= last? (n.= (n.dec size) choice)))
+
+ _
+ false)))
+ (assert "Can analyse pseudo-sum."
+ (|> (&;with-expected-type valueT
+ (@;analyse-sum analyse +0 valueC))
+ (macro;run init-compiler)
+ (case> (#R;Success sumA)
+ true
+
+ _
+ false)))
+ (assert "Can analyse sum through bound type-vars."
+ (|> (&;with-scope
+ (@common;with-var
+ (function [[var-id varT]]
+ (do Monad<Lux>
+ [_ (&;within-type-env
+ (TC;check varT variantT))]
+ (&;with-expected-type varT
+ (@;analyse-sum analyse choice valueC))))))
+ (macro;run init-compiler)
+ (case> (^multi (#R;Success [_ sumA])
+ [(flatten-variant sumA)
+ (#;Some [tag last? valueA])])
+ (and (n.= tag choice)
+ (B/= last? (n.= (n.dec size) choice)))
+
+ _
+ false)))
+ (assert "Cannot analyse sum through unbound type-vars."
+ (|> (&;with-scope
+ (@common;with-var
+ (function [[var-id varT]]
+ (&;with-expected-type varT
+ (@;analyse-sum analyse choice valueC)))))
+ (macro;run init-compiler)
+ (case> (#R;Success _)
+ false
+
+ _
+ true)))
+ (assert "Can analyse sum through existential quantification."
+ (|> (&;with-scope
+ (&;with-expected-type (type;ex-q +1 +variantT)
+ (@;analyse-sum analyse +choice +valueC)))
+ (macro;run init-compiler)
+ (case> (#R;Success _)
+ true
+
+ (#R;Error error)
+ false)))
+ (assert "Can analyse sum through universal quantification."
+ (|> (&;with-scope
+ (&;with-expected-type (type;univ-q +1 +variantT)
+ (@;analyse-sum analyse +choice +valueC)))
+ (macro;run init-compiler)
+ (case> (#R;Success _)
+ (not (n.= choice +choice))
+
+ (#R;Error error)
+ (n.= choice +choice))))
+ ))
+
+(test: "Products"
+ [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2))))
+ primitives (r;list size gen-simple-primitive)
+ choice (|> r;nat (:: @ map (n.% size)))
+ [_ +valueC] gen-simple-primitive
+ #let [[singletonT singletonC] (|> primitives (list;nth choice) assume)
+ +primitives (list;concat (list (list;take choice primitives)
+ (list [(#;Bound +1) +valueC])
+ (list;drop choice primitives)))
+ +tupleT (type;tuple (L/map product;left +primitives))]]
+ ($_ seq
+ (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)
+ (case> (#R;Success tupleA)
+ (n.= size (list;size (flatten-tuple tupleA)))
+
+ _
+ false)))
+ (assert "Can infer product."
+ (|> (@common;with-unknown-type
+ (@;analyse-product analyse (L/map product;right primitives)))
+ (macro;run init-compiler)
+ (case> (#R;Success [_type tupleA])
+ (and (Type/= (type;tuple (L/map product;left primitives))
+ _type)
+ (n.= size (list;size (flatten-tuple tupleA))))
+
+ _
+ false)))
+ (assert "Can analyse pseudo-product (singleton tuple)"
+ (|> (&;with-expected-type singletonT
+ (analyse (` [(~ singletonC)])))
+ (macro;run init-compiler)
+ (case> (#R;Success singletonA)
+ true
+
+ (#R;Error error)
+ false)))
+ (assert "Can analyse product through bound type-vars."
+ (|> (&;with-scope
+ (@common;with-var
+ (function [[var-id varT]]
+ (do Monad<Lux>
+ [_ (&;within-type-env
+ (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)
+ (case> (#R;Success [_ tupleA])
+ (n.= size (list;size (flatten-tuple tupleA)))
+
+ _
+ false)))
+ (assert "Can analyse product through existential quantification."
+ (|> (&;with-scope
+ (&;with-expected-type (type;ex-q +1 +tupleT)
+ (@;analyse-product analyse (L/map product;right +primitives))))
+ (macro;run init-compiler)
+ (case> (#R;Success _)
+ true
+
+ (#R;Error error)
+ false)))
+ (assert "Cannot analyse product through universal quantification."
+ (|> (&;with-scope
+ (&;with-expected-type (type;univ-q +1 +tupleT)
+ (@;analyse-product analyse (L/map product;right +primitives))))
+ (macro;run init-compiler)
+ (case> (#R;Success _)
+ false
+
+ (#R;Error error)
+ true)))
+ ))
+
+(def: (check-variant-inference variantT choice size analysis)
+ (-> Type Nat Nat (Lux [Module Scope Type la;Analysis]) Bool)
+ (|> analysis
+ (macro;run init-compiler)
+ (case> (^multi (#R;Success [_ _ sumT sumA])
+ [(flatten-variant sumA)
+ (#;Some [tag last? valueA])])
+ (and (Type/= variantT sumT)
+ (n.= tag choice)
+ (B/= last? (n.= (n.dec size) choice)))
+
+ _
+ false)))
+
+(def: (check-record-inference tupleT size analysis)
+ (-> Type Nat (Lux [Module Scope Type la;Analysis]) Bool)
+ (|> analysis
+ (macro;run init-compiler)
+ (case> (^multi (#R;Success [_ _ productT productA])
+ [(flatten-tuple productA)
+ membersA])
+ (and (Type/= tupleT productT)
+ (n.= size (list;size membersA)))
+
+ _
+ false)))
+
+(test: "Tagged Sums"
+ [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2))))
+ tags (|> (r;set text;Hash<Text> size (r;text +5)) (:: @ map S;to-list))
+ choice (|> r;nat (:: @ map (n.% size)))
+ other-choice (|> r;nat (:: @ map (n.% size)) (r;filter (|>. (n.= choice) not)))
+ primitives (r;list size gen-simple-primitive)
+ module-name (r;text +5)
+ type-name (r;text +5)
+ #let [varT (#;Bound +1)
+ primitivesT (L/map product;left primitives)
+ [choiceT choiceC] (assume (list;nth choice primitives))
+ [other-choiceT other-choiceC] (assume (list;nth other-choice primitives))
+ variantT (type;variant primitivesT)
+ namedT (#;Named [module-name type-name] variantT)
+ polyT (|> (type;variant (list;concat (list (list;take choice primitivesT)
+ (list varT)
+ (list;drop (n.inc choice) primitivesT))))
+ (type;univ-q +1))
+ named-polyT (#;Named [module-name type-name] polyT)
+ choice-tag (assume (list;nth choice tags))
+ other-choice-tag (assume (list;nth other-choice tags))]]
+ ($_ seq
+ (assert "Can infer tagged sum."
+ (|> (@module;with-module +0 module-name
+ (do Monad<Lux>
+ [_ (@module;declare-tags tags false namedT)]
+ (&;with-scope
+ (@common;with-unknown-type
+ (@;analyse-tagged-sum analyse [module-name choice-tag] choiceC)))))
+ (check-variant-inference variantT choice size)))
+ (assert "Tagged sums specialize when type-vars get bound."
+ (|> (@module;with-module +0 module-name
+ (do Monad<Lux>
+ [_ (@module;declare-tags tags false named-polyT)]
+ (&;with-scope
+ (@common;with-unknown-type
+ (@;analyse-tagged-sum analyse [module-name choice-tag] choiceC)))))
+ (check-variant-inference variantT choice size)))
+ (assert "Tagged sum inference retains universal quantification when type-vars are not bound."
+ (|> (@module;with-module +0 module-name
+ (do Monad<Lux>
+ [_ (@module;declare-tags tags false named-polyT)]
+ (&;with-scope
+ (@common;with-unknown-type
+ (@;analyse-tagged-sum analyse [module-name other-choice-tag] other-choiceC)))))
+ (check-variant-inference polyT other-choice size)))
+ (assert "Can specialize generic tagged sums."
+ (|> (@module;with-module +0 module-name
+ (do Monad<Lux>
+ [_ (@module;declare-tags tags false named-polyT)]
+ (&;with-scope
+ (&;with-expected-type variantT
+ (@;analyse-tagged-sum analyse [module-name other-choice-tag] other-choiceC)))))
+ (macro;run init-compiler)
+ (case> (^multi (#R;Success [_ _ sumA])
+ [(flatten-variant sumA)
+ (#;Some [tag last? valueA])])
+ (and (n.= tag other-choice)
+ (B/= last? (n.= (n.dec size) other-choice)))
+
+ _
+ false)))
+ ))
+
+(test: "Records"
+ [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2))))
+ tags (|> (r;set text;Hash<Text> size (r;text +5)) (:: @ map S;to-list))
+ primitives (r;list size gen-simple-primitive)
+ module-name (r;text +5)
+ type-name (r;text +5)
+ choice (|> r;nat (:: @ map (n.% size)))
+ #let [varT (#;Bound +1)
+ tagsC (L/map (|>. [module-name] code;tag) tags)
+ primitivesT (L/map product;left primitives)
+ primitivesC (L/map product;right primitives)
+ tupleT (type;tuple primitivesT)
+ namedT (#;Named [module-name type-name] tupleT)
+ recordC (list;zip2 tagsC primitivesC)
+ polyT (|> (type;tuple (list;concat (list (list;take choice primitivesT)
+ (list varT)
+ (list;drop (n.inc choice) primitivesT))))
+ (type;univ-q +1))
+ named-polyT (#;Named [module-name type-name] polyT)]]
+ ($_ seq
+ (assert "Can infer record."
+ (|> (@module;with-module +0 module-name
+ (do Monad<Lux>
+ [_ (@module;declare-tags tags false namedT)]
+ (&;with-scope
+ (@common;with-unknown-type
+ (@;analyse-record analyse recordC)))))
+ (check-record-inference tupleT size)))
+ (assert "Records specialize when type-vars get bound."
+ (|> (@module;with-module +0 module-name
+ (do Monad<Lux>
+ [_ (@module;declare-tags tags false named-polyT)]
+ (&;with-scope
+ (@common;with-unknown-type
+ (@;analyse-record analyse recordC)))))
+ (check-record-inference tupleT size)))
+ (assert "Can specialize generic records."
+ (|> (@module;with-module +0 module-name
+ (do Monad<Lux>
+ [_ (@module;declare-tags tags false named-polyT)]
+ (&;with-scope
+ (&;with-expected-type tupleT
+ (@;analyse-record analyse recordC)))))
+ (macro;run init-compiler)
+ (case> (^multi (#R;Success [_ _ productA])
+ [(flatten-tuple productA)
+ membersA])
+ (n.= size (list;size membersA))
+
+ _
+ false)))
+ ))
diff --git a/new-luxc/test/test/luxc/parser.lux b/new-luxc/test/test/luxc/parser.lux
index f6ee8ea72..33b6eba36 100644
--- a/new-luxc/test/test/luxc/parser.lux
+++ b/new-luxc/test/test/luxc/parser.lux
@@ -38,7 +38,7 @@
(r;Random Ident)
(r;seq ident-part^ ident-part^))
-(def: ast^
+(def: code^
(r;Random Code)
(let [numeric^ (: (r;Random Code)
($_ r;either
@@ -60,23 +60,23 @@
numeric^
textual^))]
(r;rec
- (function [ast^]
+ (function [code^]
(let [multi^ (do r;Monad<Random>
[size (|> r;nat (r/map (n.% +3)))]
- (r;list size ast^))
+ (r;list size code^))
composite^ (: (r;Random Code)
($_ r;either
(|> multi^ (r/map (|>. #;Form [default-cursor])))
(|> multi^ (r/map (|>. #;Tuple [default-cursor])))
(do r;Monad<Random>
[size (|> r;nat (r/map (n.% +3)))]
- (|> (r;list size (r;seq ast^ ast^))
+ (|> (r;list size (r;seq code^ code^))
(r/map (|>. #;Record [default-cursor]))))))]
(r;either simple^
composite^))))))
(test: "Lux code parser."
- [sample ast^]
+ [sample code^]
(assert "Can parse Lux code."
(case (&;parse [default-cursor (code;to-text sample)])
(#R;Error error)
@@ -119,7 +119,7 @@
z char-gen
offset-size (|> r;nat (r/map (|>. (n.% +10) (n.max +1))))
#let [offset (text;join-with "" (list;repeat offset-size " "))]
- sample ast^
+ sample code^
comment comment^
unbalanced-comment comment-text^]
($_ seq