aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/spec/compositor
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/spec/compositor')
-rw-r--r--stdlib/source/spec/compositor/analysis/type.lux63
-rw-r--r--stdlib/source/spec/compositor/common.lux81
-rw-r--r--stdlib/source/spec/compositor/generation/case.lux288
-rw-r--r--stdlib/source/spec/compositor/generation/common.lux343
-rw-r--r--stdlib/source/spec/compositor/generation/function.lux93
-rw-r--r--stdlib/source/spec/compositor/generation/primitive.lux48
-rw-r--r--stdlib/source/spec/compositor/generation/reference.lux60
-rw-r--r--stdlib/source/spec/compositor/generation/structure.lux89
8 files changed, 0 insertions, 1065 deletions
diff --git a/stdlib/source/spec/compositor/analysis/type.lux b/stdlib/source/spec/compositor/analysis/type.lux
deleted file mode 100644
index 7cbd5884b..000000000
--- a/stdlib/source/spec/compositor/analysis/type.lux
+++ /dev/null
@@ -1,63 +0,0 @@
-(.module:
- [lux #*
- ["_" test (#+ Test)]
- [abstract
- [monad (#+ do)]]
- [control
- [pipe (#+ case>)]
- ["." io]
- ["." try]]
- [math
- ["r" random (#+ Random)]]
- [macro
- ["." code]]
- [tool
- [compiler
- [analysis (#+ State+)]
- ["." phase
- [macro (#+ Expander)]
- ["." analysis
- ["#/." scope]
- ["#/." type]]]]]])
-
-(def: (check-success+ expander state extension params output-type)
- (-> Expander State+ Text (List Code) Type Bit)
- (|> (analysis/scope.with-scope ""
- (analysis/type.with-type output-type
- (analysis.phase expander (` ((~ (code.text extension)) (~+ params))))))
- (phase.run state)
- (case> (#try.Success _)
- true
-
- (#try.Failure _)
- false)))
-
-(def: check
- (Random [Code Type Code])
- (`` ($_ r.either
- (~~ (template [<random> <type> <code>]
- [(do r.monad
- [value <random>]
- (wrap [(` <type>)
- <type>
- (<code> value)]))]
-
- [r.bit (0 #0 "#Bit" (0 #0)) code.bit]
- [r.nat (0 #0 "#I64" (0 #1 (0 #0 "#Nat" (0 #0)) (0 #0))) code.nat]
- [r.int (0 #0 "#I64" (0 #1 (0 #0 "#Int" (0 #0)) (0 #0))) code.int]
- [r.rev (0 #0 "#I64" (0 #1 (0 #0 "#Rev" (0 #0)) (0 #0))) code.rev]
- [r.safe-frac (0 #0 "#Frac" (0 #0)) code.frac]
- [(r.ascii/upper-alpha 5) (0 #0 "#Text" (0 #0)) code.text]
- )))))
-
-(def: #export (spec expander state)
- (-> Expander State+ Test)
- (do r.monad
- [[typeC exprT exprC] ..check
- [other-typeC other-exprT other-exprC] ..check]
- ($_ _.and
- (_.test "lux check"
- (check-success+ expander state "lux check" (list typeC exprC) exprT))
- (_.test "lux coerce"
- (check-success+ expander state "lux coerce" (list typeC other-exprC) exprT))
- )))
diff --git a/stdlib/source/spec/compositor/common.lux b/stdlib/source/spec/compositor/common.lux
deleted file mode 100644
index ed3b53f30..000000000
--- a/stdlib/source/spec/compositor/common.lux
+++ /dev/null
@@ -1,81 +0,0 @@
-(.module:
- [lux #*
- [abstract
- [monad (#+ do)]]
- [control
- ["." io (#+ IO)]
- ["." try (#+ Try)]]
- [tool
- [compiler
- ["." reference]
- ["." analysis]
- ["." synthesis (#+ Synthesis)]
- ["." directive]
- ["." phase
- ["." macro (#+ Expander)]
- ["." generation (#+ Operation)]
- [extension (#+ Extender)
- ["." bundle]]]
- [default
- ["." platform (#+ Platform)]]]]])
-
-(type: #export Runner
- (-> Text Synthesis (Try Any)))
-
-(type: #export Definer
- (-> Name Synthesis (Try Any)))
-
-(type: #export (Instancer what)
- (All [anchor expression directive]
- (-> (Platform IO anchor expression directive)
- (generation.State+ anchor expression directive)
- what)))
-
-(def: (runner (^slots [#platform.runtime #platform.phase #platform.host]) state)
- (Instancer Runner)
- (function (_ evaluation-name expressionS)
- (do try.monad
- [expressionG (<| (phase.run state)
- generation.with-buffer
- (do phase.monad
- [_ runtime]
- (phase expressionS)))]
- (\ host evaluate! evaluation-name expressionG))))
-
-(def: (definer (^slots [#platform.runtime #platform.phase #platform.host])
- state)
- (Instancer Definer)
- (function (_ lux-name expressionS)
- (do try.monad
- [definitionG (<| (phase.run state)
- generation.with-buffer
- (do phase.monad
- [_ runtime
- expressionG (phase expressionS)
- [host-name host-value host-directive] (generation.define! lux-name expressionG)
- _ (generation.learn lux-name host-name)]
- (phase (synthesis.constant lux-name))))]
- (\ host evaluate! "definer" definitionG))))
-
-(def: #export (executors target expander platform
- analysis-bundle generation-bundle directive-bundle
- program extender)
- (All [anchor expression directive]
- (-> Text Expander (Platform IO anchor expression directive)
- analysis.Bundle
- (generation.Bundle anchor expression directive)
- (directive.Bundle anchor expression directive)
- (-> expression directive) Extender
- (IO (Try [(directive.State+ anchor expression directive)
- Runner
- Definer]))))
- (do io.monad
- [?state (platform.initialize target expander analysis-bundle platform generation-bundle directive-bundle program extender)]
- (wrap (do try.monad
- [[directive-bundle directive-state] ?state
- #let [generation-state (get@ [#directive.generation
- #directive.state]
- directive-state)]]
- (wrap [[directive-bundle directive-state]
- (..runner platform generation-state)
- (..definer platform generation-state)])))))
diff --git a/stdlib/source/spec/compositor/generation/case.lux b/stdlib/source/spec/compositor/generation/case.lux
deleted file mode 100644
index 2424aa330..000000000
--- a/stdlib/source/spec/compositor/generation/case.lux
+++ /dev/null
@@ -1,288 +0,0 @@
-(.module:
- [lux (#- case)
- ["_" test (#+ Test)]
- [abstract
- [monad (#+ do)]]
- [control
- [pipe (#+ case>)]
- ["." try (#+ Try)]]
- [data
- ["." text ("#\." equivalence)
- ["%" format (#+ format)]]
- [number
- ["n" nat]
- ["f" frac]]
- [collection
- ["." list ("#\." fold)]]]
- [math
- ["r" random (#+ Random)]]
- [tool
- [compiler
- ["." reference]
- ["." analysis]
- ["." synthesis (#+ Path Synthesis)]
- ["." phase
- ["#/." synthesis
- ["." case]]
- ["." extension/synthesis]]]]]
- [///
- [common (#+ Runner)]])
-
-(def: limit Nat 10)
-
-(def: size
- (Random Nat)
- (|> r.nat (\ r.monad map (|>> (n.% ..limit) (n.max 2)))))
-
-(def: (tail? size idx)
- (-> Nat Nat Bit)
- (n.= (dec size) idx))
-
-(def: #export (verify expected)
- (-> Frac (Try Any) Bit)
- (|>> (case> (#try.Success actual)
- (f.= expected (:as Frac actual))
-
- (#try.Failure _)
- false)))
-
-(def: case
- (Random [Synthesis Path])
- (<| r.rec (function (_ case))
- (`` ($_ r.either
- (do r.monad
- [value r.i64]
- (wrap [(synthesis.i64 value)
- synthesis.path/pop]))
- (~~ (template [<gen> <synth> <path>]
- [(do r.monad
- [value <gen>]
- (wrap [(<synth> value)
- (<path> value)]))]
-
- [r.bit synthesis.bit synthesis.path/bit]
- [r.i64 synthesis.i64 synthesis.path/i64]
- [r.frac synthesis.f64 synthesis.path/f64]
- [(r.unicode 5) synthesis.text synthesis.path/text]))
- (do {! r.monad}
- [size ..size
- idx (|> r.nat (\ ! map (n.% size)))
- [subS subP] case
- #let [unitS (synthesis.text synthesis.unit)
- caseS (synthesis.tuple
- (list.concat (list (list.repeat idx unitS)
- (list subS)
- (list.repeat (|> size dec (n.- idx)) unitS))))
- caseP ($_ synthesis.path/seq
- (if (tail? size idx)
- (synthesis.member/right idx)
- (synthesis.member/left idx))
- subP)]]
- (wrap [caseS caseP]))
- (do {! r.monad}
- [size ..size
- idx (|> r.nat (\ ! map (n.% size)))
- [subS subP] case
- #let [right? (tail? size idx)
- caseS (synthesis.variant
- {#analysis.lefts idx
- #analysis.right? right?
- #analysis.value subS})
- caseP ($_ synthesis.path/seq
- (if right?
- (synthesis.side/right idx)
- (synthesis.side/left idx))
- subP)]]
- (wrap [caseS caseP]))
- ))))
-
-(def: (let-spec run)
- (-> Runner Test)
- (do r.monad
- [value r.safe-frac]
- (_.test (%.name (name-of synthesis.branch/let))
- (|> (synthesis.branch/let [(synthesis.f64 value)
- 0
- (synthesis.variable/local 0)])
- (run "let-spec")
- (verify value)))))
-
-(def: (if-spec run)
- (-> Runner Test)
- (do r.monad
- [on-true r.safe-frac
- on-false (|> r.safe-frac (r.filter (|>> (f.= on-true) not)))
- verdict r.bit]
- (_.test (%.name (name-of synthesis.branch/if))
- (|> (synthesis.branch/if [(synthesis.bit verdict)
- (synthesis.f64 on-true)
- (synthesis.f64 on-false)])
- (run "if-spec")
- (verify (if verdict on-true on-false))))))
-
-(def: (case-spec run)
- (-> Runner Test)
- (do r.monad
- [[inputS pathS] ..case
- on-success r.safe-frac
- on-failure (|> r.safe-frac (r.filter (|>> (f.= on-success) not)))]
- (_.test (%.name (name-of synthesis.branch/case))
- (|> (synthesis.branch/case
- [inputS
- ($_ synthesis.path/alt
- ($_ synthesis.path/seq
- pathS
- (synthesis.path/then (synthesis.f64 on-success)))
- (synthesis.path/then (synthesis.f64 on-failure)))])
- (run "case-spec")
- (verify on-success)))))
-
-(def: special-input
- Synthesis
- (let [_cursor_ (: Synthesis
- (synthesis.tuple (list (synthesis.text .prelude_module)
- (synthesis.i64 +901)
- (synthesis.i64 +13))))
- _code_ (: (-> Synthesis Synthesis)
- (function (_ content)
- (synthesis.tuple (list _cursor_ content))))
- _nil_ (: Synthesis
- (synthesis.variant [0 #0 (synthesis.text "")]))
- _cons_ (: (-> Synthesis Synthesis Synthesis)
- (function (_ head tail)
- (synthesis.variant [0 #1 (synthesis.tuple (list head tail))])))
- _list_ (: (-> (List Synthesis) Synthesis)
- (list\fold _cons_ _nil_))]
- (let [__tuple__ (: (-> (List Synthesis) Synthesis)
- (|>> list.reverse _list_ [9 #0] synthesis.variant _code_))
- __form__ (: (-> (List Synthesis) Synthesis)
- (|>> list.reverse _list_ [8 #0] synthesis.variant _code_))
- __text__ (: (-> Text Synthesis)
- (function (_ value)
- (_code_ (synthesis.variant [5 #0 (synthesis.text value)]))))
- __identifier__ (: (-> Name Synthesis)
- (function (_ [module short])
- (_code_ (synthesis.variant [6 #0 (synthesis.tuple (list (synthesis.text module)
- (synthesis.text short)))]))))
- __tag__ (: (-> Name Synthesis)
- (function (_ [module short])
- (_code_ (synthesis.variant [7 #0 (synthesis.tuple (list (synthesis.text module)
- (synthesis.text short)))]))))
- __list__ (: (-> (List Synthesis) Synthesis)
- (list\fold (function (_ head tail)
- (__form__ (list (__tag__ ["" "Cons"]) head tail)))
- (__tag__ ["" "Nil"])))
- __apply__ (: (-> Synthesis Synthesis Synthesis)
- (function (_ func arg)
- (__form__ (list func arg))))]
- (|> _nil_
- (_cons_ (__apply__ (__identifier__ ["" "form$"])
- (__list__ (list (__apply__ (__identifier__ ["" "tag$"])
- (__tuple__ (list (__text__ .prelude_module)
- (__text__ "Cons"))))
- (__identifier__ ["" "export?-meta"])
- (__identifier__ ["" "tail"])))))
- (_cons_ (__tuple__ (list (__identifier__ ["" "tail"]))))
- ))))
-
-(def: special-path
- Path
- (let [_nil_ (synthesis.path/side (#.Left 0))
- _cons_ (synthesis.path/side (#.Right 0))
- _head_ (synthesis.path/member (#.Left 0))
- _tail_ (synthesis.path/member (#.Right 0))
- _tuple_ (synthesis.path/side (#.Left 9))]
- ($_ synthesis.path/alt
- ($_ synthesis.path/seq
- _cons_
- _head_
- _head_ (synthesis.path/bind 2) synthesis.path/pop
- _tail_ _tuple_ _cons_
- _head_ (synthesis.path/bind 3) synthesis.path/pop
- _tail_ (synthesis.path/bind 4) synthesis.path/pop
- synthesis.path/pop synthesis.path/pop synthesis.path/pop synthesis.path/pop
- _tail_ _cons_
- _head_ (synthesis.path/bind 5) synthesis.path/pop
- _tail_ _nil_
- ## THEN
- (synthesis.path/then (synthesis.bit #1)))
- ($_ synthesis.path/seq
- (synthesis.path/bind 2)
- ## THEN
- (synthesis.path/then (synthesis.bit #0))))))
-
-(def: special-pattern
- analysis.Pattern
- (let [## [_ (#Tuple (#Cons arg args'))]
- head (<| analysis.pattern/tuple (list (analysis.pattern/bind 2))
- analysis.pattern/variant [9 #0]
- analysis.pattern/variant [0 #1]
- analysis.pattern/tuple (list (analysis.pattern/bind 3)
- (analysis.pattern/bind 4)))
- ## (#Cons body #Nil)
- tail (<| analysis.pattern/variant [0 #1]
- analysis.pattern/tuple (list (analysis.pattern/bind 5))
- analysis.pattern/variant [0 #0]
- (analysis.pattern/unit))]
- ## (#Cons <head> <tail>)
- (<| analysis.pattern/variant [0 #1]
- (analysis.pattern/tuple (list head tail)))))
-
-(def: special-pattern-path
- Path
- ($_ synthesis.path/alt
- (<| try.assume
- (phase.run [extension/synthesis.bundle
- synthesis.init])
- (case.path phase/synthesis.phase
- special-pattern)
- (analysis.bit #1))
- ($_ synthesis.path/seq
- (synthesis.path/bind 2)
- ## THEN
- (synthesis.path/then (synthesis.bit #0)))))
-
-## TODO: Get rid of this ASAP
-(def: (special-spec run)
- (-> Runner Test)
- ($_ _.and
- (_.test "==="
- (and (text\= (synthesis.%path special-path)
- (synthesis.%path special-pattern-path))
- (\ synthesis.path-equivalence = special-path special-pattern-path)))
- (_.test "CODE"
- (|> special-input
- (run "special-input")
- (case> (#try.Success output)
- true
-
- (#try.Failure _)
- false)))
- (_.test "PATTERN-MATCHING 0"
- (|> (synthesis.branch/case [special-input
- special-path])
- (run "special-path")
- (case> (#try.Success output)
- true
-
- (#try.Failure _)
- false)))
- (_.test "PATTERN-MATCHING 1"
- (|> (synthesis.branch/case [special-input
- special-pattern-path])
- (run "special-pattern-path")
- (case> (#try.Success output)
- true
-
- (#try.Failure _)
- false)))
- ))
-
-(def: #export (spec run)
- (-> Runner Test)
- ($_ _.and
- (..special-spec run)
- (..let-spec run)
- (..if-spec run)
- (..case-spec run)
- ))
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)
- ))
diff --git a/stdlib/source/spec/compositor/generation/function.lux b/stdlib/source/spec/compositor/generation/function.lux
deleted file mode 100644
index 6d0f8d541..000000000
--- a/stdlib/source/spec/compositor/generation/function.lux
+++ /dev/null
@@ -1,93 +0,0 @@
-(.module:
- [lux (#- function)
- ["_" test (#+ Test)]
- [abstract
- [monad (#+ do)]
- ["." enum]]
- [control
- [pipe (#+ case>)]]
- [data
- ["." maybe]
- [number
- ["n" nat]]
- [collection
- ["." list ("#\." functor)]]]
- [math
- ["r" random (#+ Random) ("#\." monad)]]
- [tool
- [compiler
- [analysis (#+ Arity)]
- ["." reference (#+ Register)]
- ["." synthesis (#+ Synthesis)]]]]
- ["." // #_
- ["#." case]
- [//
- [common (#+ Runner)]]])
-
-(def: max-arity Arity 10)
-
-(def: arity
- (Random Arity)
- (|> r.nat (r\map (|>> (n.% max-arity) (n.max 1)))))
-
-(def: (local arity)
- (-> Arity (Random Register))
- (|> r.nat (r\map (|>> (n.% arity) inc))))
-
-(def: function
- (Random [Arity Register Synthesis])
- (do r.monad
- [arity ..arity
- local (..local arity)]
- (wrap [arity local
- (synthesis.function/abstraction
- {#synthesis.environment (list)
- #synthesis.arity arity
- #synthesis.body (synthesis.variable/local local)})])))
-
-(def: #export (spec run)
- (-> Runner Test)
- (do {! r.monad}
- [[arity local functionS] ..function
- partial-arity (|> r.nat (\ ! map (|>> (n.% arity) (n.max 1))))
- inputs (r.list arity r.safe-frac)
- #let [expectation (maybe.assume (list.nth (dec local) inputs))
- inputsS (list\map (|>> synthesis.f64) inputs)]]
- ($_ _.and
- (_.test "Can read arguments."
- (|> (synthesis.function/apply {#synthesis.function functionS
- #synthesis.arguments inputsS})
- (run "with-local")
- (//case.verify expectation)))
- (_.test "Can partially apply functions."
- (or (n.= 1 arity)
- (let [preS (list.take partial-arity inputsS)
- postS (list.drop partial-arity inputsS)
- partialS (synthesis.function/apply {#synthesis.function functionS
- #synthesis.arguments preS})]
- (|> (synthesis.function/apply {#synthesis.function partialS
- #synthesis.arguments postS})
- (run "partial-application")
- (//case.verify expectation)))))
- (_.test "Can read environment."
- (or (n.= 1 arity)
- (let [environment (|> partial-arity
- (enum.range n.enum 1)
- (list\map (|>> #reference.Local)))
- variableS (if (n.<= partial-arity local)
- (synthesis.variable/foreign (dec local))
- (synthesis.variable/local (|> local (n.- partial-arity))))
- inner-arity (n.- partial-arity arity)
- innerS (synthesis.function/abstraction
- {#synthesis.environment environment
- #synthesis.arity inner-arity
- #synthesis.body variableS})
- outerS (synthesis.function/abstraction
- {#synthesis.environment (list)
- #synthesis.arity partial-arity
- #synthesis.body innerS})]
- (|> (synthesis.function/apply {#synthesis.function outerS
- #synthesis.arguments inputsS})
- (run "with-foreign")
- (//case.verify expectation)))))
- )))
diff --git a/stdlib/source/spec/compositor/generation/primitive.lux b/stdlib/source/spec/compositor/generation/primitive.lux
deleted file mode 100644
index 3b6dd657b..000000000
--- a/stdlib/source/spec/compositor/generation/primitive.lux
+++ /dev/null
@@ -1,48 +0,0 @@
-(.module:
- [lux #*
- ["_" test (#+ Test)]
- [abstract
- [monad (#+ do)]]
- [control
- [pipe (#+ case>)]
- ["." try]]
- [data
- ["." bit ("#\." equivalence)]
- [number
- ["f" frac]]
- ["." text ("#\." equivalence)
- ["%" format (#+ format)]]]
- [math
- ["r" random]]
- [tool
- [compiler
- ["." synthesis]]]]
- [///
- [common (#+ Runner)]])
-
-(def: (f/=' reference subject)
- (-> Frac Frac Bit)
- (or (f.= reference subject)
- (and (f.not-a-number? reference)
- (f.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> (#try.Success actual)
- (<test> expected (:assume actual))
-
- (#try.Failure _)
- 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/reference.lux b/stdlib/source/spec/compositor/generation/reference.lux
deleted file mode 100644
index 665175ab4..000000000
--- a/stdlib/source/spec/compositor/generation/reference.lux
+++ /dev/null
@@ -1,60 +0,0 @@
-(.module:
- [lux #*
- ["_" test (#+ Test)]
- [abstract
- [monad (#+ do)]]
- [control
- [pipe (#+ case>)]
- ["." try]]
- [data
- [number
- ["n" nat]
- ["f" frac]]]
- [tool
- [compiler
- ["." reference]
- ["." synthesis]]]
- [math
- ["r" random (#+ Random)]]]
- [///
- [common (#+ Runner Definer)]])
-
-(def: name
- (Random Name)
- (let [name-part (r.ascii/upper-alpha 5)]
- [(r.and name-part name-part)]))
-
-(def: (definition define)
- (-> Definer Test)
- (do r.monad
- [name ..name
- expected r.safe-frac]
- (_.test "Definitions."
- (|> (define name (synthesis.f64 expected))
- (case> (#try.Success actual)
- (f.= expected (:as Frac actual))
-
- (#try.Failure _)
- false)))))
-
-(def: (variable run)
- (-> Runner Test)
- (do {! r.monad}
- [register (|> r.nat (\ ! map (n.% 100)))
- expected r.safe-frac]
- (_.test "Local variables."
- (|> (synthesis.branch/let [(synthesis.f64 expected)
- register
- (synthesis.variable/local register)])
- (run "variable")
- (case> (#try.Success actual)
- (f.= expected (:as Frac actual))
-
- (#try.Failure _)
- false)))))
-
-(def: #export (spec runner definer)
- (-> Runner Definer Test)
- ($_ _.and
- (..definition definer)
- (..variable runner)))
diff --git a/stdlib/source/spec/compositor/generation/structure.lux b/stdlib/source/spec/compositor/generation/structure.lux
deleted file mode 100644
index 7c45d2a9b..000000000
--- a/stdlib/source/spec/compositor/generation/structure.lux
+++ /dev/null
@@ -1,89 +0,0 @@
-(.module:
- [lux #*
- ["_" test (#+ Test)]
- [abstract
- [monad (#+ do)]]
- [control
- [pipe (#+ case>)]
- ["." try]]
- [data
- ["." maybe]
- [number
- ["n" nat]
- ["i" int]]
- ["." text ("#\." equivalence)
- ["%" format (#+ format)]]
- [collection
- ["." array (#+ Array)]
- ["." list ("#\." functor)]]]
- [math
- ["r" random]]
- ["." ffi (#+ import:)]
- [tool
- [compiler
- ["." analysis]
- ["." synthesis]]]]
- [///
- [common (#+ Runner)]])
-
-(import: 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> (#try.Success valueT)
- (let [valueT (:as (Array Any) valueT)]
- (and (n.= 3 (array.size valueT))
- (let [tag-out (:as java/lang/Integer (maybe.assume (array.read 0 valueT)))
- last?-out (array.read 1 valueT)
- value-out (:as Any (maybe.assume (array.read 2 valueT)))
- same-tag? (|> tag-out ffi.int-to-long (:as Nat) (n.= tag-in))
- same-flag? (case last?-out
- (#.Some last?-out')
- (and last?-in (text\= "" (:as Text last?-out')))
-
- #.None
- (not last?-in))
- same-value? (|> value-out (:as Int) (i.= value-in))]
- (and same-tag?
- same-flag?
- same-value?))))
-
- (#try.Failure _)
- 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> (#try.Success tuple-out)
- (let [tuple-out (:as (Array Any) tuple-out)]
- (and (n.= size (array.size tuple-out))
- (list.every? (function (_ [left right])
- (i.= left (:as Int right)))
- (list.zip/2 tuple-in (array.to-list tuple-out)))))
-
- (#try.Failure _)
- false)))))
-
-(def: #export (spec runner)
- (-> Runner Test)
- ($_ _.and
- (..variant runner)
- (..tuple runner)
- ))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 05:27:23 +0000