aboutsummaryrefslogtreecommitdiff
path: root/new-luxc
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc')
-rw-r--r--new-luxc/source/test/program.lux11
-rw-r--r--new-luxc/test/test/luxc/lang/translation/case.lux316
-rw-r--r--new-luxc/test/test/luxc/lang/translation/function.lux140
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)))