aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/spec/compositor/generation/common.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/spec/compositor/generation/common.lux')
-rw-r--r--stdlib/source/spec/compositor/generation/common.lux343
1 files changed, 0 insertions, 343 deletions
diff --git a/stdlib/source/spec/compositor/generation/common.lux b/stdlib/source/spec/compositor/generation/common.lux
deleted file mode 100644
index 3d377b7ca..000000000
--- a/stdlib/source/spec/compositor/generation/common.lux
+++ /dev/null
@@ -1,343 +0,0 @@
-(.module:
- [lux (#- i64)
- ["_" test (#+ Test)]
- [abstract
- [monad (#+ do)]]
- [control
- [pipe (#+ case>)]
- ["." try (#+ Try)]]
- [data
- ["." bit ("#\." equivalence)]
- [number
- ["." i64]
- ["n" nat]
- ["i" int]
- ["f" frac]]
- ["." text ("#\." equivalence)
- ["%" format (#+ format)]]
- [collection
- ["." list]]]
- [math
- ["r" random (#+ Random)]]
- [tool
- [compiler
- ["." reference]
- ["." synthesis]]]]
- ["." // #_
- ["#." case]
- [//
- [common (#+ 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> (#try.Success valueT)
- (n.= (<reference> param subject) (:as Nat valueT))
-
- (#try.Failure _)
- 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> (#try.Success valueT)
- ("lux i64 ="
- (i64.arithmetic-right-shift param subject)
- (:as I64 valueT))
-
- (#try.Failure _)
- 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> (#try.Success valueT)
- (<comp> (<prepare> subject) (:as <type> valueT))
-
- (#try.Failure _)
- false)
- (let [subject <subject-expr>])))]
-
- ["lux i64 f64" Frac i.frac f.= subject]
- ["lux i64 char" Text (|>> (:as Nat) text.from-code) text\= (|> subject
- (:as Nat)
- (n.% (i64.left-shift 8 1))
- (:as Int))]
- ))
- (~~ (template [<extension> <reference> <outputT> <comp>]
- [(_.test <extension>
- (|> (#synthesis.Extension <extension> (list (synthesis.i64 param)
- (synthesis.i64 subject)))
- (run (..sanitize <extension>))
- (case> (#try.Success valueT)
- (<comp> (<reference> param subject) (:as <outputT> valueT))
-
- (#try.Failure _)
- 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 i.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> (#try.Success valueV)
- (bit\= (<text> param subject)
- (:as 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 f64 min")]
- ["lux f64 max" ("lux f64 max")]
- ["lux f64 smallest" ("lux f64 smallest")]
- ))
- (_.test "'lux f64 i64 && 'lux i64 f64'"
- (|> (run (..sanitize "lux f64 i64")
- (|> subject synthesis.f64
- (list) (#synthesis.Extension "lux f64 i64")
- (list) (#synthesis.Extension "lux i64 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> (#try.Success valueV)
- (:as Bit valueV)
-
- _
- false))
- (|> (#synthesis.Extension "lux text =" (list sample-upperS sample-lowerS))
- (run (..sanitize "lux text ="))
- (case> (#try.Success valueV)
- (not (:as Bit valueV))
-
- _
- false))))
- (_.test "Can compare texts for order."
- (|> (#synthesis.Extension "lux text <" (list sample-lowerS sample-upperS))
- (run (..sanitize "lux text <"))
- (case> (#try.Success valueV)
- (:as Bit valueV)
-
- (#try.Failure _)
- false)))
- (_.test "Can get length of text."
- (|> (#synthesis.Extension "lux text size" (list sample-lowerS))
- (run (..sanitize "lux text size"))
- (case> (#try.Success valueV)
- (n.= sample-size (:as Nat valueV))
-
- _
- false)))
- (_.test "Can concatenate text."
- (|> (#synthesis.Extension "lux text size" (list concatenatedS))
- (run (..sanitize "lux text size"))
- (case> (#try.Success valueV)
- (n.= (n.* 2 sample-size) (:as 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 (#try.Success valueV)
- [(:as (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 (#try.Success valueV)
- [(:as (Maybe Nat) valueV) (#.Some valueV)])
- (n.= sample-size valueV)
-
- _
- false))))
- (let [test-clip (: (-> (I64 Any) (I64 Any) Text Bit)
- (function (_ offset length expected)
- (|> (#synthesis.Extension "lux text clip"
- (list concatenatedS
- (synthesis.i64 offset)
- (synthesis.i64 length)))
- (run (..sanitize "lux text clip"))
- (case> (^multi (#try.Success valueV)
- [(:as (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 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 (#try.Success valueV)
- [(:as (Maybe Int) valueV) (#.Some valueV)])
- (text.contains? ("lux i64 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> (#try.Success valueV)
- true
-
- (#try.Failure _)
- 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 (#try.Success valueV)
- [(:as (Try Text) valueV) (#try.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 (#try.Success valueV)
- [(:as (Try Text) valueV) (#try.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> (#try.Success valueV)
- (let [[pre post] (:as [Nat Nat] valueV)]
- (n.>= pre post))
-
- (#try.Failure _)
- 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-08-29 06:56:12 +0000