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/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 +- 4 files changed, 201 insertions(+), 186 deletions(-) (limited to 'new-luxc/test') 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 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 [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 - [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 - [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 + [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 - [[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 + [[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/= ( param subject) (:coerce Nat valueT)) (#error.Error error) - (exec (log! error) - #0)) + #0) (let [param ])))] ["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 @@ ( ( subject) (:coerce valueT)) (#error.Error error) - (exec (log! error) - #0)) + #0) (let [subject ])))] ["lux i64 to-f64" Frac int-to-frac f/= subject] @@ -95,8 +94,7 @@ ( ( param subject) (:coerce 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 - [param (|> r.frac (r.filter (|>> (f/= +0.0) not))) - subject r.frac] - (with-expansions [ (do-template [ ] - [(test - (|> (run (#synthesis.Extension (list (synthesis.f64 subject) - (synthesis.f64 param)))) - (case> (#error.Success valueT) - ( ( param subject) (:coerce 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 - - )))) +(def: simple-frac + (Random Frac) + (|> r.nat (:: r.Monad map (|>> (n/% 1000) .int int-to-frac)))) -(def: (f64-spec/1 run) +(def: (f64-spec run) (-> Runner Test) (do r.Monad - [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 [ ] + (~~ (do-template [ ] [(test - (|> (run (#synthesis.Extension (list))) - (case> (#error.Success valueT) - ( (:coerce Frac valueT)) + (|> (run (#synthesis.Extension (list (synthesis.f64 subject) + (synthesis.f64 param)))) + (&.check ( param subject))))] + + ["lux f64 +" f/+ f/=] + ["lux f64 -" f/- f/=] + ["lux f64 *" f/* f/=] + ["lux f64 /" f// f/=] + ["lux f64 %" f/% f/=] + )) + (~~ (do-template [ ] + [(test + (|> (run (#synthesis.Extension (list (synthesis.f64 subject) + (synthesis.f64 param)))) + (case> (#error.Success valueV) + (bit/= ( 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 [ ] + [(test + (|> (run (#synthesis.Extension (list))) + (&.check )))] + + ["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 [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)]]] [math - ["r" random ("r/." Monad)]] + ["r" random (#+ Random) ("r/." Monad)]] [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 - [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 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 - [[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 - [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 [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