Merge pull request #50 from LuxLang/fix-composite-close

Fixed a bug when closing composite syntax (forms, tuples & records) i…
author: Eduardo Julián 2019-04-14 00:49:49 -0400
committer: GitHub 2019-04-14 00:49:49 -0400
commit: cbe39845f7a0e5839345a6a02ac7662562d26e33 (patch)
tree: 07a16c341f5da86be68dc6864e6ddcd334d7629f /stdlib
parent: 2facc3b22a40d5fd29fcf3877d796e7771f50241 (diff)
parent: bb1f029e20a522546907fca47370649a1668c1bf (diff)
3 files changed, 154 insertions, 107 deletions
diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux
index ad1600856..55000aa31 100644
--- a/stdlib/source/lux/macro/template.lux
+++ b/stdlib/source/lux/macro/template.lux
@@ -24,8 +24,8 @@
 (syntax: #export (with-locals {locals (s.tuple (p.some s.local-identifier))}
                    body)
   (do @
-    [g!locals (|> (//.gensym "local")
-                  (list.repeat (list.size locals))
+    [g!locals (|> locals
+                  (list@map //.gensym)
                   (monad.seq @))]
     (wrap (list (` (.with-expansions [(~+ (|> (list.zip2 locals g!locals)
                                               (list@map (function (_ [name identifier])
diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux
index 8cea72d0e..f5166fc25 100644
--- a/stdlib/source/lux/tool/compiler/default/init.lux
+++ b/stdlib/source/lux/tool/compiler/default/init.lux
@@ -94,7 +94,7 @@
                                 #///statement.phase generate}}]))
 
 (type: Reader
-  (-> Source (Error [Source Code])))
+  (-> Source (Either [Source Text] [Source Code])))
 
 (def: (reader current-module aliases [cursor offset source-code])
   (-> Module Aliases Source (///analysis.Operation Reader))
@@ -106,7 +106,7 @@
   (-> Source Reader (///analysis.Operation [Source Code]))
   (function (_ [bundle compiler])
     (case (reader source)
-      (#error.Failure error)
+      (#error.Failure [source' error])
       (#error.Failure error)
 
       (#error.Success [source' output])
diff --git a/stdlib/source/lux/tool/compiler/default/syntax.lux b/stdlib/source/lux/tool/compiler/default/syntax.lux
index af538b1a8..d5ea0757e 100644
--- a/stdlib/source/lux/tool/compiler/default/syntax.lux
+++ b/stdlib/source/lux/tool/compiler/default/syntax.lux
@@ -42,7 +42,9 @@
      format]
     [collection
      ["." list]
-     ["." dictionary (#+ Dictionary)]]]])
+     ["." dictionary (#+ Dictionary)]]]
+   [macro
+    ["." template]]])
 
 ## TODO: Optimize how forms, tuples & records are parsed in the end.
 ## There is repeated-work going on when parsing the white-space before the
@@ -151,7 +153,7 @@
                               (input-at offset source-code))]))
 
 (type: (Parser a)
-  (-> Source (Error [Source a])))
+  (-> Source (Either [Source Text] [Source a])))
 
 (template: (!with-char+ @source-code-size @source-code @offset @char @else @body)
   (if (!i/< (:coerce Int @source-code-size)
@@ -165,46 +167,74 @@
 
 (template: (!letE <binding> <computation> <body>)
   (case <computation>
-    (#error.Success <binding>)
+    (#.Right <binding>)
     <body>
     
-    (#error.Failure error)
-    (#error.Failure error)))
+    (#.Left error)
+    (#.Left error)))
 
-(def: close-signal "CLOSE")
+(template: (!horizontal where offset source-code)
+  [(update@ #.column inc where)
+   (!inc offset)
+   source-code])
 
-(with-expansions [<cannot-close> (as-is (ex.throw cannot-close-composite-expression [closing-char source-code end]))]
-  (def: (read-close closing-char source-code//size source-code offset)
-    (-> Char Nat Text Offset (Error Offset))
-    (loop [end offset]
-      (<| (!with-char+ source-code//size source-code end char <cannot-close>
+(template: (!new-line where)
+  ## (-> Cursor Cursor)
+  (let [[where::file where::line where::column] where]
+    [where::file (!inc where::line) 0]))
+
+(template: (!vertical where offset source-code)
+  [(!new-line where)
+   (!inc offset)
+   source-code])
+
+(def: close-signal
+  (template.with-locals [g!close-signal]
+    (template.text [g!close-signal])))
+
+(template: (!cannot-close close-char where offset source-code)
+  (#.Left [[where offset source-code]
+           (ex.construct cannot-close-composite-expression [close-char source-code offset])]))
+
+(with-expansions [<cannot-close> (!cannot-close closing-char where offset source-code)
+                  <horizontal> (as-is (!horizontal where offset source-code))]
+  (def: (read-close closing-char source)
+    (-> Char (Parser Any))
+    (loop [[where offset source-code] source]
+      (<| (!with-char+ ("lux text size" source-code) source-code offset char <cannot-close>
             (if (!n/= closing-char char)
-              (#error.Success (!inc end))
+              (#.Right [<horizontal> []])
               (`` ("lux syntax char case!" char
                    [[(~~ (static ..space))
-                     (~~ (static text.carriage-return))
-                     (~~ (static text.new-line))]
-                    (recur (!inc end))]
+                     (~~ (static text.carriage-return))]
+                    (recur <horizontal>)
+
+                    [(~~ (static text.new-line))]
+                    (recur (!vertical where offset source-code))]
 
                    ## else
                    <cannot-close>))))))))
 
 (template [<name> <close> <tag> <context>]
-  [(`` (def: (<name> parse source)
-         (-> (Parser Code) (Parser Code))
-         (let [[_ _ source-code] source
-               source-code//size ("lux text size" source-code)]
-           (loop [source source
-                  stack (: (List Code) #.Nil)]
-             (case (parse source)
-               (#error.Success [source' top])
-               (recur source' (#.Cons top stack))
-               
-               (#error.Failure error)
-               (let [[where offset _] source]
-                 (!letE offset' (read-close (char (~~ (static <close>))) source-code//size source-code offset)
-                        (#error.Success [[(update@ #.column inc where) offset' source-code]
-                                         [where (<tag> (list.reverse stack))]]))))))))]
+  [(with-expansions [<cannot-close> (!cannot-close (`` (char (~~ (static <close>)))) where' offset' source-code')]
+     (def: (<name> parse source)
+       (-> (Parser Code) (Parser Code))
+       (let [[where _ _] source]
+         (loop [source source
+                stack (: (List Code) #.Nil)]
+           (case (parse source)
+             (#.Right [source' top])
+             (recur source' (#.Cons top stack))
+             
+             (#.Left [source' error])
+             (if (is? ..close-signal error)
+               (let [[where' offset' source-code'] source']
+                 (<| (!with-char source-code' offset' @close <cannot-close>)
+                     (if (!n/= (`` (char (~~ (static <close>)))) @close)
+                       (#.Right [[where' (!inc offset') source-code']
+                                 [where (<tag> (list.reverse stack))]])
+                       <cannot-close>)))
+               (#.Left [source' error])))))))]
 
   ## Form and tuple syntax is mostly the same, differing only in the
   ## delimiters involved.
@@ -213,44 +243,50 @@
   [parse-tuple ..close-tuple #.Tuple "Tuple"]
   )
 
-(def: (parse-record parse source)
-  (-> (Parser Code) (Parser Code))
-  (let [[_ _ source-code] source
-        source-code//size ("lux text size" source-code)]
-    (loop [source source
-           stack (: (List [Code Code]) #.Nil)]
-      (case (parse source)
-        (#error.Success [sourceF field])
-        (!letE [sourceFV value] (parse sourceF)
-               (recur sourceFV (#.Cons [field value] stack)))
-
-        (#error.Failure error)
-        (let [[where offset _] source]
-          (!letE offset' (read-close (`` (char (~~ (static ..close-record)))) source-code//size source-code offset)
-                 (#error.Success [[(update@ #.column inc where) offset' source-code]
-                                  [where (#.Record (list.reverse stack))]])))))))
-
-(template: (!guarantee-no-new-lines content body)
+(with-expansions [<cannot-close> (!cannot-close (`` (char (~~ (static ..close-record)))) where' offset' source-code')]
+  (def: (parse-record parse source)
+    (-> (Parser Code) (Parser Code))
+    (let [[where _ _] source]
+      (loop [source source
+             stack (: (List [Code Code]) #.Nil)]
+        (case (parse source)
+          (#.Right [sourceF field])
+          (!letE [sourceFV value] (parse sourceF)
+                 (recur sourceFV (#.Cons [field value] stack)))
+
+          (#.Left [source' error])
+          (if (is? ..close-signal error)
+            (let [[where' offset' source-code'] source']
+              (<| (!with-char source-code' offset' @close <cannot-close>)
+                  (if (!n/= (`` (char (~~ (static ..close-record)))) @close)
+                    (#.Right [[where' (!inc offset') source-code']
+                              [where (#.Record (list.reverse stack))]])
+                    <cannot-close>)))
+            (#.Left [source' error])))))))
+
+(template: (!guarantee-no-new-lines where offset source-code content body)
   (case ("lux text index" 0 (static text.new-line) content)
     #.None
     body
 
     g!_
-    (ex.throw ..text-cannot-contain-new-lines content)))
+    (#.Left [[where offset source-code]
+             (ex.construct ..text-cannot-contain-new-lines content)])))
 
 (template: (!read-text where offset source-code)
   (case ("lux text index" offset (static ..text-delimiter) source-code)
     (#.Some g!end)
     (let [g!content (!clip offset g!end source-code)]
-      (<| (!guarantee-no-new-lines g!content)
-          (#error.Success [[(update@ #.column (n/+ (!n/- offset g!end)) where)
-                            (!inc g!end)
-                            source-code]
-                           [where
-                            (#.Text g!content)]])))
+      (<| (!guarantee-no-new-lines where offset source-code g!content)
+          (#.Right [[(update@ #.column (n/+ (!n/- offset g!end)) where)
+                     (!inc g!end)
+                     source-code]
+                    [where
+                     (#.Text g!content)]])))
     
     _
-    (ex.throw unrecognized-input [where "Text" source-code offset])))
+    (#.Left [[where offset source-code]
+             (ex.construct unrecognized-input [where "Text" source-code offset])])))
 
 (def: digit-bottom Nat (!dec (char "0")))
 (def: digit-top Nat (!inc (char "9")))
@@ -288,17 +324,23 @@
       (!digit? char)))
 
 (template: (!number-output <start> <end> <codec> <tag>)
-  (!letE output (:: <codec> decode (!clip <start> <end> source-code))
-         (#error.Success [[(update@ #.column (n/+ (!n/- <start> <end>)) where)
-                           <end>
-                           source-code]
-                          [where (<tag> output)]])))
+  (case (:: <codec> decode (!clip <start> <end> source-code))
+    (#.Right output)
+    (#.Right [[(update@ #.column (n/+ (!n/- <start> <end>)) where)
+               <end>
+               source-code]
+              [where (<tag> output)]])
+    
+    (#.Left error)
+    (#.Left [[where <start> source-code]
+             error])))
 
 (def: no-exponent Offset 0)
 
 (with-expansions [<int-output> (as-is (!number-output start end int.decimal #.Int))
                   <frac-output> (as-is (!number-output start end frac.decimal #.Frac))
-                  <failure> (ex.throw unrecognized-input [where "Frac" source-code offset])]
+                  <failure> (#.Left [[where offset source-code]
+                                     (ex.construct unrecognized-input [where "Frac" source-code offset])])]
   (def: (parse-frac source-code//size start [where offset source-code])
     (-> Nat Offset (Parser Code))
     (loop [end offset
@@ -356,10 +398,10 @@
           (parse-signed offset [where (!inc/2 offset) source-code])
           (!parse-full-name offset [where (!inc offset) source-code] where #.Identifier)))))
 
-(with-expansions [<output> (#error.Success [[(update@ #.column (n/+ (!n/- start end)) where)
-                                             end
-                                             source-code]
-                                            (!clip start end source-code)])]
+(with-expansions [<output> (#.Right [[(update@ #.column (n/+ (!n/- start end)) where)
+                                      end
+                                      source-code]
+                                     (!clip start end source-code)])]
   (def: (parse-name-part start [where offset source-code])
     (-> Offset (Parser Text))
     (let [source-code//size ("lux text size" source-code)]
@@ -369,39 +411,42 @@
               (recur (!inc end))
               <output>))))))
 
-(template: (!new-line where)
-  ## (-> Cursor Cursor)
-  (let [[where::file where::line where::column] where]
-    [where::file (!inc where::line) 0]))
+(template: (!failure where offset source-code)
+  (#.Left [[where offset source-code]
+           (ex.construct unrecognized-input [where "General" source-code offset])]))
+
+(template: (!end-of-file where offset source-code current-module)
+  (#.Left [[where offset source-code]
+           (ex.construct ..end-of-file current-module)]))
 
-(with-expansions [<end-of-file> (ex.throw end-of-file current-module)
-                  <failure> (ex.throw unrecognized-input [where "General" source-code offset/0])
-                  <close!> (#error.Failure close-signal)
+(with-expansions [<close!> (#.Left [[where offset/0 source-code] ..close-signal])
                   <consume-1> (as-is [where (!inc offset/0) source-code])
                   <consume-2> (as-is [where (!inc/2 offset/0) source-code])]
 
   (template: (!parse-half-name @offset @char @module)
     (cond (!name-char?|head @char)
           (!letE [source' name] (..parse-name-part @offset [where (!inc @offset) source-code])
-                 (#error.Success [source' [@module name]]))
+                 (#.Right [source' [@module name]]))
 
           ## else
-          <failure>))
+          (!failure where @offset source-code)))
 
   (`` (def: (parse-short-name current-module [where offset/0 source-code])
         (-> Text (Parser Name))
-        (<| (!with-char source-code offset/0 char/0 <end-of-file>)
+        (<| (!with-char source-code offset/0 char/0
+              (!end-of-file where offset/0 source-code current-module))
             (if (!n/= (char (~~ (static ..name-separator))) char/0)
               (let [offset/1 (!inc offset/0)]
-                (<| (!with-char source-code offset/1 char/1 <end-of-file>)
+                (<| (!with-char source-code offset/1 char/1
+                      (!end-of-file where offset/1 source-code current-module))
                     (!parse-half-name offset/1 char/1 current-module)))
               (!parse-half-name offset/0 char/0 ..prelude)))))
 
   (template: (!parse-short-name @current-module @source @where @tag)
     (!letE [source' name] (..parse-short-name @current-module @source)
-           (#error.Success [source' [@where (@tag name)]])))
+           (#.Right [source' [@where (@tag name)]])))
 
-  (with-expansions [<simple> (as-is (#error.Success [source' ["" simple]]))]
+  (with-expansions [<simple> (as-is (#.Right [source' ["" simple]]))]
     (`` (def: (parse-full-name start source)
           (-> Offset (Parser Name))
           (!letE [source' simple] (..parse-name-part start source)
@@ -410,12 +455,12 @@
                        (if (!n/= (char (~~ (static ..name-separator))) char/separator)
                          (let [offset'' (!inc offset')]
                            (!letE [source'' complex] (..parse-name-part offset'' [where' offset'' source-code'])
-                                  (#error.Success [source'' [simple complex]])))
+                                  (#.Right [source'' [simple complex]])))
                          <simple>)))))))
 
   (template: (!parse-full-name @offset @source @where @tag)
     (!letE [source' full-name] (..parse-full-name @offset @source)
-           (#error.Success [source' [@where (@tag full-name)]])))
+           (#.Right [source' [@where (@tag full-name)]])))
 
   (`` (template: (<<closers>>)
         [(~~ (static ..close-form))
@@ -426,20 +471,19 @@
   ## (grammar: lux-grammar
   ##   [expression ...]
   ##   [form "(" [#* expression] ")"])
-  
-  (with-expansions [<parse> (as-is (parse current-module aliases source-code//size))
-                    <horizontal-move> (as-is (recur [(update@ #.column inc where)
-                                                     (!inc offset/0)
-                                                     source-code]))]
+
+  (with-expansions [<recur> (as-is (parse current-module aliases source-code//size))
+                    <horizontal-move> (as-is (recur (!horizontal where offset/0 source-code)))]
     (def: #export (parse current-module aliases source-code//size)
       (-> Text Aliases Nat (Parser Code))
       ## The "exec []" is only there to avoid function fusion.
       ## This is to preserve the loop as much as possible and keep it tight.
       (exec []
         (function (recur [where offset/0 source-code])
-          (<| (!with-char+ source-code//size source-code offset/0 char/0 <end-of-file>)
-              ## The space was singled-out for special treatment
-              ## because of how common it is.
+          (<| (!with-char+ source-code//size source-code offset/0 char/0
+                (!end-of-file where offset/0 source-code current-module))
+              ## TODO: Add ..space as just another case for "lux syntax char case!" ASAP.
+              ## It"s currently failing for some reason.
               (`` (if (!n/= (char (~~ (static ..space))) char/0)
                     <horizontal-move>
                     ("lux syntax char case!" char/0
@@ -448,19 +492,19 @@
                       <horizontal-move>
                       
                       [(~~ (static text.new-line))]
-                      (recur [(!new-line where) (!inc offset/0) source-code])
+                      (recur (!vertical where offset/0 source-code))
 
                       ## Form
                       [(~~ (static ..open-form))]
-                      (parse-form <parse> <consume-1>)
+                      (parse-form <recur> <consume-1>)
 
                       ## Tuple
                       [(~~ (static ..open-tuple))]
-                      (parse-tuple <parse> <consume-1>)
+                      (parse-tuple <recur> <consume-1>)
 
                       ## Record
                       [(~~ (static ..open-record))]
-                      (parse-record <parse> <consume-1>)
+                      (parse-record <recur> <consume-1>)
 
                       ## Text
                       [(~~ (static ..text-delimiter))]
@@ -470,7 +514,8 @@
                       ## Special code
                       [(~~ (static ..sigil))]
                       (let [offset/1 (!inc offset/0)]
-                        (<| (!with-char+ source-code//size source-code offset/1 char/1 <end-of-file>)
+                        (<| (!with-char+ source-code//size source-code offset/1 char/1
+                              (!end-of-file where offset/1 source-code current-module))
                             ("lux syntax char case!" char/1
                              [[(~~ (static ..name-separator))]
                               (!parse-short-name current-module <consume-2> where #.Tag)
@@ -479,17 +524,17 @@
                               [(~~ (static ..sigil))]
                               (case ("lux text index" (!inc offset/1) (static text.new-line) source-code)
                                 (#.Some end)
-                                (recur [(!new-line where) (!inc end) source-code])
+                                (recur (!vertical where end source-code))
                                 
                                 _
-                                <end-of-file>)
+                                (!end-of-file where offset/1 source-code current-module))
 
                               (~~ (template [<char> <bit>]
                                     [[<char>]
-                                     (#error.Success [[(update@ #.column (|>> !inc/2) where)
-                                                       (!inc offset/1)
-                                                       source-code]
-                                                      [where (#.Bit <bit>)]])]
+                                     (#.Right [[(update@ #.column (|>> !inc/2) where)
+                                                (!inc offset/1)
+                                                source-code]
+                                               [where (#.Bit <bit>)]])]
 
                                     ["0" #0]
                                     ["1" #1]))]
@@ -499,12 +544,13 @@
                                    (!parse-full-name offset/1 <consume-2> where #.Tag)
 
                                    ## else
-                                   <failure>))))
+                                   (!failure where offset/0 source-code)))))
 
                       ## Coincidentally (= name-separator frac-separator)
                       [(~~ (static ..name-separator))]
                       (let [offset/1 (!inc offset/0)]
-                        (<| (!with-char+ source-code//size source-code offset/1 char/1 <end-of-file>)
+                        (<| (!with-char+ source-code//size source-code offset/1 char/1
+                              (!end-of-file where offset/1 source-code current-module))
                             (if (!digit? char/1)
                               (let [offset/2 (!inc offset/1)]
                                 (!parse-rev source-code//size offset/0 where offset/2 source-code))
@@ -512,7 +558,8 @@
 
                       [(~~ (static ..positive-sign))
                        (~~ (static ..negative-sign))]
-                      (!parse-signed source-code//size offset/0 where source-code <end-of-file>)
+                      (!parse-signed source-code//size offset/0 where source-code
+                                     (!end-of-file where offset/0 source-code current-module))
 
                       ## Invalid characters at this point...
                       (~~ (<<closers>>))
author	Eduardo Julián	2019-04-14 00:49:49 -0400
committer	GitHub	2019-04-14 00:49:49 -0400
commit	cbe39845f7a0e5839345a6a02ac7662562d26e33 (patch)
tree	07a16c341f5da86be68dc6864e6ddcd334d7629f /stdlib
parent	2facc3b22a40d5fd29fcf3877d796e7771f50241 (diff)
parent	bb1f029e20a522546907fca47370649a1668c1bf (diff)