aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/spec/compositor/analysis/type.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/spec/compositor/analysis/type.lux')
-rw-r--r--stdlib/source/spec/compositor/analysis/type.lux63
1 files changed, 0 insertions, 63 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))
- )))