- The type syntax is finally complete ^_^

- Finally, the "case" macro has been implemented ^_^
- The macro-expand function is also alive!
- Corrected the field-access special forms so they take their field as a symbol instead of text.
- Macros are no longer stored inside the CompilerState as (Maybe Macro), but as Macro.
- Void is implemented as 
- Fixed an error when parsing escaped characters in text.
- Fixed an error in the reader in which parsing regex2 gave back a 2-vector instead of a 2-tuple.

1 files changed, 182 insertions, 110 deletions

diff --git a/source/lux.lux b/source/lux.lux
index 04ffcf91f..70ebaf67e 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -646,7 +646,7 @@
                _
                (fail "Wrong syntax for lambda"))))
 
-(defmacro #export (def tokens)
+(defmacro (def__ tokens)
   (case' tokens
          (#Cons [(#Meta [_ (#Tag ["" "export"])])
                  (#Cons [(#Meta [_ (#Form (#Cons [name args]))])
@@ -693,7 +693,7 @@
          (fail "Wrong syntax for def")
          ))
 
-(def (as-pairs xs)
+(def__ (as-pairs xs)
   (All' [a]
         (->' ($' List (B' a)) ($' List (#TupleT (list (B' a) (B' a))))))
   (case' xs
@@ -724,7 +724,7 @@
          _
          (fail "Wrong syntax for let")))
 
-(def #export (map f xs)
+(def__ #export (map f xs)
   (All' [a b]
         (->' (->' (B' a) (B' b)) ($' List (B' a)) ($' List (B' b))))
   (case' xs
@@ -734,7 +734,7 @@
          (#Cons [x xs'])
          (#Cons [(f x) (map f xs')])))
 
-(def #export (any? p xs)
+(def__ #export (any? p xs)
   (All' [a]
         (->' (->' (B' a) Bool) ($' List (B' a)) Bool))
   (case' xs
@@ -746,7 +746,7 @@
                 true  true
                 false (any? p xs'))))
 
-(def (spliced? token)
+(def__ (spliced? token)
   (->' Syntax Bool)
   (case' token
          (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~@"])]) (#Cons [_ #Nil])]))])
@@ -755,13 +755,13 @@
          _
          false))
 
-(def (wrap-meta content)
+(def__ (wrap-meta content)
   (->' Syntax Syntax)
   (_meta (#Form (list (_meta (#Tag ["lux" "Meta"]))
                       (_meta (#Tuple (list (_meta (#Tuple (list (_meta (#Text "")) (_meta (#Int -1)) (_meta (#Int -1)))))
                                            content)))))))
 
-(def (untemplate-list tokens)
+(def__ (untemplate-list tokens)
   (->' ($' List Syntax) Syntax)
   (case' tokens
          #Nil
@@ -771,7 +771,7 @@
          (_meta (#Form (list (_meta (#Tag ["lux" "Cons"]))
                              (_meta (#Tuple (list token (untemplate-list tokens')))))))))
 
-(def (list:++ xs ys)
+(def__ (list:++ xs ys)
   (All' [a] (->' ($' List (B' a)) ($' List (B' a)) ($' List (B' a))))
   (case' xs
          (#Cons [x xs'])
@@ -793,7 +793,7 @@
          _
          (fail "Wrong syntax for $")))
 
-(def (splice untemplate tag elems)
+(def__ (splice untemplate tag elems)
   (->' (->' Syntax Syntax) Syntax ($' List Syntax) Syntax)
   (case' (any? spliced? elems)
          true
@@ -816,7 +816,7 @@
          false
          (wrap-meta ($form (list tag (untemplate-list (map untemplate elems)))))))
 
-(def (untemplate token)
+(def__ (untemplate token)
   (->' Syntax Syntax)
   (case' token
          (#Meta [_ (#Bool value)])
@@ -898,7 +898,7 @@
 
 ## (deftype (Lux a)
 ##   (-> CompilerState (Either Text (, CompilerState a))))
-(def #export Lux
+(def__ #export Lux
   Type
   (All' [a]
         (->' CompilerState ($' Either Text (#TupleT (list CompilerState (B' a)))))))
@@ -908,7 +908,7 @@
 ##      return)
 ##   (: (All [a b] (-> (-> a (m b)) (m a) (m b)))
 ##      bind))
-(def Monad
+(def__ Monad
   Type
   (All' [m]
         (#RecordT (list ["lux;return" (All' [a] (->' (B' a) ($' (B' m) (B' a))))]
@@ -916,7 +916,7 @@
                                                      ($' (B' m) (B' a))
                                                      ($' (B' m) (B' b))))]))))
 
-(def Maybe:Monad
+(def__ Maybe:Monad
   ($' Monad Maybe)
   {#lux;return
    (lambda return [x]
@@ -928,7 +928,7 @@
             #None     #None
             (#Some a) (f a)))})
 
-(def Lux:Monad
+(def__ Lux:Monad
   ($' Monad Lux)
   {#lux;return
    (lambda return [x]
@@ -996,7 +996,7 @@
          _
          (fail "Wrong syntax for do")))
 
-(def (map% m f xs)
+(def__ (map% m f xs)
   ## (All [m a b]
   ##   (-> (Monad m) (-> a (m b)) (List a) (m (List b))))
   (All' [m a b]
@@ -1016,13 +1016,13 @@
              (;return (:' List (#Cons [y ys]))))
            )))
 
-(def #export (. f g)
+(def__ #export (. f g)
   (All' [a b c]
         (-> (-> (B' b) (B' c)) (-> (B' a) (B' b)) (-> (B' a) (B' c))))
   (lambda [x]
     (f (g x))))
 
-(def (get-ident x)
+(def__ (get-ident x)
   (-> Syntax ($' Maybe Text))
   (case' x
          (#Meta [_ (#Symbol ["" sname])])
@@ -1031,7 +1031,7 @@
          _
          #None))
 
-(def (tuple->list tuple)
+(def__ (tuple->list tuple)
   (-> Syntax ($' Maybe ($' List Syntax)))
   (case' tuple
          (#Meta [_ (#Tuple members)])
@@ -1040,11 +1040,11 @@
          _
          #None))
 
-(def RepEnv
+(def__ RepEnv
   Type
   ($' List (, Text Syntax)))
 
-(def (make-env xs ys)
+(def__ (make-env xs ys)
   (-> ($' List Text) ($' List Syntax) RepEnv)
   (case' (:' (, ($' List Text) ($' List Syntax))
              [xs ys])
@@ -1054,12 +1054,12 @@
          _
          #Nil))
 
-(def (text:= x y)
+(def__ (text:= x y)
   (-> Text Text Bool)
   (jvm-invokevirtual java.lang.Object equals [java.lang.Object]
                      x [y]))
 
-(def (get-rep key env)
+(def__ (get-rep key env)
   (-> Text RepEnv ($' Maybe Syntax))
   (case' env
          #Nil
@@ -1070,7 +1070,7 @@
            (#Some v)
            (get-rep key env'))))
 
-(def (apply-template env template)
+(def__ (apply-template env template)
   (-> RepEnv Syntax Syntax)
   (case' template
          (#Meta [_ (#Symbol ["" sname])])
@@ -1097,7 +1097,7 @@
          _
          template))
 
-(def (join-map f xs)
+(def__ (join-map f xs)
   (All' [a b]
         (-> (-> (B' a) ($' List (B' b))) ($' List (B' a)) ($' List (B' b))))
   (case' xs
@@ -1127,7 +1127,7 @@
          (fail "Wrong syntax for do-template")))
 
 (do-template [<name> <cmp> <type>]
-  [(def #export (<name> x y)
+  [(def__ #export (<name> x y)
      (-> <type> <type> Bool)
      (<cmp> x y))]
 
@@ -1140,7 +1140,7 @@
   )
 
 (do-template [<name> <cmp> <type>]
-  [(def #export (<name> x y)
+  [(def__ #export (<name> x y)
      (-> <type> <type> <type>)
      (<cmp> x y))]
 
@@ -1156,24 +1156,24 @@
   [real:% jvm-drem Real]
   )
 
-(def (multiple? div n)
+(def__ (multiple? div n)
   (-> Int Int Bool)
   (int:= 0 (int:% n div)))
 
-(def #export (length list)
+(def__ #export (length list)
   (-> List Int)
   (fold (lambda [acc _] (int:+ 1 acc)) 0 list))
 
-(def #export (not x)
+(def__ #export (not x)
   (-> Bool Bool)
   (if x false true))
 
-(def (text:++ x y)
+(def__ (text:++ x y)
   (-> Text Text Text)
   (jvm-invokevirtual java.lang.String concat [java.lang.String]
                      x [y]))
 
-(def (ident->text ident)
+(def__ (ident->text ident)
   (-> Ident Text)
   (let [[module name] ident]
     ($ text:++ module ";" name)))
@@ -1211,7 +1211,7 @@
                    (as-pairs tokens))]
       (;return (:' SyntaxList (list (` (#;RecordT (;list (~@ pairs))))))))))
 
-(def (replace-syntax reps syntax)
+(def__ (replace-syntax reps syntax)
   (-> RepEnv Syntax Syntax)
   (case' syntax
          (#Meta [_ (#Symbol ["" name])])
@@ -1274,7 +1274,7 @@
            (fail "Wrong syntax for All"))
     ))
 
-(def (get k plist)
+(def__ (get k plist)
   (All [a]
     (-> Text ($' List (, Text a)) ($' Maybe a)))
   (case' plist
@@ -1286,7 +1286,7 @@
          #Nil
          #None))
 
-(def #export (find-macro ident state)
+(def__ #export (find-macro ident state)
   (-> Ident ($' Lux ($' Maybe Macro)))
   (let [[module name] ident]
     (case' state
@@ -1303,12 +1303,12 @@
                                    _
                                    #None))]))))
 
-(def (list:join xs)
+(def__ (list:join xs)
   (All [a]
     (-> ($' List ($' List a)) ($' List a)))
   (fold list:++ #Nil xs))
 
-(def #export (normalize ident state)
+(def__ #export (normalize ident state)
   (-> Ident ($' Lux Ident))
   (case' ident
          ["" name]
@@ -1326,40 +1326,63 @@
          _
          (#Right [state ident])))
 
-## (def #export (macro-expand syntax)
-##   (-> Syntax ($' Lux ($' List Syntax)))
-##   (case' syntax
-##          (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) args]))])
-##          (do Lux:Monad
-##            [macro-name' (normalize macro-name)
-##             ?macro (find-macro macro-name')]
-##            (case' (:' ($' Maybe Macro) ?macro)
-##                   (#Some macro)
-##                   (do Lux:Monad
-##                     [expansion (macro args)
-##                      expansion' (map% Lux:Monad macro-expand expansion)]
-##                     (;return (:' SyntaxList (list:join expansion'))))
-                  
-##                   #None
-##                   (do Lux:Monad
-##                     [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))]
-##                     (;return (:' SyntaxList (list ($form (list:join parts'))))))))
-
-##          ## (#Meta [_ (#Form (#Cons [harg targs]))])
-##          ## (do Lux:Monad
-##          ##   [harg+ (macro-expand harg)
-##          ##    targs+ (map% Lux:Monad macro-expand targs)]
-##          ##   (;return (:' SyntaxList (list:++ harg+ (list:join targs+)))))
-
-##          (#Meta [_ (#Tuple members)])
-##          (do Lux:Monad
-##            [members' (map% Lux:Monad macro-expand members)]
-##            (;return (:' SyntaxList (list ($tuple (list:join members'))))))
-
-##          _
-##          (return (:' SyntaxList (list syntax)))))
-
-(def #export (macro-expand syntax)
+(def__ (->text x)
+  (-> (^ java.lang.Object) Text)
+  (jvm-invokevirtual java.lang.Object toString [] x []))
+
+(def__ #export (interpose sep xs)
+  (All [a]
+    (-> a ($' List a) ($' List a)))
+  (case' xs
+         #Nil
+         xs
+
+         (#Cons [x #Nil])
+         xs
+
+         (#Cons [x xs'])
+         (list& x sep (interpose sep xs'))))
+
+(def__ #export (syntax:show syntax)
+  (-> Syntax Text)
+  (case' syntax
+         (#Meta [_ (#Bool value)])
+         (->text value)
+
+         (#Meta [_ (#Int value)])
+         (->text value)
+
+         (#Meta [_ (#Real value)])
+         (->text value)
+
+         (#Meta [_ (#Char value)])
+         ($ text:++ "#\"" (->text value) "\"")
+
+         (#Meta [_ (#Text value)])
+         value
+
+         (#Meta [_ (#Symbol ident)])
+         (ident->text ident)
+
+         (#Meta [_ (#Tag ident)])
+         (text:++ "#" (ident->text ident))
+
+         (#Meta [_ (#Tuple members)])
+         ($ text:++ "[" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) "]")
+
+         (#Meta [_ (#Form members)])
+         ($ text:++ "(" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) ")")
+
+         (#Meta [_ (#Record slots)])
+         ($ text:++ "(" (|> slots
+                            (map (:' (-> (, Syntax Syntax) Text)
+                                     (lambda [slot]
+                                       (let [[k v] slot]
+                                         ($ text:++ (syntax:show k) " " (syntax:show v))))))
+                            (interpose " ") (fold text:++ "")) ")")
+         ))
+
+(def__ #export (macro-expand syntax)
   (-> Syntax ($' Lux ($' List Syntax)))
   (case' syntax
          (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) args]))])
@@ -1378,11 +1401,11 @@
                     [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))]
                     (;return (:' SyntaxList (list ($form (list:join parts'))))))))
 
-         ## (#Meta [_ (#Form (#Cons [harg targs]))])
-         ## (do Lux:Monad
-         ##   [harg+ (macro-expand harg)
-         ##    targs+ (map% Lux:Monad macro-expand targs)]
-         ##   (;return (:' SyntaxList (list:++ harg+ (list:join targs+)))))
+         (#Meta [_ (#Form (#Cons [harg targs]))])
+         (do Lux:Monad
+           [harg+ (macro-expand harg)
+            targs+ (map% Lux:Monad macro-expand targs)]
+           (;return (:' SyntaxList (list ($form (list:++ harg+ (list:join (:' ($' List ($' List Syntax)) targs+))))))))
 
          (#Meta [_ (#Tuple members)])
          (do Lux:Monad
@@ -1392,7 +1415,7 @@
          _
          (return (:' SyntaxList (list syntax)))))
 
-(def (walk-type type)
+(def__ (walk-type type)
   (-> Syntax Syntax)
   (case' type
          (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag tag)]) parts]))])
@@ -1450,36 +1473,37 @@
 
                                     _
                                     [false tokens]))
-        ## parts (: (Maybe (, Syntax (List Syntax) Syntax))
-        ##          (case' tokens'
-        ##                 (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type #Nil])])
-        ##                 (#Some [($symbol name) #Nil type])
+        parts (: (Maybe (, Syntax (List Syntax) Syntax))
+                 (case' tokens'
+                        (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type #Nil])])
+                        (#Some [($symbol name) #Nil type])
 
-        ##                 (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) (#Cons [type #Nil])])
-        ##                 (#Some [($symbol name) args type])
+                        (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) (#Cons [type #Nil])])
+                        (#Some [($symbol name) args type])
 
-        ##                 _
-        ##                 #None))
+                        _
+                        #None))
         ]
-    (return (: (List Syntax) #Nil))
-    ## (case' parts
-    ##        (#Some [name args type])
-    ##        (let [with-export (: (List Syntax)
-    ##                             (if export?
-    ##                               (list (` (export' (~ name))))
-    ##                               #Nil))
-    ##              type' (: Syntax
-    ##                       (case' args
-    ##                              #Nil
-    ##                              type
-
-    ##                              _
-    ##                              (` (;All (~ name) [(~@ args)] (~ type)))))]
-    ##          (return (: (List Syntax)
-    ##                     (list& type' with-export))))
-
-    ##        #None
-    ##        (fail "Wrong syntax for deftype"))
+    ## (return (: (List Syntax) #Nil))
+    (case' parts
+           (#Some [name args type])
+           (let [with-export (: (List Syntax)
+                                (if export?
+                                  (list (` (export' (~ name))))
+                                  #Nil))
+                 type' (: Syntax
+                          (case' args
+                                 #Nil
+                                 type
+
+                                 _
+                                 (` (;All (~ name) [(~@ args)] (~ type)))))]
+             (return (: (List Syntax)
+                        (list& (` (def' (~ name) (;type` (~ type'))))
+                               with-export))))
+
+           #None
+           (fail "Wrong syntax for deftype"))
     ))
 
 (deftype #export (IO a)
@@ -1489,7 +1513,8 @@
   (case' tokens
          (#Cons [value #Nil])
          (let [blank ($symbol ["" ""])]
-           (return (list (` (lambda' (~ blank) (~ blank) (~ value))))))
+           (return (: (List Syntax)
+                      (list (` (lambda' (~ blank) (~ blank) (~ value)))))))
 
          _
          (fail "Wrong syntax for io")))
@@ -1508,6 +1533,51 @@
          _
          (fail "Wrong syntax for exec")))
 
+(defmacro #export (def tokens)
+  (let [[export? tokens'] (: (, Bool (List Syntax))
+                             (case' tokens
+                                    (#Cons [(#Meta [_ (#Tag ["" "export"])]) tokens'])
+                                    [true tokens']
+
+                                    _
+                                    [false tokens]))
+        parts (: (Maybe (, Syntax (List Syntax) (Maybe Syntax) Syntax))
+                 (case' tokens'
+                        (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [type (#Cons [body #Nil])])])
+                        (#Some [name args (#Some type) body])
+                        
+                        (#Cons [name (#Cons [type (#Cons [body #Nil])])])
+                        (#Some [name #Nil (#Some type) body])
+                        
+                        (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [body #Nil])])
+                        (#Some [name args #None body])
+                        
+                        (#Cons [name (#Cons [body #Nil])])
+                        (#Some [name #Nil #None body])
+
+                        _
+                        #None))]
+    (case' parts
+           (#Some [name args ?type body])
+           (let [body' (: Syntax
+                          (case' args
+                                 #Nil
+                                 body
+
+                                 _
+                                 (` (;lambda (~ name) [(~@ args)] (~ body)))))
+                 body'' (: Syntax
+                           (case' ?type
+                                  (#Some type)
+                                  (` (: (~ type) (~ body')))
+                                  
+                                  #None
+                                  body'))]
+             (return (: (List Syntax) (list (` (def' (~ name) (~ body'')))))))
+           
+           #None
+           (fail "Wrong syntax for def"))))
+
 (def (rejoin-pair pair)
   (-> (, Syntax Syntax) (List Syntax))
   (let [[left right] pair]
@@ -1515,24 +1585,26 @@
 
 (defmacro #export (case tokens)
   (case' tokens
-         (#Cons value branches)
+         (#Cons [value branches])
          (do Lux:Monad
            [expansions (map% Lux:Monad
                              (: (-> (, Syntax Syntax) (Lux (List (, Syntax Syntax))))
                                 (lambda expander [branch]
                                    (let [[pattern body] branch]
                                      (case' pattern
-                                            (#Cons [(#Meta [_ (#Symbol macro-name)]) macro-args])
+                                            (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) macro-args]))])
                                             (do Lux:Monad
-                                              [expansion (macro-expand (list& ($symbol macro-name) body macro-args))]
-                                              (map% Lux:Monad expander (as-pairs expansion)))
+                                              [expansion (macro-expand ($form (list& ($symbol macro-name) body macro-args)))
+                                               expansions (map% Lux:Monad expander (as-pairs (: (List Syntax) expansion)))]
+                                              (;return (list:join (: (List (List (, Syntax Syntax))) expansions))))
 
                                             _
                                             (;return (: (List (, Syntax Syntax)) (list branch)))))))
                              (as-pairs branches))]
-           (;return (: (List (, Syntax Syntax))
+           (;return (: (List Syntax)
                        (list (` (case' (~ value)
-                                       (~@ (|> expansions list:join (map rejoin-pair) list:join))))))))
+                                       (~@ (|> (: (List (List (, Syntax Syntax))) expansions) list:join (map rejoin-pair) list:join))
+                                       ))))))
 
          _
          (fail "Wrong syntax for case")))