- Implemented ":cast" macro, and used it to implement both ":abstraction" and ":representation".

- Fix: You shouldn't be able to resolve tags if you haven't imported a module (even if they are exported).

7 files changed, 121 insertions, 100 deletions

diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 55499d6cc..31f5165ea 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -6341,3 +6341,12 @@
 
     _
     (fail "Wrong syntax for alias:")))
+
+(def: #export (cursor-description [file line column])
+  (-> Cursor Text)
+  (let [separator ", "
+        fields ($_ "lux text concat"
+                   (text/encode file) separator
+                   (nat/encode line) separator
+                   (nat/encode column))]
+    ($_ "lux text concat" "[" fields "]")))
diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux
index 8ae82ef89..b2a1c160c 100644
--- a/stdlib/source/lux/data/text/format.lux
+++ b/stdlib/source/lux/data/text/format.lux
@@ -23,9 +23,7 @@
 (syntax: #export (format {fragments (p.many s.any)})
   {#.doc (doc "Text interpolation."
               (format "Static part " (%t static) " does not match URI: " uri))}
-  (macro.with-gensyms [g!compose]
-    (wrap (list (` (let [(~ g!compose) (:: (~! text.Monoid<Text>) (~' compose))]
-                     ($_ (~ g!compose) (~+ fragments))))))))
+  (wrap (list (` ($_ "lux text concat" (~+ fragments))))))
 
 ## [Formats]
 (type: #export (Format a)
diff --git a/stdlib/source/lux/lang/type.lux b/stdlib/source/lux/lang/type.lux
index 36e6a74a8..acc3d9046 100644
--- a/stdlib/source/lux/lang/type.lux
+++ b/stdlib/source/lux/lang/type.lux
@@ -1,13 +1,16 @@
 (.module: {#.doc "Basic functionality for working with types."}
   [lux #- function]
   (lux (control [equality #+ Eq]
-                [monad #+ do Monad])
+                [monad #+ do Monad]
+                ["p" parser])
        (data [text "text/" Monoid<Text> Eq<Text>]
-             [ident "ident/" Eq<Ident>]
+             [ident "ident/" Eq<Ident> Codec<Text,Ident>]
              [number "nat/" Codec<Text,Nat>]
              [maybe]
-             (coll [list #+ "list/" Monad<List> Monoid<List> Fold<List>]))
-       (macro [code])
+             (coll [list #+ "list/" Functor<List> Monoid<List> Fold<List>]))
+       [macro]
+       (macro [code]
+              ["s" syntax #+ syntax:])
        ))
 
 ## [Utils]
@@ -275,7 +278,7 @@
        (<ctor> type (<name> types'))))]
 
   [variant Nothing #.Sum]
-  [tuple   Any #.Product]
+  [tuple   Any     #.Product]
   )
 
 (def: #export (function inputs output)
@@ -330,3 +333,34 @@
   (case level
     +0 elem-type
     _ (|> elem-type (array (dec level)) (list) (#.Primitive "#Array"))))
+
+(syntax: #export (:log! {input (p.alt s.symbol
+                                      s.any)})
+  (case input
+    (#.Left valueN)
+    (do @
+      [cursor macro.cursor
+       valueT (macro.find-type valueN)
+       #let [_ (log! ($_ text/compose
+                         ":log!" " @ " (.cursor-description cursor) "\n"
+                         (ident/encode valueN) " : " (..to-text valueT) "\n"))]]
+      (wrap (list (' []))))
+
+    (#.Right valueC)
+    (macro.with-gensyms [g!value]
+      (wrap (list (` (.let [(~ g!value) (~ valueC)]
+                       (..:log! (~ g!value)))))))))
+
+(syntax: #export (:cast {type-vars (s.tuple (p.some s.local-symbol))}
+                        input
+                        output
+                        {value (p.maybe s.any)})
+  (let [casterC (` (: (All [(~+ (list/map code.local-symbol type-vars))]
+                        (-> (~ input) (~ output)))
+                      (|>> :assume)))]
+    (case value
+      #.None
+      (wrap (list casterC))
+      
+      (#.Some value)
+      (wrap (list (` ((~ casterC) (~ value))))))))
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index 982dec71b..9e26a49e4 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -9,8 +9,7 @@
              [maybe]
              ["e" error]
              [text "text/" Monoid<Text> Eq<Text>]
-             (coll [list "list/" Monoid<List> Monad<List>]))
-       (lang [type]))
+             (coll [list "list/" Monoid<List> Monad<List>])))
   (/ [code]))
 
 ## (type: (Meta a)
@@ -605,17 +604,31 @@
     [(^slots [#.imports]) (find-module module-name)]
     (wrap imports)))
 
+(def: #export (imported-by? import module)
+  (-> Text Text (Meta Bool))
+  (do Monad<Meta>
+    [(^slots [#.imports]) (find-module module)]
+    (wrap (list.any? (text/= import) imports))))
+
+(def: #export (imported? import)
+  (-> Text (Meta Bool))
+  (let [(^open) Monad<Meta>]
+    (|> current-module-name
+        (map find-module) join
+        (map (|>> (get@ #.imports) (list.any? (text/= import)))))))
+
 (def: #export (resolve-tag tag)
   {#.doc "Given a tag, finds out what is its index, its related tag-list and it's associated type."}
   (-> Ident (Meta [Nat (List Ident) Type]))
   (do Monad<Meta>
     [#let [[module name] tag]
      =module (find-module module)
-     this-module-name current-module-name]
+     this-module-name current-module-name
+     imported! (..imported? module)]
     (case (get name (get@ #.tags =module))
       (#.Some [idx tag-list exported? type])
-      (if (or exported?
-              (text/= this-module-name module))
+      (if (or (text/= this-module-name module)
+              (and imported! exported?))
         (wrap [idx tag-list type])
         (fail ($_ text/compose "Cannot access tag: " (ident/encode tag) " from module " this-module-name)))
 
@@ -673,14 +686,6 @@
   (function (_ compiler)
     (#e.Success [compiler (get@ #.type-context compiler)])))
 
-(def: (cursor-description [file line column])
-  (-> Cursor Text)
-  (|> (list (text.encode file)
-            (nat/encode line)
-            (nat/encode column))
-      (text.join-with ", ")
-      (text.enclose ["[" "]"])))
-
 (do-template [<macro> <func> <desc>]
   [(macro: #export (<macro> tokens)
      {#.doc (doc "Performs a macro-expansion and logs the resulting code."
@@ -705,7 +710,7 @@
        (do Monad<Meta>
          [cursor ..cursor
           output (<func> token)
-          #let [_ (log! ($_ text/compose <desc> " @ " (cursor-description cursor)))
+          #let [_ (log! ($_ text/compose <desc> " @ " (.cursor-description cursor)))
                 _ (list/map (|>> code.to-text log!)
                             output)
                 _ (log! "")]]
@@ -720,25 +725,3 @@
   [log-expand-all  expand-all  "log-expand-all"]
   [log-expand-once expand-once "log-expand-once"]
   )
-
-(macro: #export (log-type! tokens)
-  (case tokens
-    (#.Cons [_ (#.Symbol valueN)] #.Nil)
-    (do Monad<Meta>
-      [cursor ..cursor
-       valueT (find-type valueN)
-       #let [_ (log! ($_ text/compose
-                         "log-type!" " @ " (cursor-description cursor) "\n"
-                         (code.to-text (code.symbol valueN)) " : " (type.to-text valueT) "\n"))]]
-      (wrap (list (' []))))
-
-    (#.Cons valueC #.Nil)
-    (|> (` (.let [(~ g!value) (~ valueC)]
-             (..log-type! (~ g!value))))
-        (let [g!value (code.local-symbol (code.to-text valueC))])
-        list
-        (:: Monad<Meta> wrap))
-
-    _
-    (fail "Wrong syntax for log-type!.")
-    ))
diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux
index cde2f97fe..f537eedac 100644
--- a/stdlib/source/lux/macro/code.lux
+++ b/stdlib/source/lux/macro/code.lux
@@ -3,7 +3,7 @@
   (lux (control [equality #+ Eq])
        (data bool
              number
-             [text #+ Eq<Text> "Text/" Monoid<Text>]
+             [text #+ Eq<Text> "text/" Monoid<Text>]
              ident
              (coll [list #* "" Functor<List> Fold<List>])
              )))
@@ -109,16 +109,16 @@
     (text.encode value)
 
     [_ (#.Tag ident)]
-    (Text/compose  "#" (:: Codec<Text,Ident> encode ident))
+    (text/compose  "#" (:: Codec<Text,Ident> encode ident))
 
     (^template [<tag> <open> <close>]
       [_ (<tag> members)]
-      ($_ Text/compose <open> (|> members (map to-text) (interpose " ") (text.join-with "")) <close>))
+      ($_ text/compose <open> (|> members (map to-text) (interpose " ") (text.join-with "")) <close>))
     ([#.Form  "(" ")"]
      [#.Tuple "[" "]"])
 
     [_ (#.Record pairs)]
-    ($_ Text/compose "{" (|> pairs (map (function (_ [left right]) ($_ Text/compose (to-text left) " " (to-text right)))) (interpose " ") (text.join-with "")) "}")
+    ($_ text/compose "{" (|> pairs (map (function (_ [left right]) ($_ text/compose (to-text left) " " (to-text right)))) (interpose " ") (text.join-with "")) "}")
     ))
 
 (def: #export (replace original substitute ast)
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
index 0268cae29..c26cb7327 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -9,9 +9,8 @@
              [text "text/" Monoid<Text>]
              [ident]
              (coll [list "list/" Functor<List>])
-             [product]
              [maybe]
-             ["e" error]))
+             [error #+ Error]))
   (// [code "code/" Eq<Code>]))
 
 ## [Utils]
@@ -38,8 +37,8 @@
   (Syntax Code)
   (function (_ tokens)
     (case tokens
-      #.Nil                (#e.Error "There are no tokens to parse!")
-      (#.Cons [t tokens']) (#e.Success [tokens' t]))))
+      #.Nil                (#error.Error "There are no tokens to parse!")
+      (#.Cons [t tokens']) (#error.Success [tokens' t]))))
 
 (do-template [<get-name> <type> <tag> <eq> <desc>]
   [(def: #export <get-name>
@@ -48,15 +47,15 @@
      (function (_ tokens)
        (case tokens
          (#.Cons [[_ (<tag> x)] tokens'])
-         (#e.Success [tokens' x])
+         (#error.Success [tokens' x])
 
          _
-         (#e.Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))]
+         (#error.Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))]
 
   [  bool  Bool   #.Bool   bool.Eq<Bool> "bool"]
   [   nat   Nat    #.Nat  number.Eq<Nat> "nat"]
   [   int   Int    #.Int  number.Eq<Int> "int"]
-  [  deg    Deg    #.Deg  number.Eq<Deg> "deg"]
+  [   deg   Deg    #.Deg  number.Eq<Deg> "deg"]
   [  frac  Frac   #.Frac number.Eq<Frac> "frac"]
   [  text  Text   #.Text   text.Eq<Text> "text"]
   [symbol Ident #.Symbol ident.Eq<Ident> "symbol"]
@@ -73,10 +72,10 @@
             remaining (if is-it?
                         tokens'
                         tokens)]
-        (#e.Success [remaining is-it?]))
+        (#error.Success [remaining is-it?]))
 
       _
-      (#e.Success [tokens false]))))
+      (#error.Success [tokens false]))))
 
 (def: #export (this ast)
   {#.doc "Ensures the given Code is the next input."}
@@ -85,12 +84,12 @@
     (case tokens
       (#.Cons [token tokens'])
       (if (code/= ast token)
-        (#e.Success [tokens' []])
-        (#e.Error ($_ text/compose "Expected a " (code.to-text ast) " but instead got " (code.to-text token)
-                      (remaining-inputs tokens))))
+        (#error.Success [tokens' []])
+        (#error.Error ($_ text/compose "Expected a " (code.to-text ast) " but instead got " (code.to-text token)
+                          (remaining-inputs tokens))))
 
       _
-      (#e.Error "There are no tokens to parse!"))))
+      (#error.Error "There are no tokens to parse!"))))
 
 (do-template [<name> <tag> <desc>]
   [(def: #export <name>
@@ -99,10 +98,10 @@
      (function (_ tokens)
        (case tokens
          (#.Cons [[_ (<tag> ["" x])] tokens'])
-         (#e.Success [tokens' x])
+         (#error.Success [tokens' x])
 
          _
-         (#e.Error ($_ text/compose "Cannot parse local " <desc> (remaining-inputs tokens))))))]
+         (#error.Error ($_ text/compose "Cannot parse local " <desc> (remaining-inputs tokens))))))]
 
   [local-symbol #.Symbol "symbol"]
   [   local-tag #.Tag    "tag"]
@@ -117,11 +116,11 @@
        (case tokens
          (#.Cons [[_ (<tag> members)] tokens'])
          (case (p members)
-           (#e.Success [#.Nil x]) (#e.Success [tokens' x])
-           _                      (#e.Error ($_ text/compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens))))
+           (#error.Success [#.Nil x]) (#error.Success [tokens' x])
+           _                          (#error.Error ($_ text/compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens))))
 
          _
-         (#e.Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))]
+         (#error.Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))]
 
   [ form  #.Form "form"]
   [tuple #.Tuple "tuple"]
@@ -135,61 +134,61 @@
     (case tokens
       (#.Cons [[_ (#.Record pairs)] tokens'])
       (case (p (join-pairs pairs))
-        (#e.Success [#.Nil x]) (#e.Success [tokens' x])
-        _                      (#e.Error ($_ text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens))))
+        (#error.Success [#.Nil x]) (#error.Success [tokens' x])
+        _                          (#error.Error ($_ text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens))))
 
       _
-      (#e.Error ($_ text/compose "Cannot parse record" (remaining-inputs tokens))))))
+      (#error.Error ($_ text/compose "Cannot parse record" (remaining-inputs tokens))))))
 
 (def: #export end!
   {#.doc "Ensures there are no more inputs."}
   (Syntax Any)
   (function (_ tokens)
     (case tokens
-      #.Nil (#e.Success [tokens []])
-      _     (#e.Error ($_ text/compose "Expected list of tokens to be empty!" (remaining-inputs tokens))))))
+      #.Nil (#error.Success [tokens []])
+      _     (#error.Error ($_ text/compose "Expected list of tokens to be empty!" (remaining-inputs tokens))))))
 
 (def: #export end?
   {#.doc "Checks whether there are no more inputs."}
   (Syntax Bool)
   (function (_ tokens)
     (case tokens
-      #.Nil (#e.Success [tokens true])
-      _     (#e.Success [tokens false]))))
+      #.Nil (#error.Success [tokens true])
+      _     (#error.Success [tokens false]))))
 
 (def: #export (on compiler action)
   {#.doc "Run a Lux operation as if it was a Syntax parser."}
   (All [a] (-> Lux (Meta a) (Syntax a)))
   (function (_ input)
     (case (macro.run compiler action)
-      (#e.Error error)
-      (#e.Error error)
+      (#error.Error error)
+      (#error.Error error)
 
-      (#e.Success value)
-      (#e.Success [input value])
+      (#error.Success value)
+      (#error.Success [input value])
       )))
 
 (def: #export (run inputs syntax)
-  (All [a] (-> (List Code) (Syntax a) (e.Error a)))
+  (All [a] (-> (List Code) (Syntax a) (Error a)))
   (case (syntax inputs)
-    (#e.Error error)
-    (#e.Error error)
+    (#error.Error error)
+    (#error.Error error)
 
-    (#e.Success [unconsumed value])
+    (#error.Success [unconsumed value])
     (case unconsumed
       #.Nil
-      (#e.Success value)
+      (#error.Success value)
 
       _
-      (#e.Error (text/compose "Unconsumed inputs: "
-                              (|> (list/map code.to-text unconsumed)
-                                  (text.join-with ", ")))))))
+      (#error.Error (text/compose "Unconsumed inputs: "
+                                  (|> (list/map code.to-text unconsumed)
+                                      (text.join-with ", ")))))))
 
 (def: #export (local inputs syntax)
   {#.doc "Run a syntax parser with the given list of inputs, instead of the real ones."}
   (All [a] (-> (List Code) (Syntax a) (Syntax a)))
   (function (_ real)
-    (do e.Monad<Error>
+    (do error.Monad<Error>
       [value (run inputs syntax)]
       (wrap [real value]))))
 
@@ -233,7 +232,7 @@
                     #.None))]
     (case ?parts
       (#.Some [name args meta body])
-      (with-gensyms [g!text/join-with g!tokens g!body g!error]
+      (with-gensyms [g!tokens g!body g!error]
         (do macro.Monad<Meta>
           [vars+parsers (monad.map @
                                    (: (-> Code (Meta [Code Code]))
@@ -263,12 +262,11 @@
                                                   ((~' wrap) ((~! do) (~! macro.Monad<Meta>)
                                                               []
                                                               (~ body))))))
-                            {(#e.Success (~ g!body))
+                            {(#error.Success (~ g!body))
                              ((~ g!body) (~ g!state))
 
-                             (#e.Error (~ g!error))
-                             (let [(~ g!text/join-with) (~! text.join-with)]
-                               (#e.Error ((~ g!text/join-with) ": " (list (~ error-msg) (~ g!error)))))})))))))
+                             (#error.Error (~ g!error))
+                             (#error.Error ((~! text.join-with) ": " (list (~ error-msg) (~ g!error))))})))))))
       
       _
       (macro.fail "Wrong syntax for syntax:"))))
diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux
index 70a71c60b..f7594852d 100644
--- a/stdlib/source/lux/type/abstract.lux
+++ b/stdlib/source/lux/type/abstract.lux
@@ -10,7 +10,8 @@
               ["s" syntax #+ syntax:]
               (syntax ["cs" common]
                       (common ["csr" reader]
-                              ["csw" writer])))))
+                              ["csw" writer])))
+       (lang [type #+ :cast])))
 
 (def: (get k plist)
   (All [a]
@@ -57,18 +58,16 @@
   (|>> ($_ text/compose "{" kind "@" module "}")
        (let [[module kind] (ident-for #..Representation)])))
 
-(def: (cast name type-vars input-declaration output-declaration)
-  (-> Text (List Code) Code Code Macro)
+(def: (cast type-vars input-declaration output-declaration)
+  (-> (List Code) Code Code Macro)
   (function (_ tokens)
     (case tokens
       (^ (list value))
-      (meta/wrap (list (` ((: (All [(~+ type-vars)]
-                                (-> (~ input-declaration) (~ output-declaration)))
-                              (|>> :assume))
+      (meta/wrap (list (` ((~! :cast) [(~+ type-vars)] (~ input-declaration) (~ output-declaration)
                            (~ value)))))
 
       _
-      (macro.fail ($_ text/compose "Wrong syntax for " name)))))
+      (meta/wrap (list (` ((~! :cast) [(~+ type-vars)] (~ input-declaration) (~ output-declaration))))))))
 
 (def: (install-casts' this-module-name name type-vars)
   (-> Text Text (List Text) (Meta Any))
@@ -80,10 +79,10 @@
            this-module (|> this-module
                            (update@ #.definitions (put down-cast (: Definition
                                                                     [Macro macro-anns
-                                                                     (cast down-cast type-varsC representation-declaration abstraction-declaration)])))
+                                                                     (cast type-varsC representation-declaration abstraction-declaration)])))
                            (update@ #.definitions (put up-cast (: Definition
                                                                   [Macro macro-anns
-                                                                   (cast up-cast type-varsC abstraction-declaration representation-declaration)]))))]]
+                                                                   (cast type-varsC abstraction-declaration representation-declaration)]))))]]
     (function (_ compiler)
       (#error.Success [(update@ #.modules (put this-module-name this-module) compiler)
                        []]))))