From 0abd5bd3c0e38e352e9ba38268e04e1c858ab01e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 15 Jul 2021 00:45:15 -0400 Subject: Re-named "spec" hierarchy to "specification". --- .../source/spec/compositor/generation/common.lux | 343 --------------------- 1 file changed, 343 deletions(-) delete mode 100644 stdlib/source/spec/compositor/generation/common.lux (limited to 'stdlib/source/spec/compositor/generation/common.lux') 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 [ (template [ ] - [(_.test - (|> (#synthesis.Extension (list (synthesis.i64 param) - (synthesis.i64 subject))) - (run (..sanitize )) - (case> (#try.Success valueT) - (n.= ( param subject) (:as Nat valueT)) - - (#try.Failure _) - false) - (let [param ])))] - - ["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 - - (_.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 [ ] - [(_.test - (|> (#synthesis.Extension (list (synthesis.i64 subject))) - (run (..sanitize )) - (case> (#try.Success valueT) - ( ( subject) (:as valueT)) - - (#try.Failure _) - false) - (let [subject ])))] - - ["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 [ ] - [(_.test - (|> (#synthesis.Extension (list (synthesis.i64 param) - (synthesis.i64 subject))) - (run (..sanitize )) - (case> (#try.Success valueT) - ( ( param subject) (:as 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 [ ] - [(_.test - (|> (#synthesis.Extension (list (synthesis.f64 param) - (synthesis.f64 subject))) - (run (..sanitize )) - (//case.verify ( param subject))))] - - ["lux f64 +" f.+ f.=] - ["lux f64 -" f.- f.=] - ["lux f64 *" f.* f.=] - ["lux f64 /" f./ f.=] - ["lux f64 %" f.% f.=] - )) - (~~ (template [ ] - [(_.test - (|> (#synthesis.Extension (list (synthesis.f64 param) - (synthesis.f64 subject))) - (run (..sanitize )) - (case> (#try.Success valueV) - (bit\= ( param subject) - (:as Bit valueV)) - - _ - false)))] - - ["lux f64 =" f.=] - ["lux f64 <" f.<] - )) - (~~ (template [ ] - [(_.test - (|> (#synthesis.Extension (list)) - (run (..sanitize )) - (//case.verify )))] - - ["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) - )) -- cgit v1.2.3