aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/spec
diff options
context:
space:
mode:
authorEduardo Julian2019-04-26 18:01:12 -0400
committerEduardo Julian2019-04-26 18:01:12 -0400
commite0b3538721a71f6e8c016b12c8c257b8cebd3981 (patch)
tree1263740cda4bff9311e58d5bb217e7565060d724 /stdlib/source/spec
parentf2c0473640e8029f27797f6ecf21662dddb0685b (diff)
WIP: Turning compiler tests into a re-usable specification.
Diffstat (limited to '')
-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
3 files changed, 201 insertions, 0 deletions
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)
+ ))