- Added a way to pass the cursor from un-expanded macro-forms to their expansions in order to aid error-reporting.

- Added recursive type definitions through the #rec tag in deftype.

4 files changed, 98 insertions, 23 deletions

diff --git a/input/lux.lux b/input/lux.lux
index 0c8b73c34..7ba6cef76 100644
--- a/input/lux.lux
+++ b/input/lux.lux
@@ -295,6 +295,12 @@
 (_lux_export Macro)
 
 ## Base functions & macros
+## (def _cursor
+##   Cursor
+##   ["" -1 -1])
+(_lux_def _cursor
+  (_lux_: Cursor ["" -1 -1]))
+
 ## (def (_meta data)
 ##   (-> (Syntax' (Meta Cursor)) Syntax)
 ##   (#Meta [["" -1 -1] data]))
@@ -303,7 +309,7 @@
                              (#AppT [Meta Cursor])])
                      Syntax])
           (_lux_lambda _ data
-            (#Meta [["" -1 -1] data]))))
+            (#Meta [_cursor data]))))
 
 ## (def (return x)
 ##   (All [a]
@@ -1488,21 +1494,34 @@
     _
     (fail "Wrong syntax for :!")))
 
+(def'' (empty? xs)
+  (All [a] (-> ($' List a) Bool))
+  (_lux_case xs
+    #Nil true
+    _    false))
+
 (defmacro #export (deftype tokens)
   (let [[export? tokens'] (: (, Bool (List Syntax))
-                             (_lux_case (:! (List Syntax) tokens)
+                             (_lux_case tokens
                                (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
-                               [true (:! (List Syntax) tokens')]
+                               [true tokens']
 
                                _
-                               [false (:! (List Syntax) tokens)]))
-        parts (: (Maybe (, Syntax (List Syntax) Syntax))
+                               [false tokens]))
+        [rec? tokens'] (: (, Bool (List Syntax))
+                          (_lux_case tokens'
+                            (#Cons [(#Meta [_ (#TagS ["" "rec"])]) tokens'])
+                            [true tokens']
+
+                            _
+                            [false tokens']))
+        parts (: (Maybe (, Text (List Syntax) Syntax))
                  (_lux_case tokens'
-                   (#Cons [(#Meta [_ (#SymbolS name)]) (#Cons [type #Nil])])
-                   (#Some [(symbol$ name) #Nil type])
+                   (#Cons [(#Meta [_ (#SymbolS ["" name])]) (#Cons [type #Nil])])
+                   (#Some [name #Nil type])
 
-                   (#Cons [(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS name)]) args]))]) (#Cons [type #Nil])])
-                   (#Some [(symbol$ name) args type])
+                   (#Cons [(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" name])]) args]))]) (#Cons [type #Nil])])
+                   (#Some [name args type])
 
                    _
                    #None))]
@@ -1510,21 +1529,71 @@
       (#Some [name args type])
       (let [with-export (: (List Syntax)
                            (if export?
-                             (list (`' (_lux_export (~ name))))
+                             (list (`' (_lux_export (~ (symbol$ ["" name])))))
                              #Nil))
-            type' (: Syntax
-                     (_lux_case args
-                       #Nil
-                       type
+            type' (: (Maybe Syntax)
+                     (if rec?
+                       (if (empty? args)
+                         (let [g!param (symbol$ ["" ""])
+                               prime-name (symbol$ ["" (text:++ name "'")])
+                               type+ (replace-syntax (list [name (`' ((~ prime-name) (~ g!param)))]) type)]
+                           (#Some (`' ((;All (~ prime-name) [(~ g!param)] (~ type+))
+                                       ;Void))))
+                         #None)
+                       (_lux_case args
+                         #Nil
+                         (#Some type)
 
-                       _
-                       (`' (;All (~ name) [(~@ args)] (~ type)))))]
-        (return (list& (`' (_lux_def (~ name) (;type (~ type'))))
-                       with-export)))
+                         _
+                         (#Some (`' (;All (~ (symbol$ ["" name])) [(~@ args)] (~ type)))))))]
+        (_lux_case type'
+          (#Some type'')
+          (return (list& (`' (_lux_def (~ (symbol$ ["" name])) (;type (~ type''))))
+                         with-export))
+
+          #None
+          (fail "Wrong syntax for deftype")))
 
       #None
       (fail "Wrong syntax for deftype"))
     ))
+## (defmacro #export (deftype tokens)
+##   (let [[export? tokens'] (: (, Bool (List Syntax))
+##                              (_lux_case (:! (List Syntax) tokens)
+##                                (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
+##                                [true (:! (List Syntax) tokens')]
+
+##                                _
+##                                [false (:! (List Syntax) tokens)]))
+##         parts (: (Maybe (, Syntax (List Syntax) Syntax))
+##                  (_lux_case tokens'
+##                    (#Cons [(#Meta [_ (#SymbolS name)]) (#Cons [type #Nil])])
+##                    (#Some [(symbol$ name) #Nil type])
+
+##                    (#Cons [(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS name)]) args]))]) (#Cons [type #Nil])])
+##                    (#Some [(symbol$ name) args type])
+
+##                    _
+##                    #None))]
+##     (_lux_case parts
+##       (#Some [name args type])
+##       (let [with-export (: (List Syntax)
+##                            (if export?
+##                              (list (`' (_lux_export (~ name))))
+##                              #Nil))
+##             type' (: Syntax
+##                      (_lux_case args
+##                        #Nil
+##                        type
+
+##                        _
+##                        (`' (;All (~ name) [(~@ args)] (~ type)))))]
+##         (return (list& (`' (_lux_def (~ name) (;type (~ type'))))
+##                        with-export)))
+
+##       #None
+##       (fail "Wrong syntax for deftype"))
+##     ))
 
 (defmacro #export (exec tokens)
   (_lux_case (reverse tokens)
diff --git a/input/lux/control/lazy.lux b/input/lux/control/lazy.lux
index fca63179e..22dac74fe 100644
--- a/input/lux/control/lazy.lux
+++ b/input/lux/control/lazy.lux
@@ -36,7 +36,7 @@
 ## Structs
 (defstruct #export Lazy/Functor (Functor Lazy)
   (def (F;map f ma)
-    (... (f (! ma)))))
+    (lambda [k] (ma (. k f)))))
 
 (defstruct #export Lazy/Monad (Monad Lazy)
   (def M;_functor Lazy/Functor)
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 995e77fe6..f85b3d619 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -535,7 +535,7 @@
                            ]
         [["lux;Right" [state* =fn]]]
         (do ;; (prn 'GOT_FUN (&/show-ast ?fn) (&/show-ast token) (aget =fn 0 0) (aget =fn 1 0))
-            ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type =fn ?args) state*))
+            ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type meta =fn ?args) state*))
 
         [_]
         ((analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token) state)))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index fc96fecff..8be2a8924 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -30,6 +30,11 @@
             (return (&/T ?item =type)))
           )))))
 
+(defn ^:private with-cursor [cursor form]
+  (matchv ::M/objects [form]
+    [["lux;Meta" [_ syntax]]]
+    (&/V "lux;Meta" (&/T cursor syntax))))
+
 ;; [Exports]
 (defn analyse-tuple [analyse exo-type ?elems]
   (|do [exo-type* (&type/actual-type exo-type)]
@@ -245,7 +250,7 @@
         (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*)))))
     ))
 
-(defn analyse-apply [analyse exo-type =fn ?args]
+(defn analyse-apply [analyse exo-type form-cursor =fn ?args]
   (|do [loader &/loader]
     (matchv ::M/objects [=fn]
       [[=fn-form =fn-type]]
@@ -255,14 +260,15 @@
           (matchv ::M/objects [$def]
             [["lux;MacroD" macro]]
             (|do [macro-expansion #(-> macro (.apply ?args) (.apply %))
+                  :let [macro-expansion* (&/|map (partial with-cursor form-cursor) macro-expansion)]
                   :let [_ (when (and ;; (= "lux/control/monad" ?module)
                                  (= "case" ?name))
-                            (->> (&/|map &/show-ast macro-expansion)
+                            (->> (&/|map &/show-ast macro-expansion*)
                                  (&/|interpose "\n")
                                  (&/fold str "")
                                  (prn ?module "case")))]
                   ]
-              (&/flat-map% (partial analyse exo-type) macro-expansion))
+              (&/flat-map% (partial analyse exo-type) macro-expansion*))
 
             [_]
             (|do [[=output-t =args] (analyse-apply* analyse exo-type =fn-type ?args)]