aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/test/test/luxc/lang/translation/case.lux97
-rw-r--r--new-luxc/test/test/luxc/lang/translation/common.lux172
-rw-r--r--new-luxc/test/test/luxc/lang/translation/function.lux103
-rw-r--r--new-luxc/test/test/luxc/lang/translation/reference.lux15
4 files changed, 201 insertions, 186 deletions
diff --git a/new-luxc/test/test/luxc/lang/translation/case.lux b/new-luxc/test/test/luxc/lang/translation/case.lux
index ed8529429..801d9f1d7 100644
--- a/new-luxc/test/test/luxc/lang/translation/case.lux
+++ b/new-luxc/test/test/luxc/lang/translation/case.lux
@@ -1,16 +1,13 @@
(.module:
- [lux #*
+ [lux (#- case)
[control
[monad (#+ do)]
pipe]
[data
- ["e" error]
- [text
- format]
[collection
["." list]]]
[math
- ["r" random]]
+ ["r" random (#+ Random)]]
[compiler
[default
["." reference]
@@ -24,15 +21,19 @@
[//
["&" function]])
-(def: struct-limit Nat 10)
+(def: limit Nat 10)
+
+(def: size
+ (Random Nat)
+ (|> r.nat (:: r.Monad<Random> map (|>> (n/% ..limit) (n/max 2)))))
(def: (tail? size idx)
(-> Nat Nat Bit)
(n/= (dec size) idx))
-(def: gen-case
- (r.Random [Synthesis Path])
- (<| r.rec (function (_ gen-case))
+(def: case
+ (Random [Synthesis Path])
+ (<| r.rec (function (_ case))
(`` ($_ r.either
(do r.Monad<Random>
[value r.i64]
@@ -49,9 +50,9 @@
[r.frac synthesis.f64 synthesis.path/f64]
[(r.unicode 5) synthesis.text synthesis.path/text]))
(do r.Monad<Random>
- [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max 2))))
+ [size ..size
idx (|> r.nat (:: @ map (n/% size)))
- [subS subP] gen-case
+ [subS subP] case
#let [unitS (synthesis.text synthesis.unit)
caseS (synthesis.tuple
(list.concat (list (list.repeat idx unitS)
@@ -63,42 +64,64 @@
subP])]]
(wrap [caseS caseP]))
(do r.Monad<Random>
- [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max 2))))
+ [size ..size
idx (|> r.nat (:: @ map (n/% size)))
- [subS subP] gen-case
- #let [caseS (let [right? (tail? size idx)]
- (synthesis.variant
- {#analysis.lefts idx
- #analysis.right? right?
- #analysis.value subS}))
+ [subS subP] case
+ #let [right? (tail? size idx)
+ caseS (synthesis.variant
+ {#analysis.lefts idx
+ #analysis.right? right?
+ #analysis.value subS})
caseP (synthesis.path/seq
- [(if (tail? size idx)
+ [(if right?
(synthesis.side/right idx)
(synthesis.side/left idx))
subP])]]
(wrap [caseS caseP]))
))))
-(def: (pattern-matching-spec run)
+(def: (let-spec run)
+ (-> Runner Test)
+ (do r.Monad<Random>
+ [value &.safe-frac]
+ (test "Specialized \"let\"."
+ (|> (run (synthesis.branch/let [(synthesis.f64 value)
+ 0
+ (synthesis.variable/local 0)]))
+ (&.check value)))))
+
+(def: (if-spec run)
(-> Runner Test)
(do r.Monad<Random>
- [[valueS pathS] gen-case
- to-bind r.frac]
- ($_ seq
- (test "Can translate pattern-matching."
- (|> (run (synthesis.branch/case
- [valueS
- (synthesis.path/alt [(synthesis.path/seq [pathS
- (synthesis.path/then (synthesis.f64 to-bind))])
- (synthesis.path/then (synthesis.f64 +0.0))])]))
- (&.check to-bind)))
- (test "Can bind values."
- (|> (run (synthesis.branch/case
- [(synthesis.f64 to-bind)
- (synthesis.path/seq [(synthesis.path/bind 0)
- (synthesis.path/then (synthesis.variable/local 0))])]))
- (&.check to-bind)))
- )))
+ [on-true &.safe-frac
+ on-false (|> &.safe-frac (r.filter (|>> (f/= on-true) not)))
+ verdict r.bit]
+ (test "Specialized \"if\"."
+ (|> (run (synthesis.branch/if [(synthesis.bit verdict)
+ (synthesis.f64 on-true)
+ (synthesis.f64 on-false)]))
+ (&.check (if verdict on-true on-false))))))
+
+(def: (case-spec run)
+ (-> Runner Test)
+ (do r.Monad<Random>
+ [[inputS pathS] ..case
+ on-success &.safe-frac
+ on-failure (|> &.safe-frac (r.filter (|>> (f/= on-success) not)))]
+ (test "Case."
+ (|> (run (synthesis.branch/case
+ [inputS
+ (synthesis.path/alt [(synthesis.path/seq [pathS
+ (synthesis.path/then (synthesis.f64 on-success))])
+ (synthesis.path/then (synthesis.f64 on-failure))])]))
+ (&.check on-success)))))
+
+(def: (pattern-matching-spec run)
+ (-> Runner Test)
+ ($_ seq
+ (let-spec run)
+ (if-spec run)
+ (case-spec run)))
(context: "[JVM] Pattern-matching."
(<| (times 100)
diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux
index 246598072..3005a7588 100644
--- a/new-luxc/test/test/luxc/lang/translation/common.lux
+++ b/new-luxc/test/test/luxc/lang/translation/common.lux
@@ -13,7 +13,7 @@
[collection
["." list]]]
[math
- ["r" random]]
+ ["r" random (#+ Random)]]
[compiler
[default
["." reference]
@@ -22,7 +22,9 @@
test]
[test
[luxc
- ["." common (#+ Runner)]]])
+ ["." common (#+ Runner)]]]
+ [//
+ ["&" function]])
(def: (bit-spec run)
(-> Runner Test)
@@ -37,8 +39,7 @@
(n/= (<reference> param subject) (:coerce Nat valueT))
(#error.Error error)
- (exec (log! error)
- #0))
+ #0)
(let [param <param-expr>])))]
["lux bit and" i64.and param]
@@ -59,8 +60,7 @@
(:coerce I64 valueT))
(#error.Error error)
- (exec (log! error)
- #0))
+ #0)
(let [param (n/% 64 param)])))
))))
@@ -77,8 +77,7 @@
(<comp> (<prepare> subject) (:coerce <type> valueT))
(#error.Error error)
- (exec (log! error)
- #0))
+ #0)
(let [subject <subject-expr>])))]
["lux i64 to-f64" Frac int-to-frac f/= subject]
@@ -95,8 +94,7 @@
(<comp> (<reference> param subject) (:coerce <outputT> valueT))
(#error.Error error)
- (exec (log! error)
- #0))))]
+ #0)))]
["lux i64 +" i/+ Int i/=]
["lux i64 -" i/- Int i/=]
@@ -108,110 +106,98 @@
))
))))
-(def: (f64-spec/0 run)
- (-> Runner Test)
- (do r.Monad<Random>
- [param (|> r.frac (r.filter (|>> (f/= +0.0) not)))
- subject r.frac]
- (with-expansions [<binary> (do-template [<name> <reference> <outputT> <comp>]
- [(test <name>
- (|> (run (#synthesis.Extension <name> (list (synthesis.f64 subject)
- (synthesis.f64 param))))
- (case> (#error.Success valueT)
- (<comp> (<reference> param subject) (:coerce <outputT> valueT))
-
- _
- #0)))]
-
- ["lux f64 +" f/+ Frac f/=]
- ["lux f64 -" f/- Frac f/=]
- ["lux f64 *" f/* Frac f/=]
- ["lux f64 /" f// Frac f/=]
- ["lux f64 %" f/% Frac f/=]
- ["lux f64 =" f/= Bit bit/=]
- ["lux f64 <" f/< Bit bit/=]
- )]
- ($_ seq
- <binary>
- ))))
+(def: simple-frac
+ (Random Frac)
+ (|> r.nat (:: r.Monad<Random> map (|>> (n/% 1000) .int int-to-frac))))
-(def: (f64-spec/1 run)
+(def: (f64-spec run)
(-> Runner Test)
(do r.Monad<Random>
- [subject (|> r.nat (:: @ map (|>> (n/% 1000) .int int-to-frac)))]
+ [param (|> ..simple-frac (r.filter (|>> (f/= +0.0) not)))
+ subject ..simple-frac]
(`` ($_ seq
- (~~ (do-template [<name> <test>]
+ (~~ (do-template [<name> <reference> <comp>]
[(test <name>
- (|> (run (#synthesis.Extension <name> (list)))
- (case> (#error.Success valueT)
- (<test> (:coerce Frac valueT))
+ (|> (run (#synthesis.Extension <name> (list (synthesis.f64 subject)
+ (synthesis.f64 param))))
+ (&.check (<reference> param subject))))]
+
+ ["lux f64 +" f/+ f/=]
+ ["lux f64 -" f/- f/=]
+ ["lux f64 *" f/* f/=]
+ ["lux f64 /" f// f/=]
+ ["lux f64 %" f/% f/=]
+ ))
+ (~~ (do-template [<name> <text>]
+ [(test <name>
+ (|> (run (#synthesis.Extension <name> (list (synthesis.f64 subject)
+ (synthesis.f64 param))))
+ (case> (#error.Success valueV)
+ (bit/= (<text> param subject)
+ (:coerce Bit valueV))
_
#0)))]
- ["lux f64 min" (f/= frac/bottom)]
- ["lux f64 max" (f/= frac/top)]
- ["lux f64 smallest" (f/= ("lux frac smallest"))]
+ ["lux f64 =" f/=]
+ ["lux f64 <" f/<]
+ ))
+ (~~ (do-template [<name> <reference>]
+ [(test <name>
+ (|> (run (#synthesis.Extension <name> (list)))
+ (&.check <reference>)))]
+
+ ["lux f64 min" frac/bottom]
+ ["lux f64 max" frac/top]
+ ["lux f64 smallest" ("lux frac smallest")]
))
(test "\"lux f64 to-i64\" && \"lux i64 to-f64\""
(|> (run (|> subject synthesis.f64
(list) (#synthesis.Extension "lux f64 to-i64")
(list) (#synthesis.Extension "lux i64 to-f64")))
- (case> (#error.Success valueT)
- (f/= subject (:coerce Frac valueT))
-
- (#error.Error error)
- (exec (log! error)
- #0))))
+ (&.check subject)))
))))
-(def: (f64-spec run)
- (-> Runner Test)
- ($_ seq
- (f64-spec/0 run)
- (f64-spec/1 run)))
-
(def: (text-spec run)
(-> Runner Test)
(do r.Monad<Random>
[sample-size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))
- sample0 (r.ascii/lower-alpha sample-size)
- sample1 (r.ascii/upper-alpha sample-size)
- sample2 (|> (r.ascii/alpha sample-size)
- (r.filter (|>> (text/= sample1) not)))
+ sample-lower (r.ascii/lower-alpha sample-size)
+ sample-upper (r.ascii/upper-alpha sample-size)
+ sample-alpha (|> (r.ascii/alpha sample-size)
+ (r.filter (|>> (text/= sample-upper) not)))
char-idx (|> r.nat (:: @ map (n/% sample-size)))
- #let [sample0S (synthesis.text sample0)
- sample1S (synthesis.text sample1)
- sample2S (synthesis.text sample2)
- concatenatedS (#synthesis.Extension "lux text concat" (list sample0S sample1S))
- pre-rep-once (format sample0 sample1)
- post-rep-once (format sample0 sample2)
- pre-rep-all (|> (list.repeat sample-size sample0) (text.join-with sample1))
- post-rep-all (|> (list.repeat sample-size sample0) (text.join-with sample2))]]
+ #let [sample-lowerS (synthesis.text sample-lower)
+ sample-upperS (synthesis.text sample-upper)
+ sample-alphaS (synthesis.text sample-alpha)
+ concatenatedS (#synthesis.Extension "lux text concat" (list sample-lowerS sample-upperS))
+ pre-rep-once (format sample-lower sample-upper)
+ post-rep-once (format sample-lower sample-alpha)
+ pre-rep-all (|> (list.repeat sample-size sample-lower) (text.join-with sample-upper))
+ post-rep-all (|> (list.repeat sample-size sample-lower) (text.join-with sample-alpha))]]
($_ seq
(test "Can compare texts for equality."
- (and (|> (run (#synthesis.Extension "lux text =" (list sample0S sample0S)))
+ (and (|> (run (#synthesis.Extension "lux text =" (list sample-lowerS sample-lowerS)))
(case> (#error.Success valueV)
(:coerce Bit valueV)
_
#0))
- (|> (run (#synthesis.Extension "lux text =" (list sample0S sample1S)))
+ (|> (run (#synthesis.Extension "lux text =" (list sample-lowerS sample-upperS)))
(case> (#error.Success valueV)
(not (:coerce Bit valueV))
_
#0))))
(test "Can compare texts for order."
- (|> (run (#synthesis.Extension "lux text <" (list sample1S sample0S)))
+ (|> (run (#synthesis.Extension "lux text <" (list sample-upperS sample-lowerS)))
(case> (#error.Success valueV)
(:coerce Bit valueV)
(#error.Error error)
- (exec (log! error)
- #0))))
+ #0)))
(test "Can get length of text."
- (|> (run (#synthesis.Extension "lux text size" (list sample0S)))
+ (|> (run (#synthesis.Extension "lux text size" (list sample-lowerS)))
(case> (#error.Success valueV)
(n/= sample-size (:coerce Nat valueV))
@@ -226,7 +212,7 @@
#0)))
(test "Can find index of sub-text."
(and (|> (run (#synthesis.Extension "lux text index"
- (list concatenatedS sample0S
+ (list concatenatedS sample-lowerS
(synthesis.i64 +0))))
(case> (^multi (#error.Success valueV)
[(:coerce (Maybe Nat) valueV) (#.Some valueV)])
@@ -235,7 +221,7 @@
_
#0))
(|> (run (#synthesis.Extension "lux text index"
- (list concatenatedS sample1S
+ (list concatenatedS sample-upperS
(synthesis.i64 +0))))
(case> (^multi (#error.Success valueV)
[(:coerce (Maybe Nat) valueV) (#.Some valueV)])
@@ -256,16 +242,16 @@
_
#0))))]
(test "Can clip text to extract sub-text."
- (and (test-clip 0 sample-size sample0)
- (test-clip sample-size (n/* 2 sample-size) sample1))))
+ (and (test-clip 0 sample-size sample-lower)
+ (test-clip sample-size (n/* 2 sample-size) sample-upper))))
(test "Can extract individual characters from text."
(|> (run (#synthesis.Extension "lux text char"
- (list sample0S
+ (list sample-lowerS
(synthesis.i64 char-idx))))
(case> (^multi (#error.Success valueV)
[(:coerce (Maybe Int) valueV) (#.Some valueV)])
(text.contains? ("lux int char" valueV)
- sample0)
+ sample-lower)
_
#0)))
@@ -283,8 +269,7 @@
#1
(#error.Error error)
- (exec (log! error)
- #0))))
+ #0)))
(test "Can throw runtime errors."
(and (|> (run (#synthesis.Extension "lux try"
(list (synthesis.function/abstraction
@@ -317,8 +302,7 @@
(n/>= pre post))
(#error.Error error)
- (exec (log! error)
- #0))))
+ #0)))
)))
(def: (all-specs run)
@@ -331,38 +315,38 @@
(io-spec run)
))
-(context: "[JVM] Common procedures."
+(context: "[JVM] Common extensions."
(<| (times 100)
(all-specs common.run-jvm)))
-## (context: "[JS] Common procedures."
+## (context: "[JS] Common extensions."
## (<| (times 100)
## (all-specs common.run-js)))
-## (context: "[Lua] Common procedures."
+## (context: "[Lua] Common extensions."
## (<| (times 100)
## (all-specs common.run-lua)))
-## (context: "[Ruby] Common procedures."
+## (context: "[Ruby] Common extensions."
## (<| (times 100)
## (all-specs common.run-ruby)))
-## (context: "[Python] Common procedures."
+## (context: "[Python] Common extensions."
## (<| (times 100)
## (all-specs common.run-python)))
-## (context: "[R] Common procedures."
+## (context: "[R] Common extensions."
## (<| (times 100)
## (all-specs common.run-r)))
-## (context: "[Scheme] Common procedures."
+## (context: "[Scheme] Common extensions."
## (<| (times 100)
## (all-specs common.run-scheme)))
-## (context: "[Common Lisp] Common procedures."
+## (context: "[Common Lisp] Common extensions."
## (<| (times 100)
## (all-specs common.run-common-lisp)))
-## (context: "[PHP] Common procedures."
+## (context: "[PHP] Common extensions."
## (<| (times 100)
## (all-specs common.run-php)))
diff --git a/new-luxc/test/test/luxc/lang/translation/function.lux b/new-luxc/test/test/luxc/lang/translation/function.lux
index 981dbb889..ef5bf7b67 100644
--- a/new-luxc/test/test/luxc/lang/translation/function.lux
+++ b/new-luxc/test/test/luxc/lang/translation/function.lux
@@ -1,18 +1,21 @@
(.module:
- [lux #*
+ [lux (#- function)
[control
[monad (#+ do)]
pipe]
[data
["." maybe]
["." error (#+ Error)]
+ ["." number]
+ [text
+ format]
[collection
["." list ("list/." Functor<List>)]]]
[math
- ["r" random ("r/." Monad<Random>)]]
+ ["r" random (#+ Random) ("r/." Monad<Random>)]]
[compiler
[default
- ["." reference]
+ ["." reference (#+ Register)]
[phase
[analysis (#+ Arity)]
["." synthesis (#+ Synthesis)]]]]
@@ -21,77 +24,83 @@
[luxc
["." common (#+ Runner)]]])
-(def: max-arity Nat 10)
+(def: max-arity Arity 10)
(def: arity
- (r.Random Arity)
+ (Random Arity)
(|> r.nat (r/map (|>> (n/% max-arity) (n/max 1)))))
-(def: gen-function
- (r.Random [Arity Nat Synthesis])
+(def: (local arity)
+ (-> Arity(Random Register))
+ (|> r.nat (r/map (|>> (n/% arity) inc))))
+
+(def: function
+ (Random [Arity Register Synthesis])
(do r.Monad<Random>
- [arity arity
- arg (|> r.nat (:: @ map (n/% arity)))]
- (wrap [arity arg
+ [arity ..arity
+ local (..local arity)]
+ (wrap [arity local
(synthesis.function/abstraction
{#synthesis.environment (list)
#synthesis.arity arity
- #synthesis.body (synthesis.variable/local arg)})])))
-
-(def: upper-alpha-ascii
- (r.Random Nat)
- (|> r.nat (:: r.Functor<Random> map (|>> (n/% 26) (n/+ 65)))))
+ #synthesis.body (synthesis.variable/local local)})])))
(def: #export (check reference)
(-> Frac (Error Any) Bit)
(|>> (case> (#error.Success valueT)
- (|> valueT (:coerce Frac) (f/= reference))
+ (f/= reference (:coerce Frac valueT))
(#error.Error error)
(exec (log! error)
#0))))
+(def: #export safe-frac
+ (Random Frac)
+ (|> r.frac (r.filter (|>> number.not-a-number? not))))
+
(def: (function-spec run)
(-> Runner Test)
(do r.Monad<Random>
- [[arity arg functionS] gen-function
- cut-off (|> r.nat (:: @ map (n/% arity)))
- args (r.list arity r.frac)
- #let [arg-value (maybe.assume (list.nth arg args))
- argsS (list/map (|>> synthesis.f64) args)
- last-arg (dec arity)
- cut-off (|> cut-off (n/min (dec last-arg)))]]
+ [[arity local functionS] ..function
+ partial-arity (|> r.nat (:: @ map (|>> (n/% arity) (n/max 1))))
+ inputs (r.list arity safe-frac)
+ #let [expectation (maybe.assume (list.nth (dec local) inputs))
+ inputsS (list/map (|>> synthesis.f64) inputs)]]
($_ seq
(test "Can read arguments."
- (|> (run (synthesis.function/apply [functionS argsS]))
- (check arg-value)))
+ (|> (run (synthesis.function/apply {#synthesis.function functionS
+ #synthesis.arguments inputsS}))
+ (check expectation)))
(test "Can partially apply functions."
(or (n/= 1 arity)
- (let [partial-arity (inc cut-off)
- preS (list.take partial-arity argsS)
- postS (list.drop partial-arity argsS)]
- (|> (run (synthesis.function/apply {#synthesis.function (synthesis.function/apply {#synthesis.function functionS
- #synthesis.arguments preS})
- #synthesis.arguments postS}))
- (check arg-value)))))
+ (let [preS (list.take partial-arity inputsS)
+ postS (list.drop partial-arity inputsS)
+ partialS (synthesis.function/apply {#synthesis.function functionS
+ #synthesis.arguments preS})
+ totalS (synthesis.function/apply {#synthesis.function partialS
+ #synthesis.arguments postS})]
+ (|> (run totalS)
+ (check expectation)))))
(test "Can read environment."
(or (n/= 1 arity)
- (let [environment (|> (list.n/range 0 cut-off)
+ (let [environment (|> partial-arity
+ (list.n/range 1)
(list/map (|>> #reference.Local)))
- arity::super (inc cut-off)
- argument (if (n/<= cut-off arg)
- (synthesis.variable/foreign arg)
- (synthesis.variable/local (n/- (dec arity::super) arg)))
- arity::sub (|> arity (n/- arity::super))
- functionS (synthesis.function/abstraction
- {#synthesis.environment (list)
- #synthesis.arity arity::super
- #synthesis.body (synthesis.function/abstraction
- {#synthesis.environment environment
- #synthesis.arity arity::sub
- #synthesis.body argument})})]
- (|> (run (synthesis.function/apply [functionS argsS]))
- (check arg-value)))))
+ variableS (if (n/<= partial-arity local)
+ (synthesis.variable/foreign (dec local))
+ (synthesis.variable/local (|> local (n/- partial-arity))))
+ inner-arity (n/- partial-arity arity)
+ innerS (synthesis.function/abstraction
+ {#synthesis.environment environment
+ #synthesis.arity inner-arity
+ #synthesis.body variableS})
+ outerS (synthesis.function/abstraction
+ {#synthesis.environment (list)
+ #synthesis.arity partial-arity
+ #synthesis.body innerS})]
+ (|> (run (synthesis.function/apply {#synthesis.function outerS
+ #synthesis.arguments inputsS}))
+ (check expectation)))))
)))
(context: "[JVM] Function."
diff --git a/new-luxc/test/test/luxc/lang/translation/reference.lux b/new-luxc/test/test/luxc/lang/translation/reference.lux
index c1a348f76..18205a560 100644
--- a/new-luxc/test/test/luxc/lang/translation/reference.lux
+++ b/new-luxc/test/test/luxc/lang/translation/reference.lux
@@ -4,15 +4,14 @@
[monad (#+ do)]
pipe]
[data
- ["e" error]
- ["." text]]
+ ["." number]]
[compiler
[default
["." reference]
[phase
["." synthesis]]]]
[math
- ["r" random]]
+ ["r" random (#+ Random)]]
test]
[test
[luxc
@@ -20,16 +19,16 @@
[//
["&" function]])
-(def: name^
- (r.Random Name)
+(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 r.frac]
+ [name ..name
+ value &.safe-frac]
(test "Can refer to definitions."
(|> (define name (synthesis.f64 value))
(&.check value)))))
@@ -38,7 +37,7 @@
(-> Runner Test)
(do r.Monad<Random>
[register (|> r.nat (:: @ map (n/% 100)))
- value r.frac]
+ value &.safe-frac]
(test "Can refer to local variables/registers."
(|> (run (synthesis.branch/let [(synthesis.f64 value)
register
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-30 19:48:46 +0000