diff options
Diffstat (limited to '')
| -rw-r--r-- | .gitignore | 6 | ||||
| -rw-r--r-- | new-luxc/project.clj | 3 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/function.lux | 2 | ||||
| -rw-r--r-- | new-luxc/source/program.lux | 13 | ||||
| -rw-r--r-- | new-luxc/source/test/program.lux | 56 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/primitive.lux | 87 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/structure.lux | 122 | ||||
| -rw-r--r-- | stdlib/source/spec/compositor.lux | 69 | ||||
| -rw-r--r-- | stdlib/source/spec/compositor/generation/primitive.lux | 47 | ||||
| -rw-r--r-- | stdlib/source/spec/compositor/generation/structure.lux | 85 |
10 files changed, 273 insertions, 217 deletions
diff --git a/.gitignore b/.gitignore index e83967470..a5e435077 100644 --- a/.gitignore +++ b/.gitignore @@ -19,29 +19,35 @@ pom.xml.asc /new-luxc/source/lux.lux /new-luxc/source/lux /new-luxc/source/program +/new-luxc/source/spec /lux-js/target /lux-js/source/lux.lux /lux-js/source/lux /lux-js/source/program +/lux-js/source/spec /lux-python/target /lux-python/source/lux.lux /lux-python/source/lux /lux-python/source/program +/lux-python/source/spec /lux-lua/target /lux-lua/source/lux.lux /lux-lua/source/lux /lux-lua/source/program +/lux-lua/source/spec /lux-ruby/target /lux-ruby/source/lux.lux /lux-ruby/source/lux /lux-ruby/source/program +/lux-ruby/source/spec /lux-php/target /lux-php/source/lux.lux /lux-php/source/lux /lux-php/source/program +/lux-php/source/spec diff --git a/new-luxc/project.clj b/new-luxc/project.clj index 1b858000d..f3864bf06 100644 --- a/new-luxc/project.clj +++ b/new-luxc/project.clj @@ -31,7 +31,6 @@ :manifest {"lux" ~version} :source-paths ["source"] - :test-paths ["test"] :lux {:program "program" - :test "tests"} + :test "test/program"} ) diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.lux b/new-luxc/source/luxc/lang/translation/jvm/function.lux index db8716697..0fea18acd 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.lux @@ -300,7 +300,7 @@ (generation.with-anchor [@begin 1] (translate bodyS))) [functionD instanceI] (with-function @begin function-class env arity bodyI) - _ (generation.save! ["" function-class] + _ (generation.save! true ["" function-class] [function-class (def.class #$.V1_6 #$.Public $.finalC function-class (list) diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux index 0936b51dd..de4445d5f 100644 --- a/new-luxc/source/program.lux +++ b/new-luxc/source/program.lux @@ -57,7 +57,7 @@ (@.array-write 0 _object-class) (@.array-write 1 _object-class))) -(def: (expander macro inputs lux) +(def: #export (expander macro inputs lux) Expander (do error.monad [apply-method (|> macro @@ -72,7 +72,7 @@ (@.array-write 1 (:coerce java/lang/Object lux))) apply-method)))) -(def: jvm +(def: #export jvm (IO (Platform IO _.Anchor _.Inst _.Definition)) (do io.monad [host jvm.host] @@ -82,7 +82,7 @@ #platform.phase expression.translate #platform.runtime runtime.translate}))) -(def: (program programI) +(def: #export (program programI) (-> _.Inst _.Definition) (let [nilI runtime.noneI num-inputsI (|>> ($i.ALOAD 0) $i.ARRAYLENGTH) @@ -147,10 +147,13 @@ $i.POP $i.RETURN))))])) +(def: #export bundle + (dictionary.merge common.bundle + host.bundle)) + (program: [{service /cli.service}] (/.compiler ..expander ..jvm - (dictionary.merge common.bundle - host.bundle) + ..bundle ..program service)) diff --git a/new-luxc/source/test/program.lux b/new-luxc/source/test/program.lux new file mode 100644 index 000000000..40eb214c2 --- /dev/null +++ b/new-luxc/source/test/program.lux @@ -0,0 +1,56 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." io] + [parser + [cli (#+ program:)]]] + [math + ["r" random]]] + [spec + ["." compositor (#+ Runner) + [generation + ["." primitive] + ["." structure]]]] + {1 + ["." /]} + ## [test + ## [luxc + ## [lang + ## [translation + ## ## ["_.T" function] + ## ## ["_.T" reference] + ## ## ["_.T" case] + ## ## ["_.T" common] + ## ## ["_.T" jvm] + ## ## ["_.T" js] + ## ## ["_.T" lua] + ## ## ["_.T" ruby] + ## ## ["_.T" python] + ## ## ["_.T" r] + ## ## ["_.T" scheme] + ## ## ["_.T" common-lisp] + ## ## ["_.T" php] + ## ]]]] + ) + +(def: (test runner) + (-> Runner Test) + ($_ _.and + (primitive.spec runner) + (structure.spec runner) + )) + +(program: args + (<| io.io + _.run! + (_.times 100) + (do r.monad + [_ (wrap []) + #let [platform (io.run /.jvm)]]) + (..test (compositor.runner platform + /.bundle + /.expander + /.program)))) diff --git a/new-luxc/test/test/luxc/lang/translation/primitive.lux b/new-luxc/test/test/luxc/lang/translation/primitive.lux deleted file mode 100644 index f3c6c8fc3..000000000 --- a/new-luxc/test/test/luxc/lang/translation/primitive.lux +++ /dev/null @@ -1,87 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - pipe] - [data - ["." error] - [bit ("bit/." Equivalence<Bit>)] - ["." number] - [text ("text/." Equivalence<Text>) - format]] - [math - ["r" random]] - [compiler - [default - [phase - ["." synthesis]]]] - test] - [test - [luxc - common]]) - -(def: (f/=' reference subject) - (-> Frac Frac Bit) - (or (f/= reference subject) - (and (number.not-a-number? reference) - (number.not-a-number? subject)))) - -(def: (spec run) - (-> Runner Test) - (do r.Monad<Random> - [|bit| r.bit - |i64| r.i64 - |f64| r.frac - |text| (r.ascii 5)] - (`` ($_ seq - (~~ (template [<desc> <type> <synthesis> <sample> <test>] - [(test (format "Can translate " <desc> ".") - (|> (run (<synthesis> <sample>)) - (case> (#error.Success valueT) - (<test> <sample> (:coerce <type> valueT)) - - (#error.Error error) - false)))] - - ["bit" Bit synthesis.bit |bit| bit/=] - ["int" Int synthesis.i64 |i64| i/=] - ["frac" Frac synthesis.f64 |f64| f/='] - ["text" Text synthesis.text |text| text/=] - )) - )))) - -(context: "[JVM] Primitives." - (<| (times 100) - (spec run-jvm))) - -## (context: "[JS] Primitives." -## (<| (times 100) -## (spec run-js))) - -## (context: "[Lua] Primitives." -## (<| (times 100) -## (spec run-lua))) - -## (context: "[Ruby] Primitives." -## (<| (times 100) -## (spec run-ruby))) - -## (context: "[Python] Primitives." -## (<| (times 100) -## (spec run-python))) - -## (context: "[R] Primitives." -## (<| (times 100) -## (spec run-r))) - -## (context: "[Scheme] Primitives." -## (<| (times 100) -## (spec run-scheme))) - -## (context: "[Common Lisp] Primitives." -## (<| (times 100) -## (spec run-common-lisp))) - -## (context: "[PHP] Primitives." -## (<| (times 100) -## (spec run-php))) diff --git a/new-luxc/test/test/luxc/lang/translation/structure.lux b/new-luxc/test/test/luxc/lang/translation/structure.lux deleted file mode 100644 index c92b132e2..000000000 --- a/new-luxc/test/test/luxc/lang/translation/structure.lux +++ /dev/null @@ -1,122 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - pipe] - [data - ["." error] - ["." maybe] - [text ("text/." Equivalence<Text>) - format] - [collection - ["." array (#+ Array)] - ["." list ("list/." Functor<List>)]]] - [math - ["r" random]] - ["." host (#+ import:)] - [compiler - [default - [phase - ["." analysis] - ["." synthesis]]]] - test] - [test - [luxc - common]]) - -(import: java/lang/Integer) - -(def: (tuples-spec run) - (-> Runner Test) - (do r.Monad<Random> - [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) - tuple-in (r.list size r.i64)] - (test "Can translate tuple." - (|> (run (synthesis.tuple (list/map (|>> synthesis.i64) tuple-in))) - (case> (#error.Success tuple-out) - (let [tuple-out (:coerce (Array Any) tuple-out)] - (and (n/= size (array.size tuple-out)) - (list.every? (function (_ [left right]) - (i/= left (:coerce Int right))) - (list.zip2 tuple-in (array.to-list tuple-out))))) - - (#error.Error error) - (exec (log! error) - #0)))))) - -(def: (variants-spec run) - (-> Runner Test) - (do r.Monad<Random> - [num-tags (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) - tag-in (|> r.nat (:: @ map (n/% num-tags))) - #let [last?-in (|> num-tags dec (n/= tag-in))] - value-in r.i64] - (test "Can translate variant." - (|> (run (synthesis.variant {#analysis.lefts (if last?-in - (dec tag-in) - tag-in) - #analysis.right? last?-in - #analysis.value (synthesis.i64 value-in)})) - (case> (#error.Success valueT) - (let [valueT (:coerce (Array Any) valueT)] - (and (n/= 3 (array.size valueT)) - (let [tag-out (:coerce Integer (maybe.assume (array.read 0 valueT))) - last?-out (array.read 1 valueT) - value-out (:coerce Any (maybe.assume (array.read 2 valueT))) - same-tag? (|> tag-out host.int-to-long (:coerce Nat) (n/= tag-in)) - same-flag? (case last?-out - (#.Some last?-out') - (and last?-in (text/= "" (:coerce Text last?-out'))) - - #.None - (not last?-in)) - same-value? (|> value-out (:coerce Int) (i/= value-in))] - (and same-tag? - same-flag? - same-value?)))) - - (#error.Error error) - (exec (log! error) - #0)))))) - -(def: (structure-spec run) - (-> Runner Test) - ($_ seq - (tuples-spec run) - (variants-spec run))) - -(context: "[JVM] Structures." - (<| (times 100) - (structure-spec run-jvm))) - -## (context: "[JS] Structures." -## (<| (times 100) -## (structure-spec run-js))) - -## (context: "[Lua] Structures." -## (<| (times 100) -## (structure-spec run-lua))) - -## (context: "[Ruby] Structures." -## (<| (times 100) -## (structure-spec run-ruby))) - -## (context: "[Python] Structures." -## (<| (times 100) -## (structure-spec run-python))) - -## (context: "[R] Structures." -## (<| (times 100) -## (structure-spec run-r))) - -## (context: "[Scheme] Structures." -## (<| (times 100) -## (structure-spec run-scheme))) - -## (context: "[Common Lisp] Structures." -## (<| (times 100) -## (structure-spec run-common-lisp))) - -## (context: "[PHP] Structures." -## (<| (times 100) -## (structure-spec run-php))) diff --git a/stdlib/source/spec/compositor.lux b/stdlib/source/spec/compositor.lux new file mode 100644 index 000000000..bb90b0cdf --- /dev/null +++ b/stdlib/source/spec/compositor.lux @@ -0,0 +1,69 @@ +(.module: + [lux #* + [abstract + [monad (#+ do)]] + [control + ["." io (#+ IO)]] + [data + ["." error (#+ Error)]] + [tool + [compiler + ["." synthesis (#+ Synthesis)] + ["." statement] + ["." phase + ["." macro (#+ Expander)] + ["." generation (#+ Operation Bundle)] + [extension + ["." bundle]]] + [default + ["." platform (#+ Platform)]]]]]) + +(type: #export Runner (-> Text Synthesis (Error Any))) +(type: #export Definer (-> Name Synthesis (Error Any))) + +(def: #export (runner platform bundle expander program) + (All [anchor expression statement] + (-> (Platform IO anchor expression statement) + (Bundle anchor expression statement) + Expander + (-> expression statement) + Runner)) + (function (_ evaluation-name expressionS) + (io.run + (do io.monad + [?state (platform.initialize expander platform bundle program)] + (wrap (do error.monad + [[bundle' state] ?state + expressionG (<| (phase.run (get@ [#statement.generation + #statement.state] + state)) + (do phase.monad + [_ (get@ #platform.runtime platform)] + ((get@ #platform.phase platform) expressionS)))] + (:: (get@ #platform.host platform) evaluate! evaluation-name + expressionG))))) + )) + +## (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: #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)])))) diff --git a/stdlib/source/spec/compositor/generation/primitive.lux b/stdlib/source/spec/compositor/generation/primitive.lux new file mode 100644 index 000000000..788085836 --- /dev/null +++ b/stdlib/source/spec/compositor/generation/primitive.lux @@ -0,0 +1,47 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + [pipe (#+ case>)]] + [data + ["." error] + ["." bit ("#@." equivalence)] + [number + ["." frac]] + ["." text ("#@." equivalence) + format]] + [math + ["r" random]] + [tool + [compiler + ["." synthesis]]]] + ["." ///]) + +(def: (f/=' reference subject) + (-> Frac Frac Bit) + (or (f/= reference subject) + (and (frac.not-a-number? reference) + (frac.not-a-number? subject)))) + +(def: #export (spec run) + (-> ///.Runner Test) + (`` ($_ _.and + (~~ (template [<evaluation-name> <synthesis> <gen> <test>] + [(do r.monad + [expected <gen>] + (_.test (%name (name-of <synthesis>)) + (|> (run <evaluation-name> (<synthesis> expected)) + (case> (#error.Success actual) + (<test> expected (:assume actual)) + + (#error.Failure error) + false))))] + + ["bit" synthesis.bit r.bit bit@=] + ["i64" synthesis.i64 r.i64 "lux i64 ="] + ["f64" synthesis.f64 r.frac f/='] + ["text" synthesis.text (r.ascii 5) text@=] + )) + ))) diff --git a/stdlib/source/spec/compositor/generation/structure.lux b/stdlib/source/spec/compositor/generation/structure.lux new file mode 100644 index 000000000..00334596c --- /dev/null +++ b/stdlib/source/spec/compositor/generation/structure.lux @@ -0,0 +1,85 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + [pipe (#+ case>)]] + [data + ["." error] + ["." maybe] + ["." text ("#@." equivalence) + format] + [collection + ["." array (#+ Array)] + ["." list ("#@." functor)]]] + [math + ["r" random]] + ["." host (#+ import:)] + [tool + [compiler + ["." analysis] + ["." synthesis]]]] + ["." ///]) + +(import: #long java/lang/Integer) + +(def: (variant run) + (-> ///.Runner Test) + (do r.monad + [num-tags (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) + tag-in (|> r.nat (:: @ map (n/% num-tags))) + #let [last?-in (|> num-tags dec (n/= tag-in))] + value-in r.i64] + (_.test (%name (name-of synthesis.variant)) + (|> (synthesis.variant {#analysis.lefts (if last?-in + (dec tag-in) + tag-in) + #analysis.right? last?-in + #analysis.value (synthesis.i64 value-in)}) + (run "variant") + (case> (#error.Success valueT) + (let [valueT (:coerce (Array Any) valueT)] + (and (n/= 3 (array.size valueT)) + (let [tag-out (:coerce java/lang/Integer (maybe.assume (array.read 0 valueT))) + last?-out (array.read 1 valueT) + value-out (:coerce Any (maybe.assume (array.read 2 valueT))) + same-tag? (|> tag-out host.int-to-long (:coerce Nat) (n/= tag-in)) + same-flag? (case last?-out + (#.Some last?-out') + (and last?-in (text@= "" (:coerce Text last?-out'))) + + #.None + (not last?-in)) + same-value? (|> value-out (:coerce Int) (i/= value-in))] + (and same-tag? + same-flag? + same-value?)))) + + (#error.Failure error) + false))))) + +(def: (tuple run) + (-> ///.Runner Test) + (do r.monad + [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) + tuple-in (r.list size r.i64)] + (_.test (%name (name-of synthesis.tuple)) + (|> (synthesis.tuple (list@map (|>> synthesis.i64) tuple-in)) + (run "tuple") + (case> (#error.Success tuple-out) + (let [tuple-out (:coerce (Array Any) tuple-out)] + (and (n/= size (array.size tuple-out)) + (list.every? (function (_ [left right]) + (i/= left (:coerce Int right))) + (list.zip2 tuple-in (array.to-list tuple-out))))) + + (#error.Failure error) + false))))) + +(def: #export (spec runner) + (-> ///.Runner Test) + ($_ _.and + (..variant runner) + (..tuple runner) + )) |