aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/spec/compositor.lux26
-rw-r--r--stdlib/source/spec/compositor/generation/case.lux (renamed from new-luxc/test/test/luxc/lang/translation/case.lux)228
-rw-r--r--stdlib/source/spec/compositor/generation/function.lux92
3 files changed, 192 insertions, 154 deletions
diff --git a/stdlib/source/spec/compositor.lux b/stdlib/source/spec/compositor.lux
index a62d2efa9..4967c0f8c 100644
--- a/stdlib/source/spec/compositor.lux
+++ b/stdlib/source/spec/compositor.lux
@@ -28,46 +28,24 @@
(generation.State+ anchor expression statement)
what)))
-## (def: #export (runner generate-runtime translate bundle state)
-## (-> (Operation Any) Phase Bundle (IO State)
-## Runner)
-## (function (_ valueS)
-## (|> (do phase.Monad<Operation>
-## [_ generate-runtime
-## program (translate valueS)]
-## (translation.evaluate! "runner" program))
-## translation.with-buffer
-## (phase.run [bundle (io.run state)]))))
-
(def: (runner (^slots [#platform.runtime #platform.phase #platform.host]) state)
(Instancer Runner)
(function (_ evaluation-name expressionS)
(do error.monad
[expressionG (<| (phase.run state)
+ generation.with-buffer
(do phase.monad
[_ runtime]
(phase expressionS)))]
(:: host evaluate! evaluation-name expressionG))))
-## (def: #export (definer generate-runtime translate bundle state)
-## (-> (Operation Any) Phase Bundle (IO State) Definer)
-## (function (_ lux-name valueS)
-## (|> (do phase.Monad<Operation>
-## [_ generate-runtime
-## valueH (translate valueS)
-## [host-name host-value] (translation.define! lux-name valueH)
-## _ (translation.learn lux-name host-name)
-## program (translate (synthesis.constant lux-name))]
-## (translation.evaluate! "definer" program))
-## translation.with-buffer
-## (phase.run [bundle (io.run state)]))))
-
(def: (definer (^slots [#platform.runtime #platform.phase #platform.host])
state)
(Instancer Definer)
(function (_ lux-name expressionS)
(do error.monad
[definitionG (<| (phase.run state)
+ generation.with-buffer
(do phase.monad
[_ runtime
expressionG (phase expressionS)
diff --git a/new-luxc/test/test/luxc/lang/translation/case.lux b/stdlib/source/spec/compositor/generation/case.lux
index 0cee2818a..1c398d301 100644
--- a/new-luxc/test/test/luxc/lang/translation/case.lux
+++ b/stdlib/source/spec/compositor/generation/case.lux
@@ -1,52 +1,57 @@
(.module:
[lux (#- case)
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
[control
- [monad (#+ do)]
- pipe]
+ [pipe (#+ case>)]]
[data
- ["." error]
- [text ("text/." Equivalence<Text>)
+ ["." error (#+ Error)]
+ ["." text ("#@." equivalence)
format]
[collection
- ["." list ("list/." Functor<List> Fold<List>)]]]
+ ["." list ("#@." fold)]]]
[math
["r" random (#+ Random)]]
- [compiler
- [default
+ [tool
+ [compiler
["." reference]
+ ["." analysis]
+ ["." synthesis (#+ Path Synthesis)]
["." phase
- ["." analysis]
- ["." synthesis (#+ Path Synthesis)
- ["." case]
- ["." expression]]
- ["." extension/synthesis]]]]
- test]
- [test
- [luxc
- ["." common (#+ Runner)]]]
- [//
- ["&" function]])
+ ["#/." synthesis
+ ["." case]]
+ ["." extension/synthesis]]]]]
+ ["." ///])
(def: limit Nat 10)
(def: size
(Random Nat)
- (|> r.nat (:: r.Monad<Random> map (|>> (n/% ..limit) (n/max 2)))))
+ (|> r.nat (:: r.monad map (|>> (n/% ..limit) (n/max 2)))))
(def: (tail? size idx)
(-> Nat Nat Bit)
(n/= (dec size) idx))
+(def: #export (verify expected)
+ (-> Frac (Error Any) Bit)
+ (|>> (case> (#error.Success actual)
+ (f/= expected (:coerce Frac actual))
+
+ (#error.Failure error)
+ false)))
+
(def: case
(Random [Synthesis Path])
(<| r.rec (function (_ case))
(`` ($_ r.either
- (do r.Monad<Random>
+ (do r.monad
[value r.i64]
(wrap [(synthesis.i64 value)
synthesis.path/pop]))
(~~ (template [<gen> <synth> <path>]
- [(do r.Monad<Random>
+ [(do r.monad
[value <gen>]
(wrap [(<synth> value)
(<path> value)]))]
@@ -55,7 +60,7 @@
[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>
+ (do r.monad
[size ..size
idx (|> r.nat (:: @ map (n/% size)))
[subS subP] case
@@ -70,7 +75,7 @@
(synthesis.member/left idx))
subP)]]
(wrap [caseS caseP]))
- (do r.Monad<Random>
+ (do r.monad
[size ..size
idx (|> r.nat (:: @ map (n/% size)))
[subS subP] case
@@ -88,42 +93,45 @@
))))
(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)))))
+ (-> ///.Runner Test)
+ (do r.monad
+ [value r.safe-frac]
+ (_.test (%name (name-of synthesis.branch/let))
+ (|> (synthesis.branch/let [(synthesis.f64 value)
+ 0
+ (synthesis.variable/local 0)])
+ (run "let-spec")
+ (verify 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)))
+ (-> ///.Runner Test)
+ (do r.monad
+ [on-true r.safe-frac
+ on-false (|> r.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))))))
+ (_.test (%name (name-of synthesis.branch/if))
+ (|> (synthesis.branch/if [(synthesis.bit verdict)
+ (synthesis.f64 on-true)
+ (synthesis.f64 on-false)])
+ (run "if-spec")
+ (verify (if verdict on-true on-false))))))
(def: (case-spec run)
- (-> Runner Test)
- (do r.Monad<Random>
+ (-> ///.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)))))
+ on-success r.safe-frac
+ on-failure (|> r.safe-frac (r.filter (|>> (f/= on-success) not)))]
+ (_.test (%name (name-of synthesis.branch/case))
+ (|> (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)))])
+ (run "case-spec")
+ (verify on-success)))))
(def: special-input
Synthesis
@@ -140,7 +148,7 @@
(function (_ head tail)
(synthesis.variant [0 #1 (synthesis.tuple (list head tail))])))
_list_ (: (-> (List Synthesis) Synthesis)
- (list/fold _cons_ _nil_))]
+ (list@fold _cons_ _nil_))]
(let [__tuple__ (: (-> (List Synthesis) Synthesis)
(|>> list.reverse _list_ [9 #0] synthesis.variant _code_))
__form__ (: (-> (List Synthesis) Synthesis)
@@ -157,7 +165,7 @@
(_code_ (synthesis.variant [7 #0 (synthesis.tuple (list (synthesis.text module)
(synthesis.text short)))]))))
__list__ (: (-> (List Synthesis) Synthesis)
- (list/fold (function (_ head tail)
+ (list@fold (function (_ head tail)
(__form__ (list (__tag__ ["" "Cons"]) head tail)))
(__tag__ ["" "Nil"])))
__apply__ (: (-> Synthesis Synthesis Synthesis)
@@ -222,7 +230,7 @@
(<| error.assume
(phase.run [extension/synthesis.bundle
synthesis.init])
- (case.path expression.synthesize
+ (case.path phase/synthesis.phase
special-pattern)
(analysis.bit #1))
($_ synthesis.path/seq
@@ -230,87 +238,47 @@
## THEN
(synthesis.path/then (synthesis.bit #0)))))
+## TODO: Get rid of this ASAP
(def: (special-spec run)
- (-> Runner Test)
- (do r.Monad<Random>
- []
- ($_ seq
- (test "==="
- (and (text/= (synthesis.%path special-path)
+ (-> ///.Runner Test)
+ ($_ _.and
+ (_.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)
+ (:: synthesis.path-equivalence = special-path special-pattern-path)))
+ (_.test "CODE"
+ (|> special-input
+ (run "special-input")
(case> (#error.Success output)
- (exec (log! (|> output (:coerce (List Code)) (%list %code)))
- #1)
+ true
- (#error.Error error)
- (exec (log! error)
- #0))))
- (test "PATTERN-MATCHING 0"
- (|> (run (synthesis.branch/case [special-input
- special-path]))
+ (#error.Failure error)
+ false)))
+ (_.test "PATTERN-MATCHING 0"
+ (|> (synthesis.branch/case [special-input
+ special-path])
+ (run "special-path")
(case> (#error.Success output)
- (exec (log! (format "output 0 = " (%b (:coerce Bit output))))
- #1)
+ true
- (#error.Error error)
- (exec (log! error)
- #0))))
- (test "PATTERN-MATCHING 1"
- (|> (run (synthesis.branch/case [special-input
- special-pattern-path]))
+ (#error.Failure error)
+ false)))
+ (_.test "PATTERN-MATCHING 1"
+ (|> (synthesis.branch/case [special-input
+ special-pattern-path])
+ (run "special-pattern-path")
(case> (#error.Success output)
- (exec (log! (format "output 1 = " (%b (:coerce Bit output))))
- #1)
+ true
- (#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)
+ (#error.Failure error)
+ false)))
))
-(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)))
+(def: #export (spec run)
+ (-> ///.Runner Test)
+ ($_ _.and
+ (..special-spec run)
+ (..let-spec run)
+ (..if-spec run)
+ (..case-spec run)
+ ))
diff --git a/stdlib/source/spec/compositor/generation/function.lux b/stdlib/source/spec/compositor/generation/function.lux
new file mode 100644
index 000000000..c9f8f5f56
--- /dev/null
+++ b/stdlib/source/spec/compositor/generation/function.lux
@@ -0,0 +1,92 @@
+(.module:
+ [lux (#- function)
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ [pipe (#+ case>)]]
+ [data
+ ["." maybe]
+ ["." error (#+ Error)]
+ [text
+ format]
+ [collection
+ ["." list ("#@." functor)]]]
+ [math
+ ["r" random (#+ Random) ("#@." monad)]]
+ [tool
+ [compiler
+ [analysis (#+ Arity)]
+ ["." reference (#+ Register)]
+ ["." synthesis (#+ Synthesis)]]]]
+ ["." // #_
+ ["#." case]
+ ["/#" //]])
+
+(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
+ [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 (spec run)
+ (-> ///.Runner Test)
+ (do r.monad
+ [[arity local functionS] ..function
+ partial-arity (|> r.nat (:: @ map (|>> (n/% arity) (n/max 1))))
+ inputs (r.list arity r.safe-frac)
+ #let [expectation (maybe.assume (list.nth (dec local) inputs))
+ inputsS (list@map (|>> synthesis.f64) inputs)]]
+ ($_ _.and
+ (_.test "Can read arguments."
+ (|> (synthesis.function/apply {#synthesis.function functionS
+ #synthesis.arguments inputsS})
+ (run "with-local")
+ (//case.verify 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})]
+ (|> (synthesis.function/apply {#synthesis.function partialS
+ #synthesis.arguments postS})
+ (run "partial-application")
+ (//case.verify 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})]
+ (|> (synthesis.function/apply {#synthesis.function outerS
+ #synthesis.arguments inputsS})
+ (run "with-foreign")
+ (//case.verify expectation)))))
+ )))