From 453ab9f67873bb022acadf4c0f5c1e635c7d5794 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 11 Aug 2018 23:27:32 -0400
Subject: - Fixed common translation tests for JVM. - Fixed a bug in "lux text
<". - Small optimizations to old LuxC.
---
new-luxc/source/luxc/lang/translation/jvm.lux | 7 +-
.../source/luxc/lang/translation/jvm/case.jvm.lux | 13 +-
.../lang/translation/jvm/procedure/common.jvm.lux | 86 ++++++-----
.../luxc/lang/translation/jvm/runtime.jvm.lux | 8 +-
.../luxc/lang/translation/jvm/structure.jvm.lux | 12 +-
new-luxc/test/test/luxc/lang/translation/case.lux | 97 +++++++-----
.../test/test/luxc/lang/translation/common.lux | 172 ++++++++++-----------
.../test/test/luxc/lang/translation/function.lux | 103 ++++++------
.../test/test/luxc/lang/translation/reference.lux | 15 +-
9 files changed, 268 insertions(+), 245 deletions(-)
(limited to 'new-luxc')
diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux
index f9b081972..b8c00c8a4 100644
--- a/new-luxc/source/luxc/lang/translation/jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm.lux
@@ -133,9 +133,10 @@
(ex.report ["Class" class]
["Error" error]))
-(exception: #export (invalid-field {class Text} {field Text})
+(exception: #export (invalid-field {class Text} {field Text} {error Text})
(ex.report ["Class" class]
- ["Field" field]))
+ ["Field" field]
+ ["Error" error]))
(exception: #export (invalid-value {class Text})
(ex.report ["Class" class]))
@@ -157,7 +158,7 @@
(ex.throw cannot-load [class-name error]))
(#error.Error error)
- (ex.throw invalid-field [class-name ..value-field])))
+ (ex.throw invalid-field [class-name ..value-field error])))
(def: module-separator "/")
(def: class-path-separator ".")
diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
index 4f3193bbf..e11187787 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
@@ -107,9 +107,9 @@
(_.GOTO @end))))
- (^template [<pattern> <method> <mod>]
+ (^template [<pattern> <method>]
(^ (<pattern> idx))
- (operation/wrap (.case (<mod> idx)
+ (operation/wrap (.case idx
0
(|>> peekI
(_.CHECKCAST ($t.descriptor runtime.$Tuple))
@@ -128,8 +128,8 @@
(list))
#0)
pushI))))
- ([synthesis.member/left "pm_left" .id]
- [synthesis.member/right "pm_right" .inc])
+ ([synthesis.member/left "pm_left"]
+ [synthesis.member/right "pm_right"])
(^template [<pattern> <flag> <mod>]
(^ (<pattern> idx))
@@ -222,9 +222,8 @@
[@end _.make-label
valueI (translate valueS)
pathI (..path translate path @end)]
- (wrap (|>> valueI
- _.NULL
- _.SWAP
+ (wrap (|>> _.NULL
+ valueI
pushI
pathI
(_.label @end)))))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
index 7ce1d6fda..efccb25f6 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
@@ -84,6 +84,7 @@
## [Instructions]
(def: lux-intI Inst (|>> _.I2L (_.wrap #$.Long)))
(def: jvm-intI Inst (|>> (_.unwrap #$.Long) _.L2I))
+(def: check-stringI Inst (_.CHECKCAST "java.lang.String"))
(def: (predicateI tester)
(-> (-> Label Inst)
@@ -161,17 +162,17 @@
<op>
(_.wrap <type>)))]
- [i64::add #$.Long _.LADD]
- [i64::sub #$.Long _.LSUB]
- [i64::mul #$.Long _.LMUL]
- [i64::div #$.Long _.LDIV]
- [i64::rem #$.Long _.LREM]
+ [i64::+ #$.Long _.LADD]
+ [i64::- #$.Long _.LSUB]
+ [i64::* #$.Long _.LMUL]
+ [i64::/ #$.Long _.LDIV]
+ [i64::% #$.Long _.LREM]
- [f64::add #$.Double _.DADD]
- [f64::sub #$.Double _.DSUB]
- [f64::mul #$.Double _.DMUL]
- [f64::div #$.Double _.DDIV]
- [f64::rem #$.Double _.DREM]
+ [f64::+ #$.Double _.DADD]
+ [f64::- #$.Double _.DSUB]
+ [f64::* #$.Double _.DMUL]
+ [f64::/ #$.Double _.DDIV]
+ [f64::% #$.Double _.DREM]
)
(do-template [<eq> <lt> <unwrap> <cmp>]
@@ -183,11 +184,12 @@
<cmp>
(_.int <reference>)
(predicateI _.IF_ICMPEQ)))]
+
[<eq> +0]
[<lt> -1])]
- [i64::eq i64::lt (_.unwrap #$.Long) _.LCMP]
- [f64::eq f64::lt (_.unwrap #$.Double) _.DCMPG]
+ [i64::= i64::< (_.unwrap #$.Long) _.LCMP]
+ [f64::= f64::< (_.unwrap #$.Double) _.DCMPG]
)
(do-template [<name> <prepare> <transform>]
@@ -202,7 +204,7 @@
[f64::to-i64 (_.unwrap #$.Double) (<| (_.wrap #$.Long) _.D2L)]
[f64::encode (_.unwrap #$.Double)
(_.INVOKESTATIC "java.lang.Double" "toString" (_t.method (list _t.double) (#.Some $String) (list)) #0)]
- [f64::decode (_.CHECKCAST "java.lang.String")
+ [f64::decode ..check-stringI
(_.INVOKESTATIC ///.runtime-class "decode_frac" (_t.method (list $String) (#.Some $Object-Array) (list)) #0)]
)
@@ -210,7 +212,7 @@
(def: (text::size inputI)
Unary
(|>> inputI
- (_.CHECKCAST "java.lang.String")
+ ..check-stringI
(_.INVOKEVIRTUAL "java.lang.String" "length" (_t.method (list) (#.Some _t.int) (list)) #0)
lux-intI))
@@ -221,16 +223,16 @@
paramI <pre-param>
<op> <post>))]
- [text::eq id id
+ [text::= id id
(_.INVOKEVIRTUAL "java.lang.Object" "equals" (_t.method (list ///.$Object) (#.Some _t.boolean) (list)) #0)
(_.wrap #$.Boolean)]
- [text::lt (_.CHECKCAST "java.lang.String") (_.CHECKCAST "java.lang.String")
+ [text::< ..check-stringI ..check-stringI
(_.INVOKEVIRTUAL "java.lang.String" "compareTo" (_t.method (list $String) (#.Some _t.int) (list)) #0)
- (<| (predicateI _.IF_ICMPEQ) (_.int -1))]
- [text::concat (_.CHECKCAST "java.lang.String") (_.CHECKCAST "java.lang.String")
+ (predicateI _.IFLT)]
+ [text::concat ..check-stringI ..check-stringI
(_.INVOKEVIRTUAL "java.lang.String" "concat" (_t.method (list $String) (#.Some $String) (list)) #0)
id]
- [text::char (_.CHECKCAST "java.lang.String") jvm-intI
+ [text::char ..check-stringI jvm-intI
(_.INVOKESTATIC ///.runtime-class "text_char" (_t.method (list $String _t.int) (#.Some ///.$Variant) (list)) #0)
id]
)
@@ -243,7 +245,7 @@
extraI <pre-extra>
<op>))]
- [text::clip (_.CHECKCAST "java.lang.String") jvm-intI jvm-intI
+ [text::clip ..check-stringI jvm-intI jvm-intI
(_.INVOKESTATIC ///.runtime-class "text_clip"
(_t.method (list $String _t.int _t.int) (#.Some ///.$Variant) (list)) #0)]
)
@@ -253,8 +255,8 @@
Trinary
(<| _.with-label (function (_ @not-found))
_.with-label (function (_ @end))
- (|>> textI (_.CHECKCAST "java.lang.String")
- partI (_.CHECKCAST "java.lang.String")
+ (|>> textI ..check-stringI
+ partI ..check-stringI
startI jvm-intI
(_.INVOKEVIRTUAL "java.lang.String" "indexOf" index-method #0)
_.DUP
@@ -264,7 +266,7 @@
runtime.someI
(_.GOTO @end)
(_.label @not-found)
- ## _.POP
+ _.POP
runtime.noneI
(_.label @end))))
@@ -274,7 +276,7 @@
Unary
(|>> (_.GETSTATIC "java.lang.System" "out" (_t.class "java.io.PrintStream" (list)))
messageI
- (_.CHECKCAST "java.lang.String")
+ ..check-stringI
(_.INVOKEVIRTUAL "java.io.PrintStream" "println" string-method #0)
unitI))
@@ -283,7 +285,7 @@
(|>> (_.NEW "java.lang.Error")
_.DUP
messageI
- (_.CHECKCAST "java.lang.String")
+ ..check-stringI
(_.INVOKESPECIAL "java.lang.Error" "<init>" string-method #0)
_.ATHROW))
@@ -293,7 +295,7 @@
(_.INVOKESTATIC "java.lang.System" "exit" (_t.method (list _t.int) #.None (list)) #0)
_.NULL))
-(def: (io::current-time [])
+(def: (io::current-time _)
Nullary
(|>> (_.INVOKESTATIC "java.lang.System" "currentTimeMillis" (_t.method (list) (#.Some _t.long) (list)) #0)
(_.wrap #$.Long)))
@@ -320,13 +322,13 @@
Bundle
(<| (bundle.prefix "i64")
(|> (: Bundle bundle.empty)
- (bundle.install "+" (binary i64::add))
- (bundle.install "-" (binary i64::sub))
- (bundle.install "*" (binary i64::mul))
- (bundle.install "/" (binary i64::div))
- (bundle.install "%" (binary i64::rem))
- (bundle.install "=" (binary i64::eq))
- (bundle.install "<" (binary i64::lt))
+ (bundle.install "+" (binary i64::+))
+ (bundle.install "-" (binary i64::-))
+ (bundle.install "*" (binary i64::*))
+ (bundle.install "/" (binary i64::/))
+ (bundle.install "%" (binary i64::%))
+ (bundle.install "=" (binary i64::=))
+ (bundle.install "<" (binary i64::<))
(bundle.install "to-f64" (unary i64::to-f64))
(bundle.install "char" (unary i64::char)))))
@@ -334,13 +336,13 @@
Bundle
(<| (bundle.prefix "f64")
(|> (: Bundle bundle.empty)
- (bundle.install "+" (binary f64::add))
- (bundle.install "-" (binary f64::sub))
- (bundle.install "*" (binary f64::mul))
- (bundle.install "/" (binary f64::div))
- (bundle.install "%" (binary f64::rem))
- (bundle.install "=" (binary f64::eq))
- (bundle.install "<" (binary f64::lt))
+ (bundle.install "+" (binary f64::+))
+ (bundle.install "-" (binary f64::-))
+ (bundle.install "*" (binary f64::*))
+ (bundle.install "/" (binary f64::/))
+ (bundle.install "%" (binary f64::%))
+ (bundle.install "=" (binary f64::=))
+ (bundle.install "<" (binary f64::<))
(bundle.install "smallest" (nullary f64::smallest))
(bundle.install "min" (nullary f64::min))
(bundle.install "max" (nullary f64::max))
@@ -352,8 +354,8 @@
Bundle
(<| (bundle.prefix "text")
(|> (: Bundle bundle.empty)
- (bundle.install "=" (binary text::eq))
- (bundle.install "<" (binary text::lt))
+ (bundle.install "=" (binary text::=))
+ (bundle.install "<" (binary text::<))
(bundle.install "concat" (binary text::concat))
(bundle.install "index" (trinary text::index))
(bundle.install "size" (unary text::size))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
index 3c687f822..c92ab1026 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
@@ -316,9 +316,13 @@
(<| _.with-label (function (_ @begin))
_.with-label (function (_ @tail))
_.with-label (function (_ @slice))
- (let [updated-idxI (|>> (_.ILOAD 1) (_.int +1) _.IADD tuple-sizeI _.ISUB)
+ (let [updated-idxI (|>> (_.ILOAD 1) (_.int +1) _.ISUB tuple-sizeI _.ISUB)
sliceI (|>> (_.ALOAD 0) (_.ILOAD 1) tuple-sizeI
- (_.INVOKESTATIC "java.util.Arrays" "copyOfRange" ($t.method (list $Object-Array $t.int $t.int) (#.Some $Object-Array) (list)) #0))])
+ (_.INVOKESTATIC "java.util.Arrays" "copyOfRange"
+ ($t.method (list $Object-Array $t.int $t.int)
+ (#.Some $Object-Array)
+ (list))
+ #0))])
(|>> (_.label @begin)
tuple-sizeI
expected-last-sizeI
diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux
index 040c4dd59..f937d5bdb 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux
@@ -46,18 +46,20 @@
(_.array $Object)
membersI))))
-(def: (flagI tail?)
+(def: (flagI right?)
(-> Bit Inst)
- (if tail?
+ (if right?
(_.string "")
_.NULL))
-(def: #export (variant translate tag tail? member)
+(def: #export (variant translate lefts right? member)
(-> Phase Nat Bit Synthesis (Operation Inst))
(do phase.Monad<Operation>
[memberI (translate member)]
- (wrap (|>> (_.int (.int tag))
- (flagI tail?)
+ (wrap (|>> (_.int (.int (if right?
+ (.inc lefts)
+ lefts)))
+ (flagI right?)
memberI
(_.INVOKESTATIC //.runtime-class
"variant_make"
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
--
cgit v1.2.3