aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--.gitignore6
-rw-r--r--new-luxc/project.clj3
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/function.lux2
-rw-r--r--new-luxc/source/program.lux13
-rw-r--r--new-luxc/source/test/program.lux56
-rw-r--r--new-luxc/test/test/luxc/lang/translation/primitive.lux87
-rw-r--r--new-luxc/test/test/luxc/lang/translation/structure.lux122
-rw-r--r--stdlib/source/spec/compositor.lux69
-rw-r--r--stdlib/source/spec/compositor/generation/primitive.lux47
-rw-r--r--stdlib/source/spec/compositor/generation/structure.lux85
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)
+ ))