aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lux-mode/lux-mode.el4
-rw-r--r--stdlib/source/lux/type/dynamic.lux39
-rw-r--r--stdlib/test/test/lux/type/dynamic.lux31
-rw-r--r--stdlib/test/tests.lux144
4 files changed, 145 insertions, 73 deletions
diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el
index 1babb75fe..8825438c7 100644
--- a/lux-mode/lux-mode.el
+++ b/lux-mode/lux-mode.el
@@ -249,6 +249,7 @@ Called by `imenu--generic-function'."
(type//abstract (altRE "abstract:" ":abstraction" ":representation" ":transmutation" "\\^:representation"))
(type//unit (altRE "unit:" "scale:"))
(type//poly (altRE "poly:" "derived:"))
+ (type//dynamic (altRE ":dynamic" ":check"))
;; Data
(data//record (altRE "get@" "set@" "update@"))
(data//signature (altRE "signature:" "structure:" "open:" "structure" "::"))
@@ -273,7 +274,8 @@ Called by `imenu--generic-function'."
type//checking
type//abstract
type//unit
- type//poly))
+ type//poly
+ type//dynamic))
(data (altRE data//record
data//signature
data//implicit
diff --git a/stdlib/source/lux/type/dynamic.lux b/stdlib/source/lux/type/dynamic.lux
new file mode 100644
index 000000000..d57669213
--- /dev/null
+++ b/stdlib/source/lux/type/dynamic.lux
@@ -0,0 +1,39 @@
+(.module:
+ [lux #*
+ [control
+ ["ex" exception (#+ exception:)]]
+ [data
+ ["." error]
+ [text
+ format]]
+ [macro (#+ with-gensyms)
+ ["." syntax (#+ syntax:)]]
+ ["." type
+ abstract]])
+
+(exception: #export (wrong-type {expected Type} {actual Type})
+ (ex.report ["Expected" (%type expected)]
+ ["Actual" (%type actual)]))
+
+(abstract: #export Dynamic
+ {}
+
+ [Type Any]
+
+ (def: dynamic-abstraction (-> [Type Any] Dynamic) (|>> :abstraction))
+ (def: dynamic-representation (-> Dynamic [Type Any]) (|>> :representation))
+
+ (syntax: #export (:dynamic value)
+ (with-gensyms [g!value]
+ (wrap (list (` (let [(~ g!value) (~ value)]
+ ((~! ..dynamic-abstraction) [(:of (~ g!value)) (~ g!value)])))))))
+
+ (syntax: #export (:check type value)
+ (with-gensyms [g!type g!value]
+ (wrap (list (` (let [[(~ g!type) (~ g!value)] ((~! ..dynamic-representation) (~ value))]
+ (: ((~! error.Error) (~ type))
+ (if (:: (~! type.Equivalence<Type>) (~' =)
+ (.type (~ type)) (~ g!type))
+ (#error.Success (:coerce (~ type) (~ g!value)))
+ ((~! ex.throw) ..wrong-type [(.type (~ type)) (~ g!type)])))))))))
+ )
diff --git a/stdlib/test/test/lux/type/dynamic.lux b/stdlib/test/test/lux/type/dynamic.lux
new file mode 100644
index 000000000..70e26f743
--- /dev/null
+++ b/stdlib/test/test/lux/type/dynamic.lux
@@ -0,0 +1,31 @@
+(.module:
+ [lux #*
+ [control
+ [monad (#+ do)]]
+ [data
+ ["." error]]
+ [math
+ ["r" random]]
+ [type
+ ["/" dynamic (#+ Dynamic :dynamic :check)]]]
+ lux/test)
+
+(context: "Dynamic typing."
+ (do @
+ [expected r.nat
+ #let [value (:dynamic expected)]]
+ ($_ seq
+ (test "Can check dynamic values."
+ (case (:check Nat value)
+ (#error.Success actual)
+ (n/= expected actual)
+
+ (#error.Failure error)
+ false))
+ (test "Cannot confuse types."
+ (case (:check Text value)
+ (#error.Success actual)
+ false
+
+ (#error.Failure error)
+ true)))))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index fa5eb2f67..a5c6919c5 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -81,94 +81,94 @@
]
## TODO: Must have 100% coverage on tests.
[test
- ## ["_." lux]
+ ## [lux (#+)]
[lux
- ## ["_." cli]
- ## ["_." host]
+ ## [cli (#+)]
+ ## [host (#+)]
[host
[jvm (#+)]]
- ## ["_." io]
+ ## [io (#+)]
## [time
- ## ["_." instant]
- ## ["_." duration]
- ## ["_." date]]
+ ## [instant (#+)]
+ ## [duration (#+)]
+ ## [date (#+)]]
## [control
- ## ## ["_." exception]
- ## ## ["_." interval]
- ## ## ["_." pipe]
- ## ## ["_." continuation]
- ## ## ["_." reader]
- ## ## ["_." writer]
- ## ## ["_." state]
- ## ## ["_." parser]
- ## ## ["_." thread]
- ## ## ["_." region]
+ ## ## [exception (#+)]
+ ## ## [interval (#+)]
+ ## ## [pipe (#+)]
+ ## ## [continuation (#+)]
+ ## ## [reader (#+)]
+ ## ## [writer (#+)]
+ ## ## [state (#+)]
+ ## ## [parser (#+)]
+ ## ## [thread (#+)]
+ ## ## [region (#+)]
## ## [security
- ## ## ["_." privacy]
- ## ## ["._" integrity]]
+ ## ## [privacy (#+)]
+ ## ## [integrity (#+)]]
## [concurrency
- ## ["_." actor]
- ## ["_." atom]
- ## ["_." frp]
- ## ["_." promise]
- ## ["_." stm]
- ## ## ["_." semaphore]
+ ## [actor (#+)]
+ ## [atom (#+)]
+ ## [frp (#+)]
+ ## [promise (#+)]
+ ## [stm (#+)]
+ ## ## [semaphore (#+)]
## ]]
## [data
- ## ["_." bit]
- ## ["_." color]
- ## ["_." error]
- ## ["_." name]
- ## ["_." identity]
- ## ["_." lazy]
- ## ["_." maybe]
- ## ["_." product]
- ## ["_." sum]
- ## [number
- ## ## "_." number ## TODO: FIX Specially troublesome...
- ## ["_." i64]
- ## ["_." ratio]
- ## ["_." complex]]
- ## ["_." text
- ## ## ["_." format]
- ## ["_." lexer]
- ## ["_." regex]]
+ ## [bit (#+)]
+ ## [color (#+)]
+ ## [error (#+)]
+ ## [name (#+)]
+ ## [identity (#+)]
+ ## [lazy (#+)]
+ ## [maybe (#+)]
+ ## [product (#+)]
+ ## [sum (#+)]
+ ## [number (#+) ## TODO: FIX Specially troublesome...
+ ## [i64 (#+)]
+ ## [ratio (#+)]
+ ## [complex (#+)]]
+ ## [text (#+)
+ ## ## [format (#+)]
+ ## [lexer (#+)]
+ ## [regex (#+)]]
## [format
- ## ## ["_." json]
- ## ["_." xml]]
+ ## ## [json (#+)]
+ ## [xml (#+)]]
## ## [collection
- ## ## ["_." array]
- ## ## ["_." bits]
- ## ## ["_." list]
- ## ## ["_." stack]
- ## ## ["_." row]
- ## ## ["_." sequence]
- ## ## ["_." dictionary
+ ## ## [array (#+)]
+ ## ## [bits (#+)]
+ ## ## [list (#+)]
+ ## ## [stack (#+)]
+ ## ## [row (#+)]
+ ## ## [sequence (#+)]
+ ## ## [dictionary (#+)
## ## ["dictionary_." ordered]]
- ## ## ["_." set
+ ## ## [set (#+)
## ## ["set_." ordered]]
- ## ## ["_." queue
- ## ## ["_." priority]]
+ ## ## [queue (#+)
+ ## ## [priority (#+)]]
## ## [tree
- ## ## ["_." rose
- ## ## ["_." zipper]]]]
+ ## ## [rose (#+)
+ ## ## [zipper (#+)]]]]
## ]
- ## ["_." math
- ## ["_." random]
- ## ["_." modular]
+ ## [math (#+)
+ ## [random (#+)]
+ ## [modular (#+)]
## [logic
- ## ["_." continuous]
- ## ["_." fuzzy]]]
+ ## [continuous (#+)]
+ ## [fuzzy (#+)]]]
## [macro
- ## ["_." code]
- ## ["_." syntax]
+ ## [code (#+)]
+ ## [syntax (#+)]
## [poly
## ["poly_." equivalence]
## ["poly_." functor]]]
- ## ["_." type
- ## ["_." check]
- ## ## ["_." implicit] ## TODO: FIX Specially troublesome...
- ## ["_." resource]]
+ [type ## (#+)
+ ## [check (#+)]
+ ## [implicit (#+)] ## TODO: FIX Specially troublesome...
+ ## [resource (#+)]
+ [dynamic (#+)]]
## [compiler
## [default
## ["_default/." syntax]
@@ -187,11 +187,11 @@
## ["_.S" case]
## ["_.S" function]]]]]
## [world
- ## ["_." binary]
- ## ["_." file]
+ ## [binary (#+)]
+ ## [file (#+)]
## [net
- ## ["_." tcp]
- ## ["_." udp]]]
+ ## [tcp (#+)]
+ ## [udp (#+)]]]
]]
)