From 94f60efe5745accce36c5d6824c71f00a12dd384 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 24 Jan 2019 00:16:16 -0400
Subject: Added dynamic typing.

---
 lux-mode/lux-mode.el                  |   4 +-
 stdlib/source/lux/type/dynamic.lux    |  39 +++++++++
 stdlib/test/test/lux/type/dynamic.lux |  31 ++++++++
 stdlib/test/tests.lux                 | 144 +++++++++++++++++-----------------
 4 files changed, 145 insertions(+), 73 deletions(-)
 create mode 100644 stdlib/source/lux/type/dynamic.lux
 create mode 100644 stdlib/test/test/lux/type/dynamic.lux

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 (#+)]]]
     ]]
   )
 
-- 
cgit v1.2.3