diff options
Diffstat (limited to 'new-luxc')
| -rw-r--r-- | new-luxc/source/test/program.lux | 11 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/case.lux | 316 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/function.lux | 140 |
3 files changed, 7 insertions, 460 deletions
diff --git a/new-luxc/source/test/program.lux b/new-luxc/source/test/program.lux index 687c8ca2a..48cbd3aef 100644 --- a/new-luxc/source/test/program.lux +++ b/new-luxc/source/test/program.lux @@ -16,15 +16,15 @@ [generation ["." primitive] ["." structure] - ["." reference]]]] + ["." reference] + ["." case] + ["." function]]]] {1 ["." /]} ## [test ## [luxc ## [lang ## [translation - ## ## ["_.T" function] - ## ## ["_.T" case] ## ## ["_.T" common] ## ## ["_.T" jvm] ## ## ["_.T" js] @@ -44,12 +44,15 @@ (primitive.spec runner) (structure.spec runner) (reference.spec runner definer) + (case.spec runner) + (function.spec runner) )) (program: args (<| io.io _.run! - (_.times 100) + ## (_.times 100) + (_.seed 1985013625126912890) (do r.monad [_ (wrap []) #let [?runner,definer (io.run (do io.monad diff --git a/new-luxc/test/test/luxc/lang/translation/case.lux b/new-luxc/test/test/luxc/lang/translation/case.lux deleted file mode 100644 index 0cee2818a..000000000 --- a/new-luxc/test/test/luxc/lang/translation/case.lux +++ /dev/null @@ -1,316 +0,0 @@ -(.module: - [lux (#- case) - [control - [monad (#+ do)] - pipe] - [data - ["." error] - [text ("text/." Equivalence<Text>) - format] - [collection - ["." list ("list/." Functor<List> Fold<List>)]]] - [math - ["r" random (#+ Random)]] - [compiler - [default - ["." reference] - ["." phase - ["." analysis] - ["." synthesis (#+ Path Synthesis) - ["." case] - ["." expression]] - ["." extension/synthesis]]]] - test] - [test - [luxc - ["." common (#+ Runner)]]] - [// - ["&" function]]) - -(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: case - (Random [Synthesis Path]) - (<| r.rec (function (_ case)) - (`` ($_ r.either - (do r.Monad<Random> - [value r.i64] - (wrap [(synthesis.i64 value) - synthesis.path/pop])) - (~~ (template [<gen> <synth> <path>] - [(do r.Monad<Random> - [value <gen>] - (wrap [(<synth> value) - (<path> value)]))] - - [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<Random> - [size ..size - idx (|> r.nat (:: @ map (n/% size))) - [subS subP] case - #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<Random> - [size ..size - idx (|> r.nat (:: @ map (n/% size))) - [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 right? - (synthesis.side/right idx) - (synthesis.side/left idx)) - subP)]] - (wrap [caseS caseP])) - )))) - -(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> - [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: special-input - Synthesis - (let [_cursor_ (: Synthesis - (synthesis.tuple (list (synthesis.text "lux") - (synthesis.i64 +901) - (synthesis.i64 +13)))) - _code_ (: (-> Synthesis Synthesis) - (function (_ content) - (synthesis.tuple (list _cursor_ content)))) - _nil_ (: Synthesis - (synthesis.variant [0 #0 (synthesis.text "")])) - _cons_ (: (-> Synthesis Synthesis Synthesis) - (function (_ head tail) - (synthesis.variant [0 #1 (synthesis.tuple (list head tail))]))) - _list_ (: (-> (List Synthesis) Synthesis) - (list/fold _cons_ _nil_))] - (let [__tuple__ (: (-> (List Synthesis) Synthesis) - (|>> list.reverse _list_ [9 #0] synthesis.variant _code_)) - __form__ (: (-> (List Synthesis) Synthesis) - (|>> list.reverse _list_ [8 #0] synthesis.variant _code_)) - __text__ (: (-> Text Synthesis) - (function (_ value) - (_code_ (synthesis.variant [5 #0 (synthesis.text value)])))) - __identifier__ (: (-> Name Synthesis) - (function (_ [module short]) - (_code_ (synthesis.variant [6 #0 (synthesis.tuple (list (synthesis.text module) - (synthesis.text short)))])))) - __tag__ (: (-> Name Synthesis) - (function (_ [module short]) - (_code_ (synthesis.variant [7 #0 (synthesis.tuple (list (synthesis.text module) - (synthesis.text short)))])))) - __list__ (: (-> (List Synthesis) Synthesis) - (list/fold (function (_ head tail) - (__form__ (list (__tag__ ["" "Cons"]) head tail))) - (__tag__ ["" "Nil"]))) - __apply__ (: (-> Synthesis Synthesis Synthesis) - (function (_ func arg) - (__form__ (list func arg))))] - (|> _nil_ - (_cons_ (__apply__ (__identifier__ ["" "form$"]) - (__list__ (list (__apply__ (__identifier__ ["" "tag$"]) - (__tuple__ (list (__text__ "lux") - (__text__ "Cons")))) - (__identifier__ ["" "export?-meta"]) - (__identifier__ ["" "tail"]))))) - (_cons_ (__tuple__ (list (__identifier__ ["" "tail"])))) - )))) - -(def: special-path - Path - (let [_nil_ (synthesis.path/side (#.Left 0)) - _cons_ (synthesis.path/side (#.Right 0)) - _head_ (synthesis.path/member (#.Left 0)) - _tail_ (synthesis.path/member (#.Right 0)) - _tuple_ (synthesis.path/side (#.Left 9))] - ($_ synthesis.path/alt - ($_ synthesis.path/seq - _cons_ - _head_ - _head_ (synthesis.path/bind 2) synthesis.path/pop - _tail_ _tuple_ _cons_ - _head_ (synthesis.path/bind 3) synthesis.path/pop - _tail_ (synthesis.path/bind 4) synthesis.path/pop - synthesis.path/pop synthesis.path/pop synthesis.path/pop synthesis.path/pop - _tail_ _cons_ - _head_ (synthesis.path/bind 5) synthesis.path/pop - _tail_ _nil_ - ## THEN - (synthesis.path/then (synthesis.bit #1))) - ($_ synthesis.path/seq - (synthesis.path/bind 2) - ## THEN - (synthesis.path/then (synthesis.bit #0)))))) - -(def: special-pattern - analysis.Pattern - (let [## [_ (#Tuple (#Cons arg args'))] - head (<| analysis.pattern/tuple (list (analysis.pattern/bind 2)) - analysis.pattern/variant [9 #0] - analysis.pattern/variant [0 #1] - analysis.pattern/tuple (list (analysis.pattern/bind 3) - (analysis.pattern/bind 4))) - ## (#Cons body #Nil) - tail (<| analysis.pattern/variant [0 #1] - analysis.pattern/tuple (list (analysis.pattern/bind 5)) - analysis.pattern/variant [0 #0] - (analysis.pattern/unit))] - ## (#Cons <head> <tail>) - (<| analysis.pattern/variant [0 #1] - (analysis.pattern/tuple (list head tail))))) - -(def: special-pattern-path - Path - ($_ synthesis.path/alt - (<| error.assume - (phase.run [extension/synthesis.bundle - synthesis.init]) - (case.path expression.synthesize - special-pattern) - (analysis.bit #1)) - ($_ synthesis.path/seq - (synthesis.path/bind 2) - ## THEN - (synthesis.path/then (synthesis.bit #0))))) - -(def: (special-spec run) - (-> Runner Test) - (do r.Monad<Random> - [] - ($_ seq - (test "===" - (and (text/= (synthesis.%path special-path) - (synthesis.%path special-pattern-path)) - (:: synthesis.Equivalence<Path> = special-path special-pattern-path))) - (test "CODE" - (|> (run special-input) - (case> (#error.Success output) - (exec (log! (|> output (:coerce (List Code)) (%list %code))) - #1) - - (#error.Error error) - (exec (log! error) - #0)))) - (test "PATTERN-MATCHING 0" - (|> (run (synthesis.branch/case [special-input - special-path])) - (case> (#error.Success output) - (exec (log! (format "output 0 = " (%b (:coerce Bit output)))) - #1) - - (#error.Error error) - (exec (log! error) - #0)))) - (test "PATTERN-MATCHING 1" - (|> (run (synthesis.branch/case [special-input - special-pattern-path])) - (case> (#error.Success output) - (exec (log! (format "output 1 = " (%b (:coerce Bit output)))) - #1) - - (#error.Error error) - (exec (log! error) - #0)))) - ))) - -(def: (pattern-matching-spec run) - (-> Runner Test) - ($_ seq - (special-spec run) - ## (let-spec run) - ## (if-spec run) - ## (case-spec run) - )) - -(context: "[JVM] Pattern-matching." - (<| (times 100) - (pattern-matching-spec common.run-jvm))) - -## (context: "[JS] Pattern-matching." -## (<| (times 100) -## (pattern-matching-spec common.run-js))) - -## (context: "[Lua] Pattern-matching." -## (<| (times 100) -## (pattern-matching-spec common.run-lua))) - -## (context: "[Ruby] Pattern-matching." -## (<| (times 100) -## (pattern-matching-spec common.run-ruby))) - -## (context: "[Python] Function." -## (<| (times 100) -## (pattern-matching-spec common.run-python))) - -## (context: "[R] Pattern-matching." -## (<| (times 100) -## (pattern-matching-spec common.run-r))) - -## (context: "[Scheme] Pattern-matching." -## (<| (times 100) -## (pattern-matching-spec common.run-scheme))) - -## (context: "[Common Lisp] Pattern-matching." -## (<| (times 100) -## (pattern-matching-spec common.run-common-lisp))) - -## (context: "[PHP] Pattern-matching." -## (<| (times 100) -## (pattern-matching-spec 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 deleted file mode 100644 index ef5bf7b67..000000000 --- a/new-luxc/test/test/luxc/lang/translation/function.lux +++ /dev/null @@ -1,140 +0,0 @@ -(.module: - [lux (#- function) - [control - [monad (#+ do)] - pipe] - [data - ["." maybe] - ["." error (#+ Error)] - ["." number] - [text - format] - [collection - ["." list ("list/." Functor<List>)]]] - [math - ["r" random (#+ Random) ("r/." Monad<Random>)]] - [compiler - [default - ["." reference (#+ Register)] - [phase - [analysis (#+ Arity)] - ["." synthesis (#+ Synthesis)]]]] - test] - [test - [luxc - ["." common (#+ Runner)]]]) - -(def: max-arity Arity 10) - -(def: arity - (Random Arity) - (|> r.nat (r/map (|>> (n/% max-arity) (n/max 1))))) - -(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 - local (..local arity)] - (wrap [arity local - (synthesis.function/abstraction - {#synthesis.environment (list) - #synthesis.arity arity - #synthesis.body (synthesis.variable/local local)})]))) - -(def: #export (check reference) - (-> Frac (Error Any) Bit) - (|>> (case> (#error.Success valueT) - (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 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 {#synthesis.function functionS - #synthesis.arguments inputsS})) - (check expectation))) - (test "Can partially apply functions." - (or (n/= 1 arity) - (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 (|> partial-arity - (list.n/range 1) - (list/map (|>> #reference.Local))) - 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." - (<| (times 100) - (function-spec common.run-jvm))) - -## (context: "[JS] Function." -## (<| (times 100) -## (function-spec common.run-js))) - -## (context: "[Lua] Function." -## (<| (times 100) -## (function-spec common.run-lua))) - -## (context: "[Ruby] Function." -## (<| (times 100) -## (function-spec common.run-ruby))) - -## (context: "[Python] Function." -## (<| (times 100) -## (function-spec common.run-python))) - -## (context: "[R] Function." -## (<| (times 100) -## (function-spec common.run-r))) - -## (context: "[Scheme] Function." -## (<| (times 100) -## (function-spec common.run-scheme))) - -## (context: "[Common Lisp] Function." -## (<| (times 100) -## (function-spec common.run-common-lisp))) - -## (context: "[PHP] Function." -## (<| (times 100) -## (function-spec common.run-php))) |