From c3cdaad1d13f38ec926e7113ae95a25611a04053 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 30 Jul 2018 21:27:26 -0400
Subject: Updating new-luxc to latest Lux changes [Part 1].
---
new-luxc/test/test/luxc/common.lux | 62 ++--
new-luxc/test/test/luxc/lang/translation/case.lux | 161 ++++----
.../test/test/luxc/lang/translation/common.lux | 412 ++++++++++++---------
.../test/test/luxc/lang/translation/reference.lux | 111 +++---
4 files changed, 391 insertions(+), 355 deletions(-)
(limited to 'new-luxc/test')
diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux
index 87ecaed5c..7b370ab21 100644
--- a/new-luxc/test/test/luxc/common.lux
+++ b/new-luxc/test/test/luxc/common.lux
@@ -9,11 +9,12 @@
["." code]]
[compiler
["." default
+ ["." reference]
["." init]
["." phase
["." analysis
["." module]]
- [synthesis (#+ Synthesis)]
+ ["." synthesis (#+ Synthesis)]
["." translation]
[extension
["." bundle]]]]]]
@@ -90,45 +91,40 @@
(translation.evaluate! program))
(phase.run [bundle (io.run state)]))))
-## (def: (definer generate-runtime translate bundle state translate-def)
-## (All [a]
-## (-> (Operation Any) Phase Bundle (IO State)
-## (-> Text Type a Code (Meta Any))
-## Definer))
-## (function (_ [module-name def-name] synthesis)
-## (|> (do macro.Monad
-## [_ generate-runtime
-## valueO (translate synthesis)
-## _ (module.with-module +0 module-name
-## (translate-def def-name Any valueO (' {})))
-## sampleO (translate (code.identifier [module-name def-name]))]
-## (eval sampleO))
-## (analysis.with-current-module "")
-## (macro.run (io.run init)))))
+(def: (definer generate-runtime translate bundle state)
+ (-> (Operation Any) Phase Bundle (IO State) Definer)
+ (function (_ name synthesis)
+ (|> (do phase.Monad
+ [_ generate-runtime
+ valueS (translate synthesis)
+ _ (translation.define! name valueS)
+ program (translate (synthesis.constant name))]
+ (translation.evaluate! program))
+ (phase.run [bundle (io.run state)]))))
(def: #export run-jvm (runner runtime_jvm.translate expression_jvm.translate bundle.empty init-jvm))
-## (def: #export def-jvm (definer runtime_jvm.translate expression_jvm.translate init-jvm statement_jvm.translate-def))
+(def: #export def-jvm (definer runtime_jvm.translate expression_jvm.translate bundle.empty init-jvm))
-## (def: #export run-js (runner runtime_js.translate expression_js.translate init-js))
-## (def: #export def-js (definer runtime_js.translate expression_js.translate init-js statement_js.translate-def))
+## (def: #export run-js (runner runtime_js.translate expression_js.translate bundle.empty init-js))
+## (def: #export def-js (definer runtime_js.translate expression_js.translate bundle.empty init-js))
-## (def: #export run-lua (runner runtime_lua.translate expression_lua.translate init-lua))
-## (def: #export def-lua (definer runtime_lua.translate expression_lua.translate init-lua statement_lua.translate-def))
+## (def: #export run-lua (runner runtime_lua.translate expression_lua.translate bundle.empty init-lua))
+## (def: #export def-lua (definer runtime_lua.translate expression_lua.translate bundle.empty init-lua))
-## (def: #export run-ruby (runner runtime_ruby.translate expression_ruby.translate init-ruby))
-## (def: #export def-ruby (definer runtime_ruby.translate expression_ruby.translate init-ruby statement_ruby.translate-def))
+## (def: #export run-ruby (runner runtime_ruby.translate expression_ruby.translate bundle.empty init-ruby))
+## (def: #export def-ruby (definer runtime_ruby.translate expression_ruby.translate bundle.empty init-ruby))
-## (def: #export run-python (runner runtime_python.translate expression_python.translate init-python))
-## (def: #export def-python (definer runtime_python.translate expression_python.translate init-python statement_python.translate-def))
+## (def: #export run-python (runner runtime_python.translate expression_python.translate bundle.empty init-python))
+## (def: #export def-python (definer runtime_python.translate expression_python.translate bundle.empty init-python))
-## (def: #export run-r (runner runtime_r.translate expression_r.translate init-r))
-## (def: #export def-r (definer runtime_r.translate expression_r.translate init-r statement_r.translate-def))
+## (def: #export run-r (runner runtime_r.translate expression_r.translate bundle.empty init-r))
+## (def: #export def-r (definer runtime_r.translate expression_r.translate bundle.empty init-r))
-## (def: #export run-scheme (runner runtime_scheme.translate expression_scheme.translate init-scheme))
-## (def: #export def-scheme (definer runtime_scheme.translate expression_scheme.translate init-scheme statement_scheme.translate-def))
+## (def: #export run-scheme (runner runtime_scheme.translate expression_scheme.translate bundle.empty init-scheme))
+## (def: #export def-scheme (definer runtime_scheme.translate expression_scheme.translate bundle.empty init-scheme))
-## (def: #export run-common-lisp (runner runtime_common-lisp.translate expression_common-lisp.translate init-common-lisp))
-## (def: #export def-common-lisp (definer runtime_common-lisp.translate expression_common-lisp.translate init-common-lisp statement_common-lisp.translate-def))
+## (def: #export run-common-lisp (runner runtime_common-lisp.translate expression_common-lisp.translate bundle.empty init-common-lisp))
+## (def: #export def-common-lisp (definer runtime_common-lisp.translate expression_common-lisp.translate bundle.empty init-common-lisp))
-## (def: #export run-php (runner runtime_php.translate expression_php.translate init-php))
-## (def: #export def-php (definer runtime_php.translate expression_php.translate init-php statement_php.translate-def))
+## (def: #export run-php (runner runtime_php.translate expression_php.translate bundle.empty init-php))
+## (def: #export def-php (definer runtime_php.translate expression_php.translate bundle.empty init-php))
diff --git a/new-luxc/test/test/luxc/lang/translation/case.lux b/new-luxc/test/test/luxc/lang/translation/case.lux
index 391dc5ad8..ed8529429 100644
--- a/new-luxc/test/test/luxc/lang/translation/case.lux
+++ b/new-luxc/test/test/luxc/lang/translation/case.lux
@@ -1,62 +1,81 @@
(.module:
- lux
- (lux [io #+ IO]
- (control [monad #+ do]
- pipe)
- (data ["e" error]
- text/format
- (coll [list]))
- ["r" math/random]
- (lang ["//." synthesis #+ Path Synthesis])
- test)
- (test/luxc common))
-
-(def: struct-limit Nat +10)
+ [lux #*
+ [control
+ [monad (#+ do)]
+ pipe]
+ [data
+ ["e" error]
+ [text
+ format]
+ [collection
+ ["." list]]]
+ [math
+ ["r" random]]
+ [compiler
+ [default
+ ["." reference]
+ [phase
+ ["." analysis]
+ ["." synthesis (#+ Path Synthesis)]]]]
+ test]
+ [test
+ [luxc
+ ["." common (#+ Runner)]]]
+ [//
+ ["&" function]])
+
+(def: struct-limit Nat 10)
(def: (tail? size idx)
(-> Nat Nat Bit)
- (n/= (n/dec size) idx))
+ (n/= (dec size) idx))
(def: gen-case
(r.Random [Synthesis Path])
(<| r.rec (function (_ gen-case))
(`` ($_ r.either
(do r.Monad
- [value r.int]
- (wrap [(//synthesis.path/i64 value)
- //synthesis.path/pop]))
+ [value r.i64]
+ (wrap [(synthesis.i64 value)
+ synthesis.path/pop]))
(~~ (do-template [ ]
[(do r.Monad
[value ]
(wrap [( value)
( value)]))]
- [r.bit //synthesis.bit //synthesis.path/bit]
- [r.int //synthesis.i64 //synthesis.path/i64]
- [r.frac //synthesis.f64 //synthesis.path/f64]
- [(r.unicode +5) //synthesis.text //synthesis.path/text]))
+ [r.bit synthesis.bit synthesis.path/bit]
+ [r.i64 synthesis.i64 synthesis.path/i64]
+ [r.frac synthesis.f64 synthesis.path/f64]
+ [(r.unicode 5) synthesis.text synthesis.path/text]))
(do r.Monad
- [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2))))
+ [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max 2))))
idx (|> r.nat (:: @ map (n/% size)))
[subS subP] gen-case
- #let [caseS (` [(~+ (list.concat (list (list.repeat idx (' []))
- (list subS)
- (list.repeat (|> size n/dec (n/- idx)) (' [])))))])
- caseP (//synthesis.path/seq [(if (tail? size idx)
- (` ("lux case tuple right" (~ (code.nat idx))))
- (` ("lux case tuple left" (~ (code.nat idx)))))
- subP])]]
+ #let [unitS (synthesis.text synthesis.unit)
+ caseS (synthesis.tuple
+ (list.concat (list (list.repeat idx unitS)
+ (list subS)
+ (list.repeat (|> size dec (n/- idx)) unitS))))
+ caseP (synthesis.path/seq [(if (tail? size idx)
+ (synthesis.member/right idx)
+ (synthesis.member/left idx))
+ subP])]]
(wrap [caseS caseP]))
(do r.Monad
- [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2))))
+ [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max 2))))
idx (|> r.nat (:: @ map (n/% size)))
[subS subP] gen-case
- #let [caseS (` ((~ (code.nat idx)) (~ (code.bit (tail? size idx))) (~ subS)))
- caseP (` ("lux case seq"
- (~ (if (tail? size idx)
- (` ("lux case variant right" (~ (code.nat idx))))
- (` ("lux case variant left" (~ (code.nat idx))))))
- (~ subP)))]]
+ #let [caseS (let [right? (tail? size idx)]
+ (synthesis.variant
+ {#analysis.lefts idx
+ #analysis.right? right?
+ #analysis.value subS}))
+ caseP (synthesis.path/seq
+ [(if (tail? size idx)
+ (synthesis.side/right idx)
+ (synthesis.side/left idx))
+ subP])]]
(wrap [caseS caseP]))
))))
@@ -64,65 +83,55 @@
(-> Runner Test)
(do r.Monad
[[valueS pathS] gen-case
- to-bind r.nat]
+ to-bind r.frac]
($_ seq
(test "Can translate pattern-matching."
- (|> (run (` ("lux case" (~ valueS)
- ("lux case alt"
- ("lux case seq" (~ pathS)
- ("lux case exec" #1))
- ("lux case seq" ("lux case bind" +0)
- ("lux case exec" #0))))))
- (case> (#e.Success valueT)
- (:coerce Bit valueT)
-
- (#e.Error error)
- (exec (log! error)
- #0))))
+ (|> (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 (` ("lux case" (~ (code.nat to-bind))
- ("lux case seq" ("lux case bind" +0)
- ("lux case exec" (0))))))
- (case> (#e.Success valueT)
- (n/= to-bind (:coerce Nat valueT))
-
- (#e.Error error)
- (exec (log! error)
- #0))))
+ (|> (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)))
)))
(context: "[JVM] Pattern-matching."
- (<| (times +100)
- (pattern-matching-spec run-jvm)))
+ (<| (times 100)
+ (pattern-matching-spec common.run-jvm)))
## (context: "[JS] Pattern-matching."
-## (<| (times +100)
-## (pattern-matching-spec run-js)))
+## (<| (times 100)
+## (pattern-matching-spec common.run-js)))
## (context: "[Lua] Pattern-matching."
-## (<| (times +100)
-## (pattern-matching-spec run-lua)))
+## (<| (times 100)
+## (pattern-matching-spec common.run-lua)))
## (context: "[Ruby] Pattern-matching."
-## (<| (times +100)
-## (pattern-matching-spec run-ruby)))
+## (<| (times 100)
+## (pattern-matching-spec common.run-ruby)))
## (context: "[Python] Function."
-## (<| (times +100)
-## (pattern-matching-spec run-python)))
+## (<| (times 100)
+## (pattern-matching-spec common.run-python)))
## (context: "[R] Pattern-matching."
-## (<| (times +100)
-## (pattern-matching-spec run-r)))
+## (<| (times 100)
+## (pattern-matching-spec common.run-r)))
## (context: "[Scheme] Pattern-matching."
-## (<| (times +100)
-## (pattern-matching-spec run-scheme)))
+## (<| (times 100)
+## (pattern-matching-spec common.run-scheme)))
## (context: "[Common Lisp] Pattern-matching."
-## (<| (times +100)
-## (pattern-matching-spec run-common-lisp)))
+## (<| (times 100)
+## (pattern-matching-spec common.run-common-lisp)))
## (context: "[PHP] Pattern-matching."
-## (<| (times +100)
-## (pattern-matching-spec run-php)))
+## (<| (times 100)
+## (pattern-matching-spec common.run-php)))
diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux
index 769aea3f5..2641d8acd 100644
--- a/new-luxc/test/test/luxc/lang/translation/common.lux
+++ b/new-luxc/test/test/luxc/lang/translation/common.lux
@@ -1,34 +1,38 @@
(.module:
- lux
- (lux [io #+ IO]
- (control [monad #+ do]
- pipe)
- (data text/format
- [bit]
- ["e" error]
- [bit "bit/" Eq]
- [text "text/" Eq]
- [number "int/" Number "frac/" Number Interval]
- (coll ["a" array]
- [list]))
- ["r" math/random]
- [macro]
- (macro [code])
- [host]
- test)
- (luxc [lang]
- (lang [synthesis #+ Synthesis]))
- (test/luxc common))
+ [lux #*
+ [control
+ [monad (#+ do)]
+ pipe]
+ [data
+ ["e" error]
+ [bit ("bit/." Equivalence)]
+ [number ("frac/." Number Interval)
+ ["." i64]]
+ ["." text ("text/." Equivalence)
+ format]
+ [collection
+ ["." list]]]
+ [math
+ ["r" random]]
+ [compiler
+ [default
+ ["." reference]
+ [phase
+ ["." synthesis]]]]
+ test]
+ [test
+ [luxc
+ ["." common (#+ Runner)]]])
(def: (bit-spec run)
(-> Runner Test)
(do r.Monad
- [param r.nat
- subject r.nat]
+ [param r.i64
+ subject r.i64]
(with-expansions [ (do-template [ ]
[(test
- (|> (run (` ( (~ (code.nat subject))
- (~ (code.nat param)))))
+ (|> (run (#synthesis.Extension (list (synthesis.i64 subject)
+ (synthesis.i64 param))))
(case> (#e.Success valueT)
(n/= ( param subject) (:coerce Nat valueT))
@@ -37,39 +41,38 @@
#0))
(let [param ])))]
- ["lux bit and" bit.and param]
- ["lux bit or" bit.or param]
- ["lux bit xor" bit.xor param]
- ["lux bit left-shift" bit.left-shift (n/% +64 param)]
- ["lux bit logical-right-shift" bit.logical-right-shift (n/% +64 param)]
+ ["lux bit and" i64.and param]
+ ["lux bit or" i64.or param]
+ ["lux bit xor" i64.xor param]
+ ["lux bit left-shift" i64.left-shift (n/% 64 param)]
+ ["lux bit logical-right-shift" i64.logical-right-shift (n/% 64 param)]
)]
($_ seq
(test "lux bit arithmetic-right-shift"
- (|> (run (` ("lux bit arithmetic-right-shift"
- (~ (code.int (nat-to-int subject)))
- (~ (code.nat param)))))
+ (|> (run (#synthesis.Extension "lux bit arithmetic-right-shift"
+ (list (synthesis.i64 subject)
+ (synthesis.i64 param))))
(case> (#e.Success valueT)
- (i/= (bit.arithmetic-right-shift param (nat-to-int subject))
- (:coerce Int valueT))
+ ("lux i64 ="
+ (i64.arithmetic-right-shift param subject)
+ (:coerce I64 valueT))
(#e.Error error)
(exec (log! error)
#0))
- (let [param (n/% +64 param)])))
+ (let [param (n/% 64 param)])))
))))
-(def: (int-spec run)
+(def: (i64-spec run)
(-> Runner Test)
(do r.Monad
- [param (|> r.int (r.filter (|>> (i/= 0) not)))
- subject r.int
- #let [_ (log! (format " param = " (%i param) "\n"
- "subject = " (%i subject) "\n"))]]
+ [param (|> r.i64 (r.filter (|>> ("lux i64 =" 0) not)))
+ subject r.i64]
(`` ($_ seq
(~~ (do-template [ ]
[(test
- (|> (run (` ( (~ (code.int subject)))))
+ (|> (run (#synthesis.Extension (list (synthesis.i64 subject))))
(case> (#e.Success valueT)
( ( subject) (:coerce valueT))
@@ -78,16 +81,17 @@
#0))
(let [subject ])))]
- ["lux int to-frac" Frac int-to-frac f/= subject]
- ["lux int char" Text (|>> (:coerce Nat) text.from-code) text/= (|> subject
+ ["lux i64 to-frac" Frac int-to-frac f/= subject]
+ ["lux i64 char" Text (|>> (:coerce Nat) text.from-code) text/= (|> subject
(:coerce Nat)
- (n/% (bit.left-shift +8 +1))
+ (n/% (i64.left-shift 8 1))
(:coerce Int))]
))
(~~ (do-template [ ]
[(test
(exec (log! )
- (|> (run (` ( (~ (code.int subject)) (~ (code.int param)))))
+ (|> (run (#synthesis.Extension (list (synthesis.i64 subject)
+ (synthesis.i64 param))))
(case> (#e.Success valueT)
( ( param subject) (:coerce valueT))
@@ -95,63 +99,66 @@
(exec (log! error)
#0)))))]
- ["lux int +" i/+ Int i/=]
- ["lux int -" i/- Int i/=]
- ["lux int *" i/* Int i/=]
- ["lux int /" i// Int i/=]
- ["lux int %" i/% Int i/=]
- ["lux int =" i/= Bit bit/=]
- ["lux int <" i/< Bit bit/=]
+ ["lux i64 +" i/+ Int i/=]
+ ["lux i64 -" i/- Int i/=]
+ ["lux i64 *" i/* Int i/=]
+ ["lux i64 /" i// Int i/=]
+ ["lux i64 %" i/% Int i/=]
+ ["lux i64 =" i/= Bit bit/=]
+ ["lux i64 <" i/< Bit bit/=]
))
))))
-(def: (frac-spec|0 run)
+(def: (f64-spec/0 run)
(-> Runner Test)
(do r.Monad
- [param (|> r.frac (r.filter (|>> (f/= 0.0) not)))
+ [param (|> r.frac (r.filter (|>> (f/= +0.0) not)))
subject r.frac]
(with-expansions [ (do-template [ ]
[(test
- (|> (run (` ( (~ (code.frac subject)) (~ (code.frac param)))))
+ (|> (run (#synthesis.Extension (list (synthesis.f64 subject)
+ (synthesis.f64 param))))
(case> (#e.Success valueT)
( ( param subject) (:coerce valueT))
_
#0)))]
- ["lux frac +" f/+ Frac f/=]
- ["lux frac -" f/- Frac f/=]
- ["lux frac *" f/* Frac f/=]
- ["lux frac /" f// Frac f/=]
- ["lux frac %" f/% Frac f/=]
- ["lux frac =" f/= Bit bit/=]
- ["lux frac <" f/< Bit bit/=]
+ ["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
))))
-(def: (frac-spec|1 run)
+(def: (f64-spec/1 run)
(-> Runner Test)
(do r.Monad
[subject r.frac]
(`` ($_ seq
(~~ (do-template [ ]
[(test
- (|> (run (` ()))
+ (|> (run (#synthesis.Extension (list)))
(case> (#e.Success valueT)
( (:coerce Frac valueT))
_
#0)))]
- ["lux frac min" (f/= frac/bottom)]
- ["lux frac max" (f/= frac/top)]
- ["lux frac smallest" (f/= ("lux frac smallest"))]
+ ["lux f64 min" (f/= frac/bottom)]
+ ["lux f64 max" (f/= frac/top)]
+ ["lux f64 smallest" (f/= ("lux frac smallest"))]
))
(~~ (do-template [ ]
[(test
- (|> (run (` ( ( (~ (code.frac subject))))))
+ (|> (run (|> subject synthesis.f64
+ (list) (#synthesis.Extension )
+ (list) (#synthesis.Extension )))
(case> (#e.Success valueT)
(|> valueT (:coerce Frac) (f/- subject) frac/abs )
@@ -159,113 +166,105 @@
(exec (log! error)
#0))))]
- ["lux frac to-int" "lux int to-frac" (f/< 1.0)]))
+ ["lux f64 to-int" "lux i64 to-frac" (f/< +1.0)]))
))))
-(def: (frac-spec run)
+(def: (f64-spec run)
(-> Runner Test)
($_ seq
- (frac-spec|0 run)
- (frac-spec|1 run)))
-
-(def: lower-alpha
- (r.Random Nat)
- (|> r.nat (:: r.Functor map (|>> (n/% +26) (n/+ +97)))))
-
-(def: upper-alpha
- (r.Random Nat)
- (|> r.nat (:: r.Functor map (|>> (n/% +26) (n/+ +65)))))
-
-(def: alpha
- (r.Random Nat)
- (r.either lower-alpha
- upper-alpha))
+ (f64-spec/0 run)
+ (f64-spec/1 run)))
(def: (text-spec run)
(-> Runner Test)
(do r.Monad
- [sample-size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
- sample0 (r.text' lower-alpha sample-size)
- sample1 (r.text' upper-alpha sample-size)
- sample2 (|> (r.text' alpha sample-size)
+ [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)))
char-idx (|> r.nat (:: @ map (n/% sample-size)))
- #let [sample0S (code.text sample0)
- sample1S (code.text sample1)
- sample2S (code.text sample2)
- concatenatedS (` ("lux text concat" (~ sample0S) (~ sample1S)))
+ #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))]]
($_ seq
(test "Can compare texts for equality."
- (and (|> (run (` ("lux text =" (~ sample0S) (~ sample0S))))
+ (and (|> (run (#synthesis.Extension "lux text =" (list sample0S sample0S)))
(case> (#e.Success valueV)
(:coerce Bit valueV)
_
#0))
- (|> (run (` ("lux text =" (~ sample0S) (~ sample1S))))
+ (|> (run (#synthesis.Extension "lux text =" (list sample0S sample1S)))
(case> (#e.Success valueV)
(not (:coerce Bit valueV))
_
#0))))
(test "Can compare texts for order."
- (|> (run (` ("lux text <" (~ sample1S) (~ sample0S))))
+ (|> (run (#synthesis.Extension "lux text <" (list sample1S sample0S)))
(case> (#e.Success valueV)
(:coerce Bit valueV)
_
#0)))
(test "Can get length of text."
- (|> (run (` ("lux text size" (~ sample0S))))
+ (|> (run (#synthesis.Extension "lux text size" (list sample0S)))
(case> (#e.Success valueV)
(n/= sample-size (:coerce Nat valueV))
_
#0)))
(test "Can concatenate text."
- (|> (run (` ("lux text size" (~ concatenatedS))))
+ (|> (run (#synthesis.Extension "lux text size" (list concatenatedS)))
(case> (#e.Success valueV)
- (n/= (n/* +2 sample-size) (:coerce Nat valueV))
+ (n/= (n/* 2 sample-size) (:coerce Nat valueV))
_
#0)))
(test "Can find index of sub-text."
- (and (|> (run (` ("lux text index" (~ concatenatedS) (~ sample0S) +0)))
+ (and (|> (run (#synthesis.Extension "lux text index"
+ (list concatenatedS sample0S
+ (synthesis.i64 0))))
(case> (^multi (#e.Success valueV)
[(:coerce (Maybe Nat) valueV) (#.Some valueV)])
- (n/= +0 valueV)
+ (n/= 0 valueV)
_
#0))
- (|> (run (` ("lux text index" (~ concatenatedS) (~ sample1S) +0)))
+ (|> (run (#synthesis.Extension "lux text index"
+ (list concatenatedS sample1S
+ (synthesis.i64 0))))
(case> (^multi (#e.Success valueV)
[(:coerce (Maybe Nat) valueV) (#.Some valueV)])
(n/= sample-size valueV)
_
#0))))
- (let [test-clip (function (_ from to expected)
- (|> (run (` ("lux text clip"
- (~ concatenatedS)
- (~ (code.nat from))
- (~ (code.nat to)))))
- (case> (^multi (#e.Success valueV)
- [(:coerce (Maybe Text) valueV) (#.Some valueV)])
- (text/= expected valueV)
-
- _
- #0)))]
+ (let [test-clip (: (-> (I64 Any) (I64 Any) Text Bit)
+ (function (_ from to expected)
+ (|> (run (#synthesis.Extension "lux text clip"
+ (list concatenatedS
+ (synthesis.i64 from)
+ (synthesis.i64 to))))
+ (case> (^multi (#e.Success valueV)
+ [(:coerce (Maybe Text) valueV) (#.Some valueV)])
+ (text/= expected valueV)
+
+ _
+ #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 sample0)
+ (test-clip sample-size (n/* 2 sample-size) sample1))))
(test "Can extract individual characters from text."
- (|> (run (` ("lux text char"
- (~ sample0S)
- (~ (code.nat char-idx)))))
+ (|> (run (#synthesis.Extension "lux text char"
+ (list sample0S
+ (synthesis.i64 char-idx))))
(case> (^multi (#e.Success valueV)
[(:coerce (Maybe Int) valueV) (#.Some valueV)])
(text.contains? ("lux int char" valueV)
@@ -278,14 +277,19 @@
(def: (array-spec run)
(-> Runner Test)
(do r.Monad
- [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
+ [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))
idx (|> r.nat (:: @ map (n/% size)))
value r.nat
- #let [array0S (` ("lux array new" (~ (code.nat size))))
- array1S (` ("lux array put" (~ array0S) (~ (code.nat idx)) (~ (code.nat value))))]]
+ #let [array0S (#synthesis.Extension "lux array new"
+ (list (synthesis.i64 size)))
+ array1S (#synthesis.Extension "lux array put"
+ (list array0S
+ (synthesis.i64 idx)
+ (synthesis.i64 value)))]]
($_ seq
(test "Can get size of array."
- (|> (run (` ("lux array size" (~ array0S))))
+ (|> (run (#synthesis.Extension "lux array size"
+ (list array0S)))
(case> (#e.Success valueV)
(n/= size (:coerce Nat valueV))
@@ -293,14 +297,16 @@
(exec (log! error)
#0))))
(test "Can get element from array (if it exists)."
- (and (|> (run (` ("lux array get" (~ array0S) (~ (code.nat idx)))))
+ (and (|> (run (#synthesis.Extension "lux array get"
+ (list array0S (synthesis.i64 idx))))
(case> (^multi (#e.Success valueV)
[(:coerce (Maybe Nat) valueV) #.None])
#1
_
#0))
- (|> (run (` ("lux array get" (~ array1S) (~ (code.nat idx)))))
+ (|> (run (#synthesis.Extension "lux array get"
+ (list array1S (synthesis.i64 idx))))
(case> (^multi (#e.Success valueV)
[(:coerce (Maybe Nat) valueV) (#.Some valueV)])
(n/= value valueV)
@@ -308,10 +314,11 @@
_
#0))))
(test "Can remove element from array."
- (|> (run (` ("lux array get"
- ("lux array remove" (~ array1S)
- (~ (code.nat idx)))
- (~ (code.nat idx)))))
+ (|> (run (#synthesis.Extension "lux array get"
+ (list (#synthesis.Extension "lux array remove"
+ (list array1S
+ (synthesis.i64 idx)))
+ (synthesis.i64 idx))))
(case> (^multi (#e.Success valueV)
[(:coerce (Maybe Nat) valueV) #.None])
#1
@@ -328,7 +335,7 @@
(`` ($_ seq
(~~ (do-template []
[(test (format "Can apply '" "' procedure.")
- (|> (run (` ( (~ (code.frac subject)))))
+ (|> (run (#synthesis.Extension (list (synthesis.f64 subject))))
(case> (#e.Success valueV)
#1
@@ -348,7 +355,8 @@
["lux math floor"]))
(~~ (do-template []
[(test (format "Can apply '" "' procedure.")
- (|> (run (` ( (~ (code.frac subject)) (~ (code.frac param)))))
+ (|> (run (#synthesis.Extension (list (synthesis.f64 subject)
+ (synthesis.f64 param))))
(case> (#e.Success valueV)
#1
@@ -362,10 +370,11 @@
(def: (io-spec run)
(-> Runner Test)
(do r.Monad
- [message (r.text' alpha +5)]
+ [message (r.ascii/alpha 5)]
($_ seq
(test "Can log messages."
- (|> (run (` ("lux io log" (~ (code.text (format "LOG: " message))))))
+ (|> (run (#synthesis.Extension "lux io log"
+ (list (synthesis.text (format "LOG: " message)))))
(case> (#e.Success valueV)
#1
@@ -373,16 +382,24 @@
(exec (log! error)
#0))))
(test "Can throw runtime errors."
- (and (|> (run (` ("lux try" ("lux function" +1 []
- ("lux io error" (~ (code.text message)))))))
+ (and (|> (run (#synthesis.Extension "lux try"
+ (list (synthesis.function/abstraction
+ {#synthesis.environment (list)
+ #synthesis.arity 1
+ #synthesis.body (#synthesis.Extension "lux io error"
+ (list (synthesis.text message)))}))))
(case> (^multi (#e.Success valueV)
[(:coerce (e.Error Text) valueV) (#e.Error error)])
(text.contains? message error)
_
#0))
- (|> (run (` ("lux try" ("lux function" +1 []
- (~ (code.text message))))))
+ (|> (run (#synthesis.Extension "lux try"
+ (list (synthesis.function/abstraction
+ {#synthesis.environment (list)
+ #synthesis.arity 1
+ #synthesis.body (#synthesis.Extension "lux io error"
+ (list (synthesis.text message)))}))))
(case> (^multi (#e.Success valueV)
[(:coerce (e.Error Text) valueV) (#e.Success valueV)])
(text/= message valueV)
@@ -390,7 +407,8 @@
_
#0))))
(test "Can obtain current time in milli-seconds."
- (|> (run (` [("lux io current-time") ("lux io current-time")]))
+ (|> (run (synthesis.tuple (list (#synthesis.Extension "lux io current-time" (list))
+ (#synthesis.Extension "lux io current-time" (list)))))
(case> (#e.Success valueV)
(let [[pre post] (:coerce [Nat Nat] valueV)]
(n/>= pre post))
@@ -405,12 +423,12 @@
(do r.Monad
[pre r.nat
post (|> r.nat (r.filter (|>> (n/= pre) not)))
- #let [preS (code.nat pre)
- postS (code.nat post)
- atomS (` ("lux atom new" (~ preS)))]]
+ #let [preS (synthesis.i64 pre)
+ postS (synthesis.i64 post)
+ atomS (#synthesis.Extension "lux atom new" (list preS))]]
($_ seq
(test "Can read atoms."
- (|> (run (` ("lux atom read" (~ atomS))))
+ (|> (run (#synthesis.Extension "lux atom read" (list atomS)))
(case> (#e.Success valueV)
(n/= pre (:coerce Nat valueV))
@@ -418,10 +436,18 @@
(exec (log! error)
#0))))
(test "Can compare-and-swap atoms."
- (and (|> (run (` ("lux let" +0 (~ preS)
- ("lux let" +1 ("lux atom new" (0))
- [("lux atom compare-and-swap" (1) (0) (~ postS))
- ("lux atom read" (1))]))))
+ (and (|> (run (synthesis.branch/let
+ [preS 0
+ (synthesis.branch/let
+ [(#synthesis.Extension "lux atom new"
+ (list (synthesis.variable/local 0)))
+ 1
+ (synthesis.tuple
+ (list (#synthesis.Extension "lux atom compare-and-swap"
+ (list (synthesis.variable/local 1)
+ (synthesis.variable/local 0)
+ postS))
+ (#synthesis.Extension "lux atom read" (list (synthesis.variable/local 1)))))])]))
(case> (#e.Success valueV)
(let [[swapped? current-value] (:coerce [Bit Nat] valueV)]
(and swapped?
@@ -430,10 +456,18 @@
(#e.Error error)
(exec (log! error)
#0)))
- (|> (run (` ("lux let" +0 (~ preS)
- ("lux let" +1 ("lux atom new" (0))
- [("lux atom compare-and-swap" (1) (~ postS) (~ postS))
- ("lux atom read" (1))]))))
+ (|> (run (synthesis.branch/let
+ [preS 0
+ (synthesis.branch/let
+ [(#synthesis.Extension "lux atom new"
+ (list (synthesis.variable/local 0)))
+ 1
+ (synthesis.tuple
+ (list (#synthesis.Extension "lux atom compare-and-swap"
+ (list (synthesis.variable/local 1)
+ postS
+ postS))
+ (#synthesis.Extension "lux atom read" (list (synthesis.variable/local 1)))))])]))
(case> (#e.Success valueV)
(let [[swapped? current-value] (:coerce [Bit Nat] valueV)]
(and (not swapped?)
@@ -449,12 +483,13 @@
(do r.Monad
[pre r.nat
post (|> r.nat (r.filter (|>> (n/= pre) not)))
- #let [preS (code.nat pre)
- postS (code.nat post)
- boxS (` ("lux box new" (~ preS)))]]
+ #let [preS (synthesis.i64 pre)
+ postS (synthesis.i64 post)
+ boxS (#synthesis.Extension "lux box new"
+ (list preS))]]
($_ seq
(test "Can read boxes."
- (|> (run (` ("lux box read" (~ boxS))))
+ (|> (run (#synthesis.Extension "lux box read" (list boxS)))
(case> (#e.Success valueV)
(n/= pre (:coerce Nat valueV))
@@ -462,9 +497,15 @@
(exec (log! error)
#0))))
(test "Can write boxes."
- (|> (run (` ("lux let" +0 (~ boxS)
- ("lux let" +1 ("lux box write" (~ postS) (0))
- ("lux box read" (0))))))
+ (|> (run (synthesis.branch/let
+ [boxS
+ 0
+ (synthesis.branch/let
+ [(#synthesis.Extension "lux box write"
+ (list postS (synthesis.variable/local 0)))
+ 1
+ (#synthesis.Extension "lux box read"
+ (list (synthesis.variable/local 0)))])]))
(case> (#e.Success valueV)
(n/= post (:coerce Nat valueV))
@@ -477,21 +518,24 @@
(-> Runner Test)
($_ seq
(test "Can query the concurrency level of the machine."
- (|> (run (` ("lux process parallelism-level")))
+ (|> (run (#synthesis.Extension "lux process parallelism-level" (list)))
(case> (#e.Success valueV)
- (n/>= +1 (:coerce Nat valueV))
+ (n/>= 1 (:coerce Nat valueV))
(#e.Error error)
(exec (log! error)
#0))))
(do r.Monad
- [delay (|> r.nat (:: @ map (n/% +10)))
- message (r.text +5)]
+ [delay (|> r.nat (:: @ map (n/% 10)))
+ message (r.ascii/upper-alpha 5)]
(test "Can schedule I/O operations for future execution."
- (|> (run (` ("lux process schedule"
- (~ (code.nat delay))
- ("lux function" +1 []
- ("lux io log" (~ (code.text (format "SCHEDULE: " message))))))))
+ (|> (run (#synthesis.Extension "lux process schedule"
+ (list (synthesis.i64 delay)
+ (synthesis.function/abstraction
+ {#synthesis.environment (list)
+ #synthesis.arity 1
+ #synthesis.body (#synthesis.Extension "lux io log"
+ (list (synthesis.text (format "SCHEDULE: " message))))}))))
(case> (#e.Success valueV)
#1
@@ -504,8 +548,8 @@
(-> Runner Test)
($_ seq
(bit-spec run)
- (int-spec run)
- (frac-spec run)
+ (i64-spec run)
+ (f64-spec run)
(text-spec run)
(array-spec run)
(math-spec run)
@@ -516,37 +560,37 @@
))
(context: "[JVM] Common procedures."
- (<| (times +100)
- (all-specs run-jvm)))
+ (<| (times 100)
+ (all-specs common.run-jvm)))
## (context: "[JS] Common procedures."
-## (<| (times +100)
-## (all-specs run-js)))
+## (<| (times 100)
+## (all-specs common.run-js)))
## (context: "[Lua] Common procedures."
-## (<| (times +100)
-## (all-specs run-lua)))
+## (<| (times 100)
+## (all-specs common.run-lua)))
## (context: "[Ruby] Common procedures."
-## (<| (times +100)
-## (all-specs run-ruby)))
+## (<| (times 100)
+## (all-specs common.run-ruby)))
## (context: "[Python] Common procedures."
-## (<| (times +100)
-## (all-specs run-python)))
+## (<| (times 100)
+## (all-specs common.run-python)))
## (context: "[R] Common procedures."
-## (<| (times +100)
-## (all-specs run-r)))
+## (<| (times 100)
+## (all-specs common.run-r)))
## (context: "[Scheme] Common procedures."
-## (<| (times +100)
-## (all-specs run-scheme)))
+## (<| (times 100)
+## (all-specs common.run-scheme)))
## (context: "[Common Lisp] Common procedures."
-## (<| (times +100)
-## (all-specs run-common-lisp)))
+## (<| (times 100)
+## (all-specs common.run-common-lisp)))
## (context: "[PHP] Common procedures."
-## (<| (times +100)
-## (all-specs run-php)))
+## (<| (times 100)
+## (all-specs common.run-php)))
diff --git a/new-luxc/test/test/luxc/lang/translation/reference.lux b/new-luxc/test/test/luxc/lang/translation/reference.lux
index 4aaed8124..a10e98ae6 100644
--- a/new-luxc/test/test/luxc/lang/translation/reference.lux
+++ b/new-luxc/test/test/luxc/lang/translation/reference.lux
@@ -1,61 +1,48 @@
(.module:
- lux
- (lux (control [monad #+ do]
- pipe)
- (data ["e" error]
- [text])
- (lang ["//." synthesis])
- ["r" math/random]
- test)
- (luxc (lang (translation (jvm [".T_jvm" statement])
- ## (js [".T_js" statement])
- ## (lua [".T_lua" statement])
- ## (ruby [".T_ruby" statement])
- ## (python [".T_python" statement])
- ## (r [".T_r" statement])
- ## (scheme [".T_scheme" statement])
- ## (common-lisp [".T_common-lisp" statement])
- ## (php [".T_php" statement])
- )))
- (test/luxc common))
+ [lux #*
+ [control
+ [monad (#+ do)]
+ pipe]
+ [data
+ ["e" error]
+ ["." text]]
+ [compiler
+ [default
+ ["." reference]
+ [phase
+ ["." synthesis]]]]
+ [math
+ ["r" random]]
+ test]
+ [test
+ [luxc
+ ["." common (#+ Runner Definer)]]]
+ [//
+ ["&" function]])
(def: name-part
(r.Random Text)
- (|> (r.ascii +5)
- (r.filter (function (_ sample)
- (not (or (text.contains? "/" sample)
- (text.contains? "[" sample)
- (text.contains? "]" sample)))))))
+ (r.ascii/alpha 5))
(def: (definitions-spec define)
(-> Definer Test)
(do r.Monad
- [def-name (r.seq name-part name-part)
- def-value r.int]
+ [name (r.and name-part name-part)
+ value r.frac]
(test "Can refer to definitions."
- (|> (define def-name (//synthesis.i64 def-value))
- (case> (#e.Success valueT)
- (i/= def-value (:coerce Int valueT))
-
- (#e.Error error)
- (exec (log! error)
- #0))))))
+ (|> (define name (synthesis.f64 value))
+ (&.check value)))))
(def: (variables-spec run)
(-> Runner Test)
(do r.Monad
- [register (|> r.nat (:: @ map (n/% +100)))
- value r.int]
+ [register (|> r.nat (:: @ map (n/% 100)))
+ value r.frac]
(test "Can refer to local variables/registers."
- (|> (run (//synthesis.branch/let [(//synthesis.i64 value)
- register
- (//synthesis.variable/local register)]))
- (case> (#e.Success outputT)
- (i/= value (:coerce Int outputT))
-
- (#e.Error error)
- (exec (log! error)
- #0))))))
+ (|> (run (synthesis.branch/let [(synthesis.f64 value)
+ register
+ (synthesis.variable/local register)]))
+ (&.check value)))))
(def: (references-spec run define)
(-> Runner Definer Test)
@@ -63,37 +50,37 @@
(variables-spec run)))
(context: "[JVM] References."
- (<| (times +100)
- (references-spec run-jvm def-jvm)))
+ (<| (times 100)
+ (references-spec common.run-jvm common.def-jvm)))
## (context: "[JS] References."
-## (<| (times +100)
-## (references-spec run-js def-js)))
+## (<| (times 100)
+## (references-spec common.run-js common.def-js)))
## (context: "[Lua] References."
-## (<| (times +100)
-## (references-spec run-lua def-lua)))
+## (<| (times 100)
+## (references-spec common.run-lua common.def-lua)))
## (context: "[Ruby] References."
-## (<| (times +100)
-## (references-spec run-ruby def-ruby)))
+## (<| (times 100)
+## (references-spec common.run-ruby common.def-ruby)))
## (context: "[Python] References."
-## (<| (times +100)
-## (references-spec run-python def-python)))
+## (<| (times 100)
+## (references-spec common.run-python common.def-python)))
## (context: "[R] References."
-## (<| (times +100)
-## (references-spec run-r def-r)))
+## (<| (times 100)
+## (references-spec common.run-r common.def-r)))
## (context: "[Scheme] References."
-## (<| (times +100)
-## (references-spec run-scheme def-scheme)))
+## (<| (times 100)
+## (references-spec common.run-scheme common.def-scheme)))
## (context: "[Common Lisp] References."
-## (<| (times +100)
-## (references-spec run-common-lisp def-common-lisp)))
+## (<| (times 100)
+## (references-spec common.run-common-lisp common.def-common-lisp)))
## (context: "[PHP] References."
-## (<| (times +100)
-## (references-spec run-php def-php)))
+## (<| (times 100)
+## (references-spec common.run-php common.def-php)))
--
cgit v1.2.3