aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/specification/compositor/generation/common.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/specification/compositor/generation/common.lux')
-rw-r--r--stdlib/source/specification/compositor/generation/common.lux350
1 files changed, 0 insertions, 350 deletions
diff --git a/stdlib/source/specification/compositor/generation/common.lux b/stdlib/source/specification/compositor/generation/common.lux
deleted file mode 100644
index acb782c1f..000000000
--- a/stdlib/source/specification/compositor/generation/common.lux
+++ /dev/null
@@ -1,350 +0,0 @@
-(.require
- [library
- [lux (.except i64)
- [abstract
- [monad (.only do)]]
- [control
- ["[0]" pipe]
- ["[0]" try (.only Try)]]
- [data
- ["[0]" bit (.use "[1]#[0]" equivalence)]
- [number
- ["[0]" i64]
- ["n" nat]
- ["i" int]
- ["f" frac]]
- ["[0]" text (.use "[1]#[0]" equivalence)
- ["%" \\format (.only format)]]
- [collection
- ["[0]" list]]]
- [math
- ["r" random (.only Random)]]
- [meta
- [macro
- ["^" pattern]]
- [compiler
- ["[0]" reference]
- ["[0]" synthesis]]]
- [test
- ["_" property (.only Test)]]]]
- ["[0]" //
- ["[1][0]" when]
- [//
- [common (.only Runner)]]])
-
-(def safe
- (-> Text Text)
- (text.replaced " " "_"))
-
-(def (bit run)
- (-> Runner Test)
- (do r.monad
- [param r.i64
- subject r.i64]
- (with_expansions [<binary> (with_template [<extension> <reference> <param_expr>]
- [(_.test <extension>
- (|> {synthesis.#Extension (symbol <extension>) (list (synthesis.i64 param)
- (synthesis.i64 subject))}
- (run (..safe <extension>))
- (pipe.when
- {try.#Success valueT}
- (n.= (<reference> param subject) (as Nat valueT))
-
- {try.#Failure _}
- false)
- (let [param <param_expr>])))]
-
- [.i64_and# i64.and param]
- [.i64_or# i64.or param]
- [.i64_xor# i64.xor param]
- [.i64_left# i64.left_shifted (n.% 64 param)]
- ["lux i64 logical-right-shift" i64.logic_right_shifted (n.% 64 param)]
- )]
- (all _.and
- <binary>
- (_.test "lux i64 arithmetic-right-shift"
- (|> {synthesis.#Extension "lux i64 arithmetic-right-shift"
- (list (synthesis.i64 subject)
- (synthesis.i64 param))}
- (run (..safe "lux i64 arithmetic-right-shift"))
- (pipe.when
- {try.#Success valueT}
- (.i64_=# (i64.arithmetic_right_shifted 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.only (|>> (.i64_=# 0) not)))
- subject r.i64]
- (`` (all _.and
- (,, (with_template [<extension> <type> <prepare> <comp> <subject_expr>]
- [(_.test <extension>
- (|> {synthesis.#Extension (symbol <extension>) (list (synthesis.i64 subject))}
- (run (..safe <extension>))
- (pipe.when
- {try.#Success valueT}
- (<comp> (<prepare> subject) (as <type> valueT))
-
- {try.#Failure _}
- false)
- (let [subject <subject_expr>])))]
-
- [.int_f64# Frac i.frac f.= subject]
- [.int_char# Text (|>> (as Nat) text.from_code) text#= (|> subject
- (as Nat)
- (n.% (i64.left_shifted 8 1))
- (as Int))]
- ))
- (,, (with_template [<extension> <reference> <outputT> <comp>]
- [(_.test <extension>
- (|> {synthesis.#Extension (symbol <extension>) (list (synthesis.i64 param)
- (synthesis.i64 subject))}
- (run (..safe <extension>))
- (pipe.when
- {try.#Success valueT}
- (<comp> (<reference> param subject) (as <outputT> valueT))
-
- {try.#Failure _}
- false)))]
-
- [.i64_+# i.+ Int i.=]
- [.i64_-# i.- Int i.=]
- [.i64_=# i.= Bit bit#=]
-
- [.int_<# i.< Bit bit#=]
- [.int_*# i.* Int i.=]
- [.int_/# i./ Int i.=]
- [.int_%# i.% Int i.=]
- ))
- ))))
-
-(def simple_frac
- (Random Frac)
- (|> r.nat (of r.monad each (|>> (n.% 1000) .int i.frac))))
-
-(def (f64 run)
- (-> Runner Test)
- (do r.monad
- [param (|> ..simple_frac (r.only (|>> (f.= +0.0) not)))
- subject ..simple_frac]
- (`` (all _.and
- (,, (with_template [<extension> <reference> <comp>]
- [(_.test <extension>
- (|> {synthesis.#Extension (symbol <extension>) (list (synthesis.f64 param)
- (synthesis.f64 subject))}
- (run (..safe <extension>))
- (//when.verify (<reference> param subject))))]
-
- [.f64_+# f.+ f.=]
- [.f64_-# f.- f.=]
- [.f64_*# f.* f.=]
- [.f64_/# f./ f.=]
- [.f64_%# f.% f.=]
- ))
- (,, (with_template [<extension> <text>]
- [(_.test <extension>
- (|> {synthesis.#Extension (symbol <extension>) (list (synthesis.f64 param)
- (synthesis.f64 subject))}
- (run (..safe <extension>))
- (pipe.when
- {try.#Success valueV}
- (bit#= (<text> param subject)
- (as Bit valueV))
-
- _
- false)))]
-
- [.f64_=# f.=]
- [.f64_<# f.<]
- ))
- (_.test ".f64_int# && .int_f64#"
- (|> (run (..safe .f64_int#)
- (|> subject synthesis.f64
- (list) {synthesis.#Extension (symbol .f64_int#)}
- (list) {synthesis.#Extension (symbol .int_f64#)}))
- (//when.verify subject)))
- ))))
-
-(def (text run)
- (-> Runner Test)
- (do [! r.monad]
- [sample_size (|> r.nat (of ! each (|>> (n.% 10) (n.max 1))))
- sample_lower (r.lower_case_alpha sample_size)
- sample_upper (r.upper_case_alpha sample_size)
- sample_alpha (|> (r.alphabetic sample_size)
- (r.only (|>> (text#= sample_upper) not)))
- char_idx (|> r.nat (of ! each (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 (symbol .text_composite#) (list sample_lowerS sample_upperS)}
- pre_rep_once (format sample_lower sample_upper)
- post_rep_once (format sample_lower sample_alpha)
- pre_rep_all (|> sample_lower (list.repeated sample_size) (text.interposed sample_upper))
- post_rep_all (|> sample_lower (list.repeated sample_size) (text.interposed sample_alpha))]]
- (all _.and
- (_.test "Can compare texts for equality."
- (and (|> {synthesis.#Extension (symbol .text_=#) (list sample_lowerS sample_lowerS)}
- (run (..safe .text_=#))
- (pipe.when
- {try.#Success valueV}
- (as Bit valueV)
-
- _
- false))
- (|> {synthesis.#Extension (symbol .text_=#) (list sample_upperS sample_lowerS)}
- (run (..safe .text_=#))
- (pipe.when
- {try.#Success valueV}
- (not (as Bit valueV))
-
- _
- false))))
- (_.test "Can compare texts for order."
- (|> {synthesis.#Extension (symbol .text_<#) (list sample_lowerS sample_upperS)}
- (run (..safe .text_<#))
- (pipe.when
- {try.#Success valueV}
- (as Bit valueV)
-
- {try.#Failure _}
- false)))
- (_.test "Can get length of text."
- (|> {synthesis.#Extension (symbol .text_size#) (list sample_lowerS)}
- (run (..safe .text_size#))
- (pipe.when
- {try.#Success valueV}
- (n.= sample_size (as Nat valueV))
-
- _
- false)))
- (_.test "Can concatenate text."
- (|> {synthesis.#Extension (symbol .text_size#) (list concatenatedS)}
- (run (..safe .text_size#))
- (pipe.when
- {try.#Success valueV}
- (n.= (n.* 2 sample_size) (as Nat valueV))
-
- _
- false)))
- (_.test "Can find index of sub-text."
- (and (|> {synthesis.#Extension (symbol .text_index#)
- (list concatenatedS sample_lowerS
- (synthesis.i64 +0))}
- (run (..safe .text_index#))
- (pipe.when
- (^.multi {try.#Success valueV}
- [(as (Maybe Nat) valueV)
- {.#Some valueV}])
- (n.= 0 valueV)
-
- _
- false))
- (|> {synthesis.#Extension (symbol .text_index#)
- (list concatenatedS sample_upperS
- (synthesis.i64 +0))}
- (run (..safe .text_index#))
- (pipe.when
- (^.multi {try.#Success valueV}
- [(as (Maybe Nat) valueV)
- {.#Some valueV}])
- (n.= sample_size valueV)
-
- _
- false))))
- (let [test_clip (is (-> (I64 Any) (I64 Any) Text Bit)
- (function (_ offset length expected)
- (|> {synthesis.#Extension (symbol .text_clip#)
- (list concatenatedS
- (synthesis.i64 offset)
- (synthesis.i64 length))}
- (run (..safe .text_clip#))
- (pipe.when
- (^.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 (symbol .text_char#)
- (list sample_lowerS
- (synthesis.i64 char_idx))}
- (run (..safe .text_char#))
- (pipe.when
- (^.multi {try.#Success valueV}
- [(as (Maybe Int) valueV)
- {.#Some valueV}])
- (text.contains? (.int_char# valueV)
- sample_lower)
-
- _
- false)))
- )))
-
-(def (io run)
- (-> Runner Test)
- (do r.monad
- [message (r.alphabetic 5)]
- (all _.and
- (_.test "Can log messages."
- (|> {synthesis.#Extension .log!#
- (list (synthesis.text (format "LOG: " message)))}
- (run (..safe .log!#))
- (pipe.when
- {try.#Success valueV}
- true
-
- {try.#Failure _}
- false)))
- (_.test "Can throw runtime errors."
- (and (|> {synthesis.#Extension .try#
- (list (synthesis.function/abstraction
- [synthesis.#environment (list)
- synthesis.#arity 1
- synthesis.#body {synthesis.#Extension (symbol .error#)
- (list (synthesis.text message))}]))}
- (run (..safe .try#))
- (pipe.when
- (^.multi {try.#Success valueV}
- [(as (Try Text) valueV)
- {try.#Failure error}])
- (text.contains? message error)
-
- _
- false))
- (|> {synthesis.#Extension .try#
- (list (synthesis.function/abstraction
- [synthesis.#environment (list)
- synthesis.#arity 1
- synthesis.#body (synthesis.text message)]))}
- (run (..safe .try#))
- (pipe.when
- (^.multi {try.#Success valueV}
- [(as (Try Text) valueV)
- {try.#Success valueV}])
- (text#= message valueV)
-
- _
- false))))
- )))
-
-(def .public (spec runner)
- (-> Runner Test)
- (all _.and
- (..bit runner)
- (..i64 runner)
- (..f64 runner)
- (..text runner)
- (..io runner)
- ))
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-29 01:50:09 +0000