aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/spec/compositor/generation/common.lux339
1 files changed, 339 insertions, 0 deletions
diff --git a/stdlib/source/spec/compositor/generation/common.lux b/stdlib/source/spec/compositor/generation/common.lux
new file mode 100644
index 000000000..16ff5aab8
--- /dev/null
+++ b/stdlib/source/spec/compositor/generation/common.lux
@@ -0,0 +1,339 @@
+(.module:
+ [lux (#- i64)
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ [pipe (#+ case>)]]
+ [data
+ ["." error (#+ Error)]
+ ["." bit ("#@." equivalence)]
+ [number
+ ["." i64]]
+ ["." text ("#@." equivalence)
+ format]
+ [collection
+ ["." list]]]
+ [math
+ ["r" random (#+ Random)]]
+ [tool
+ [compiler
+ ["." reference]
+ ["." synthesis]]]]
+ ["." // #_
+ ["#." case]
+ ["/#" // (#+ Runner)]])
+
+(def: sanitize
+ (-> Text Text)
+ (text.replace-all " " "_"))
+
+(def: (bit run)
+ (-> Runner Test)
+ (do r.monad
+ [param r.i64
+ subject r.i64]
+ (with-expansions [<binary> (template [<extension> <reference> <param-expr>]
+ [(_.test <extension>
+ (|> (#synthesis.Extension <extension> (list (synthesis.i64 param)
+ (synthesis.i64 subject)))
+ (run (..sanitize <extension>))
+ (case> (#error.Success valueT)
+ (n/= (<reference> param subject) (:coerce Nat valueT))
+
+ (#error.Failure error)
+ false)
+ (let [param <param-expr>])))]
+
+ ["lux i64 and" i64.and param]
+ ["lux i64 or" i64.or param]
+ ["lux i64 xor" i64.xor param]
+ ["lux i64 left-shift" i64.left-shift (n/% 64 param)]
+ ["lux i64 logical-right-shift" i64.logic-right-shift (n/% 64 param)]
+ )]
+ ($_ _.and
+ <binary>
+ (_.test "lux i64 arithmetic-right-shift"
+ (|> (#synthesis.Extension "lux i64 arithmetic-right-shift"
+ (list (synthesis.i64 subject)
+ (synthesis.i64 param)))
+ (run (..sanitize "lux i64 arithmetic-right-shift"))
+ (case> (#error.Success valueT)
+ ("lux i64 ="
+ (i64.arithmetic-right-shift param subject)
+ (:coerce I64 valueT))
+
+ (#error.Failure error)
+ false)
+ (let [param (n/% 64 param)])))
+ ))))
+
+(def: (i64 run)
+ (-> Runner Test)
+ (do r.monad
+ [param (|> r.i64 (r.filter (|>> ("lux i64 =" 0) not)))
+ subject r.i64]
+ (`` ($_ _.and
+ (~~ (template [<extension> <type> <prepare> <comp> <subject-expr>]
+ [(_.test <extension>
+ (|> (#synthesis.Extension <extension> (list (synthesis.i64 subject)))
+ (run (..sanitize <extension>))
+ (case> (#error.Success valueT)
+ (<comp> (<prepare> subject) (:coerce <type> valueT))
+
+ (#error.Failure error)
+ false)
+ (let [subject <subject-expr>])))]
+
+ ["lux i64 to-f64" Frac int-to-frac f/= subject]
+ ["lux i64 char" Text (|>> (:coerce Nat) text.from-code) text@= (|> subject
+ (:coerce Nat)
+ (n/% (i64.left-shift 8 1))
+ (:coerce Int))]
+ ))
+ (~~ (template [<extension> <reference> <outputT> <comp>]
+ [(_.test <extension>
+ (|> (#synthesis.Extension <extension> (list (synthesis.i64 param)
+ (synthesis.i64 subject)))
+ (run (..sanitize <extension>))
+ (case> (#error.Success valueT)
+ (<comp> (<reference> param subject) (:coerce <outputT> valueT))
+
+ (#error.Failure error)
+ false)))]
+
+ ["lux i64 +" i/+ Int i/=]
+ ["lux i64 -" i/- Int i/=]
+ ["lux i64 *" i/* Int i/=]
+ ["lux i64 /" i// Int i/=]
+ ["lux i64 %" i/% Int i/=]
+ ["lux i64 =" i/= Bit bit@=]
+ ["lux i64 <" i/< Bit bit@=]
+ ))
+ ))))
+
+(def: simple-frac
+ (Random Frac)
+ (|> r.nat (:: r.monad map (|>> (n/% 1000) .int int-to-frac))))
+
+(def: (f64 run)
+ (-> Runner Test)
+ (do r.monad
+ [param (|> ..simple-frac (r.filter (|>> (f/= +0.0) not)))
+ subject ..simple-frac]
+ (`` ($_ _.and
+ (~~ (template [<extension> <reference> <comp>]
+ [(_.test <extension>
+ (|> (#synthesis.Extension <extension> (list (synthesis.f64 param)
+ (synthesis.f64 subject)))
+ (run (..sanitize <extension>))
+ (//case.verify (<reference> param subject))))]
+
+ ["lux f64 +" f/+ f/=]
+ ["lux f64 -" f/- f/=]
+ ["lux f64 *" f/* f/=]
+ ["lux f64 /" f// f/=]
+ ["lux f64 %" f/% f/=]
+ ))
+ (~~ (template [<extension> <text>]
+ [(_.test <extension>
+ (|> (#synthesis.Extension <extension> (list (synthesis.f64 param)
+ (synthesis.f64 subject)))
+ (run (..sanitize <extension>))
+ (case> (#error.Success valueV)
+ (bit@= (<text> param subject)
+ (:coerce Bit valueV))
+
+ _
+ false)))]
+
+ ["lux f64 =" f/=]
+ ["lux f64 <" f/<]
+ ))
+ (~~ (template [<extension> <reference>]
+ [(_.test <extension>
+ (|> (#synthesis.Extension <extension> (list))
+ (run (..sanitize <extension>))
+ (//case.verify <reference>)))]
+
+ ["lux f64 min" ("lux frac min")]
+ ["lux f64 max" ("lux frac max")]
+ ["lux f64 smallest" ("lux frac smallest")]
+ ))
+ (_.test "'lux f64 to-i64' && 'lux i64 to-f64'"
+ (|> (run (..sanitize "lux f64 to-i64")
+ (|> subject synthesis.f64
+ (list) (#synthesis.Extension "lux f64 to-i64")
+ (list) (#synthesis.Extension "lux i64 to-f64")))
+ (//case.verify subject)))
+ ))))
+
+(def: (text run)
+ (-> Runner Test)
+ (do r.monad
+ [sample-size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))
+ sample-lower (r.ascii/lower-alpha sample-size)
+ sample-upper (r.ascii/upper-alpha sample-size)
+ sample-alpha (|> (r.ascii/alpha sample-size)
+ (r.filter (|>> (text@= sample-upper) not)))
+ char-idx (|> r.nat (:: @ map (n/% sample-size)))
+ #let [sample-lowerS (synthesis.text sample-lower)
+ sample-upperS (synthesis.text sample-upper)
+ sample-alphaS (synthesis.text sample-alpha)
+ concatenatedS (#synthesis.Extension "lux text concat" (list sample-lowerS sample-upperS))
+ pre-rep-once (format sample-lower sample-upper)
+ post-rep-once (format sample-lower sample-alpha)
+ pre-rep-all (|> (list.repeat sample-size sample-lower) (text.join-with sample-upper))
+ post-rep-all (|> (list.repeat sample-size sample-lower) (text.join-with sample-alpha))]]
+ ($_ _.and
+ (_.test "Can compare texts for equality."
+ (and (|> (#synthesis.Extension "lux text =" (list sample-lowerS sample-lowerS))
+ (run (..sanitize "lux text ="))
+ (case> (#error.Success valueV)
+ (:coerce Bit valueV)
+
+ _
+ false))
+ (|> (#synthesis.Extension "lux text =" (list sample-upperS sample-lowerS))
+ (run (..sanitize "lux text ="))
+ (case> (#error.Success valueV)
+ (not (:coerce Bit valueV))
+
+ _
+ false))))
+ (_.test "Can compare texts for order."
+ (|> (#synthesis.Extension "lux text <" (list sample-lowerS sample-upperS))
+ (run (..sanitize "lux text <"))
+ (case> (#error.Success valueV)
+ (:coerce Bit valueV)
+
+ (#error.Failure error)
+ false)))
+ (_.test "Can get length of text."
+ (|> (#synthesis.Extension "lux text size" (list sample-lowerS))
+ (run (..sanitize "lux text size"))
+ (case> (#error.Success valueV)
+ (n/= sample-size (:coerce Nat valueV))
+
+ _
+ false)))
+ (_.test "Can concatenate text."
+ (|> (#synthesis.Extension "lux text size" (list concatenatedS))
+ (run (..sanitize "lux text size"))
+ (case> (#error.Success valueV)
+ (n/= (n/* 2 sample-size) (:coerce Nat valueV))
+
+ _
+ false)))
+ (_.test "Can find index of sub-text."
+ (and (|> (#synthesis.Extension "lux text index"
+ (list concatenatedS sample-lowerS
+ (synthesis.i64 +0)))
+ (run (..sanitize "lux text index"))
+ (case> (^multi (#error.Success valueV)
+ [(:coerce (Maybe Nat) valueV) (#.Some valueV)])
+ (n/= 0 valueV)
+
+ _
+ false))
+ (|> (#synthesis.Extension "lux text index"
+ (list concatenatedS sample-upperS
+ (synthesis.i64 +0)))
+ (run (..sanitize "lux text index"))
+ (case> (^multi (#error.Success valueV)
+ [(:coerce (Maybe Nat) valueV) (#.Some valueV)])
+ (n/= sample-size valueV)
+
+ _
+ false))))
+ (let [test-clip (: (-> (I64 Any) (I64 Any) Text Bit)
+ (function (_ from to expected)
+ (|> (#synthesis.Extension "lux text clip"
+ (list concatenatedS
+ (synthesis.i64 from)
+ (synthesis.i64 to)))
+ (run (..sanitize "lux text clip"))
+ (case> (^multi (#error.Success valueV)
+ [(:coerce (Maybe Text) valueV) (#.Some valueV)])
+ (text@= expected valueV)
+
+ _
+ false))))]
+ (_.test "Can clip text to extract sub-text."
+ (and (test-clip 0 sample-size sample-lower)
+ (test-clip sample-size (n/* 2 sample-size) sample-upper))))
+ (_.test "Can extract individual characters from text."
+ (|> (#synthesis.Extension "lux text char"
+ (list sample-lowerS
+ (synthesis.i64 char-idx)))
+ (run (..sanitize "lux text char"))
+ (case> (^multi (#error.Success valueV)
+ [(:coerce (Maybe Int) valueV) (#.Some valueV)])
+ (text.contains? ("lux int char" valueV)
+ sample-lower)
+
+ _
+ false)))
+ )))
+
+(def: (io run)
+ (-> Runner Test)
+ (do r.monad
+ [message (r.ascii/alpha 5)]
+ ($_ _.and
+ (_.test "Can log messages."
+ (|> (#synthesis.Extension "lux io log"
+ (list (synthesis.text (format "LOG: " message))))
+ (run (..sanitize "lux io log"))
+ (case> (#error.Success valueV)
+ true
+
+ (#error.Failure error)
+ false)))
+ (_.test "Can throw runtime errors."
+ (and (|> (#synthesis.Extension "lux try"
+ (list (synthesis.function/abstraction
+ {#synthesis.environment (list)
+ #synthesis.arity 1
+ #synthesis.body (#synthesis.Extension "lux io error"
+ (list (synthesis.text message)))})))
+ (run (..sanitize "lux try"))
+ (case> (^multi (#error.Success valueV)
+ [(:coerce (Error Text) valueV) (#error.Failure error)])
+ (text.contains? message error)
+
+ _
+ false))
+ (|> (#synthesis.Extension "lux try"
+ (list (synthesis.function/abstraction
+ {#synthesis.environment (list)
+ #synthesis.arity 1
+ #synthesis.body (synthesis.text message)})))
+ (run (..sanitize "lux try"))
+ (case> (^multi (#error.Success valueV)
+ [(:coerce (Error Text) valueV) (#error.Success valueV)])
+ (text@= message valueV)
+
+ _
+ false))))
+ (_.test "Can obtain current time in milli-seconds."
+ (|> (synthesis.tuple (list (#synthesis.Extension "lux io current-time" (list))
+ (#synthesis.Extension "lux io current-time" (list))))
+ (run (..sanitize "lux io current-time"))
+ (case> (#error.Success valueV)
+ (let [[pre post] (:coerce [Nat Nat] valueV)]
+ (n/>= pre post))
+
+ (#error.Failure error)
+ false)))
+ )))
+
+(def: #export (spec runner)
+ (-> Runner Test)
+ ($_ _.and
+ (..bit runner)
+ (..i64 runner)
+ (..f64 runner)
+ (..text runner)
+ (..io runner)
+ ))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-29 18:57:03 +0000