diff options
| -rw-r--r-- | lux-mode/lux-mode.el | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/type/dynamic.lux | 39 | ||||
| -rw-r--r-- | stdlib/test/test/lux/type/dynamic.lux | 31 | ||||
| -rw-r--r-- | stdlib/test/tests.lux | 144 |
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 (#+)]]] ]] ) |