diff options
Diffstat (limited to 'new-luxc')
| -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 |
6 files changed, 66 insertions, 217 deletions
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))) |