Micro-optimizations.

12 files changed, 147 insertions, 185 deletions

diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux
index 73b018c95..9c7b7868d 100644
--- a/stdlib/source/lux/compiler/default.lux
+++ b/stdlib/source/lux/compiler/default.lux
@@ -54,8 +54,11 @@
       (#error.Error error)
 
       (#error.Success [source' output])
-      (#error.Success [[bundle (set@ #.source source' compiler)]
-                       output]))))
+      (let [[cursor _] output]
+        (#error.Success [[bundle (|> compiler
+                                     (set@ #.source source')
+                                     (set@ #.cursor cursor))]
+                         output])))))
 
 ## ## (def: (write-module target-dir file-name module-name module artifacts)
 ## ##   (-> File Text Text Module Artifacts (Process Any))
@@ -101,12 +104,7 @@
     (<| (phase.timed (name-of ..module-compilation-iteration) "ITERATION")
         (do phase.Monad<Operation>
           [code (statement.lift-analysis
-                 (do @
-                   [code (<| (phase.timed (name-of ..module-compilation-iteration) "syntax")
-                             (..read reader))
-                    #let [[cursor _] code]
-                    _ (analysis.set-cursor cursor)]
-                   (wrap code)))
+                 (..read reader))
            _ (<| (phase.timed (name-of ..module-compilation-iteration) "PHASE")
                  (totalS.phase code))]
           init.refresh)))
diff --git a/stdlib/source/lux/compiler/default/name.lux b/stdlib/source/lux/compiler/default/name.lux
index 925b0585d..184b2cab5 100644
--- a/stdlib/source/lux/compiler/default/name.lux
+++ b/stdlib/source/lux/compiler/default/name.lux
@@ -5,33 +5,32 @@
     ["." text
      format]]])
 
-(def: (sanitize char)
-  (-> Nat Text)
-  (case char
-    (^ (char "*")) "_ASTER_"
-    (^ (char "+")) "_PLUS_"
-    (^ (char "-")) "_DASH_"
-    (^ (char "/")) "_SLASH_"
-    (^ (char "\")) "_BSLASH_"
-    (^ (char "_")) "_UNDERS_"
-    (^ (char "%")) "_PERCENT_"
-    (^ (char "$")) "_DOLLAR_"
-    (^ (char "'")) "_QUOTE_"
-    (^ (char "`")) "_BQUOTE_"
-    (^ (char "@")) "_AT_"
-    (^ (char "^")) "_CARET_"
-    (^ (char "&")) "_AMPERS_"
-    (^ (char "=")) "_EQ_"
-    (^ (char "!")) "_BANG_"
-    (^ (char "?")) "_QM_"
-    (^ (char ":")) "_COLON_"
-    (^ (char ".")) "_PERIOD_"
-    (^ (char ",")) "_COMMA_"
-    (^ (char "<")) "_LT_"
-    (^ (char ">")) "_GT_"
-    (^ (char "~")) "_TILDE_"
-    (^ (char "|")) "_PIPE_"
-    _              (text.from-code char)))
+(`` (template: (!sanitize char)
+      ("lux syntax char case!" char
+       [["*"] "_ASTER_"
+        ["+"] "_PLUS_"
+        ["-"] "_DASH_"
+        ["/"] "_SLASH_"
+        ["\"] "_BSLASH_"
+        ["_"] "_UNDERS_"
+        ["%"] "_PERCENT_"
+        ["$"] "_DOLLAR_"
+        ["'"] "_QUOTE_"
+        ["`"] "_BQUOTE_"
+        ["@"] "_AT_"
+        ["^"] "_CARET_"
+        ["&"] "_AMPERS_"
+        ["="] "_EQ_"
+        ["!"] "_BANG_"
+        ["?"] "_QM_"
+        [":"] "_COLON_"
+        ["."] "_PERIOD_"
+        [","] "_COMMA_"
+        ["<"] "_LT_"
+        [">"] "_GT_"
+        ["~"] "_TILDE_"
+        ["|"] "_PIPE_"]
+       (text.from-code char))))
 
 (def: #export (normalize name)
   (-> Text Text)
@@ -40,7 +39,7 @@
            output ""]
       (if (n/< name/size idx)
         (recur (inc idx)
-               (|> (text.nth idx name) maybe.assume sanitize (format output)))
+               (|> ("lux text char" name idx) !sanitize (format output)))
         output))))
 
 (def: #export (definition [module short])
diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux
index 615075800..0a122bf3c 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis.lux
@@ -183,12 +183,12 @@
   (function (_ [bundle state])
     (let [old-source (get@ #.source state)]
       (case (action [bundle (set@ #.source source state)])
-        (#error.Error error)
-        (#error.Error error)
-
         (#error.Success [[bundle' state'] output])
         (#error.Success [[bundle' (set@ #.source old-source state')]
-                         output])))))
+                         output])
+
+        (#error.Error error)
+        (#error.Error error)))))
 
 (def: fresh-bindings
   (All [k v] (Bindings k v))
@@ -208,12 +208,12 @@
     (case (action [bundle (update@ #.scopes (|>> (#.Cons fresh-scope)) state)])
       (#error.Success [[bundle' state'] output])
       (case (get@ #.scopes state')
-        #.Nil
-        (#error.Error "Impossible error: Drained scopes!")
-
         (#.Cons head tail)
         (#error.Success [[bundle' (set@ #.scopes tail state')]
-                         [head output]]))
+                         [head output]])
+
+        #.Nil
+        (#error.Error "Impossible error: Drained scopes!"))
 
       (#error.Error error)
       (#error.Error error))))
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/case.lux b/stdlib/source/lux/compiler/default/phase/analysis/case.lux
index 2081ceb61..5044aed92 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/case.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/case.lux
@@ -276,9 +276,6 @@
 (def: #export (case analyse inputC branches)
   (-> Phase Code (List [Code Code]) (Operation Analysis))
   (.case branches
-    #.Nil
-    (///.throw cannot-have-empty-branches "")
-
     (#.Cons [patternH bodyH] branchesT)
     (do ///.Monad<Operation>
       [[inputT inputA] (//type.with-inference
@@ -297,4 +294,7 @@
 
            (#error.Error error)
            (///.fail error))]
-      (wrap (#//.Case inputA [outputH outputT])))))
+      (wrap (#//.Case inputA [outputH outputT])))
+
+    #.Nil
+    (///.throw cannot-have-empty-branches "")))
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux b/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux
index cf9abecd4..aff981e09 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/case/coverage.lux
@@ -213,14 +213,6 @@
 (def: #export (merge addition so-far)
   (-> Coverage Coverage (Error Coverage))
   (case [addition so-far]
-    ## The addition cannot possibly improve the coverage.
-    [_ #Exhaustive]
-    (ex.throw redundant-pattern [so-far addition])
-
-    ## The addition completes the coverage.
-    [#Exhaustive _]
-    (error/wrap #Exhaustive)
-
     [#Partial #Partial]
     (error/wrap #Partial)
 
@@ -269,14 +261,6 @@
 
     [(#Seq leftA rightA) (#Seq leftSF rightSF)]
     (case [(coverage/= leftSF leftA) (coverage/= rightSF rightA)]
-      ## There is nothing the addition adds to the coverage.
-      [#1 #1]
-      (ex.throw redundant-pattern [so-far addition])
-
-      ## The 2 sequences cannot possibly be merged.
-      [#0 #0]
-      (error/wrap (#Alt so-far addition))
-
       ## Same prefix
       [#1 #0]
       (do error.Monad<Error>
@@ -292,7 +276,23 @@
       [#0 #1]
       (do error.Monad<Error>
         [leftM (merge leftA leftSF)]
-        (wrap (#Seq leftM rightA))))
+        (wrap (#Seq leftM rightA)))
+
+      ## The 2 sequences cannot possibly be merged.
+      [#0 #0]
+      (error/wrap (#Alt so-far addition))
+
+      ## There is nothing the addition adds to the coverage.
+      [#1 #1]
+      (ex.throw redundant-pattern [so-far addition]))
+
+    ## The addition cannot possibly improve the coverage.
+    [_ #Exhaustive]
+    (ex.throw redundant-pattern [so-far addition])
+
+    ## The addition completes the coverage.
+    [#Exhaustive _]
+    (error/wrap #Exhaustive)
     
     ## The left part will always match, so the addition is redundant.
     (^multi [(#Seq left right) single]
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/scope.lux b/stdlib/source/lux/compiler/default/phase/analysis/scope.lux
index 2c34e7a44..2849e059d 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/scope.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/scope.lux
@@ -1,7 +1,8 @@
 (.module:
   [lux #*
    [control
-    monad]
+    monad
+    ["ex" exception (#+ exception:)]]
    [data
     [text ("text/." Equivalence<Text>)
      format]
@@ -46,13 +47,13 @@
   (loop [idx 0
          mappings (get@ [#.captured #.mappings] scope)]
     (case mappings
-      #.Nil
-      #.None
-
       (#.Cons [_name [_source-type _source-ref]] mappings')
       (if (text/= name _name)
         (#.Some [_source-type (#reference.Foreign idx)])
-        (recur (inc idx) mappings')))))
+        (recur (inc idx) mappings'))
+
+      #.Nil
+      #.None)))
 
 (def: (reference? name scope)
   (-> Text Scope Bit)
@@ -98,6 +99,12 @@
                      (#.Some [ref-type ref])]))
          )))))
 
+(exception: #export (cannot-create-local-binding-without-a-scope)
+  "")
+
+(exception: #export (invalid-scope-alteration)
+  "")
+
 (def: #export (with-local [name type] action)
   (All [a] (-> [Text Type] (Operation a) (Operation a)))
   (function (_ [bundle state])
@@ -121,13 +128,13 @@
                            output]))
 
             _
-            (error! "Invalid scope alteration."))
+            (ex.throw invalid-scope-alteration []))
 
           (#e.Error error)
           (#e.Error error)))
 
       _
-      (#e.Error "Cannot create local binding without a scope."))
+      (ex.throw cannot-create-local-binding-without-a-scope []))
     ))
 
 (do-template [<name> <val-type>]
@@ -159,27 +166,29 @@
       (case (action [bundle (update@ #.scopes
                                      (|>> (#.Cons (scope parent-name name)))
                                      state)])
-        (#e.Error error)
-        (#e.Error error)
-
         (#e.Success [[bundle' state'] output])
         (#e.Success [[bundle' (update@ #.scopes
                                        (|>> list.tail (maybe.default (list)))
                                        state')]
                      output])
-        ))
+
+        (#e.Error error)
+        (#e.Error error)))
     ))
 
+(exception: #export (cannot-get-next-reference-when-there-is-no-scope)
+  "")
+
 (def: #export next-local
   (Operation Register)
   (extension.lift
    (function (_ state)
      (case (get@ #.scopes state)
-       #.Nil
-       (#e.Error "Cannot get next reference when there is no scope.")
-       
        (#.Cons top _)
-       (#e.Success [state (get@ [#.locals #.counter] top)])))))
+       (#e.Success [state (get@ [#.locals #.counter] top)])
+
+       #.Nil
+       (ex.throw cannot-get-next-reference-when-there-is-no-scope [])))))
 
 (def: (ref-to-variable ref)
   (-> Ref Variable)
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/structure.lux b/stdlib/source/lux/compiler/default/phase/analysis/structure.lux
index 3988349e0..43cb8e0d2 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/structure.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/structure.lux
@@ -148,12 +148,12 @@
 
           _
           (case (type.apply (list inputT) funT)
-            #.None
-            (///.throw not-a-quantified-type funT)
-            
             (#.Some outputT)
             (//type.with-type outputT
-              (sum analyse tag valueC))))
+              (sum analyse tag valueC))
+
+            #.None
+            (///.throw not-a-quantified-type funT)))
         
         _
         (///.throw invalid-variant-type [expectedT tag valueC])))))
@@ -241,12 +241,12 @@
 
           _
           (case (type.apply (list inputT) funT)
-            #.None
-            (///.throw not-a-quantified-type funT)
-            
             (#.Some outputT)
             (//type.with-type outputT
-              (product analyse membersC))))
+              (product analyse membersC))
+
+            #.None
+            (///.throw not-a-quantified-type funT)))
         
         _
         (///.throw invalid-tuple-type [expectedT membersC])
@@ -317,13 +317,13 @@
                               (do @
                                 [key (extension.lift (macro.normalize key))]
                                 (case (dict.get key tag->idx)
-                                  #.None
-                                  (///.throw tag-does-not-belong-to-record [key recordT])
-
                                   (#.Some idx)
                                   (if (dict.contains? idx idx->val)
                                     (///.throw cannot-repeat-tag [key record])
-                                    (wrap (dict.put idx val idx->val))))))
+                                    (wrap (dict.put idx val idx->val)))
+
+                                  #.None
+                                  (///.throw tag-does-not-belong-to-record [key recordT]))))
                             (: (Dictionary Nat Code)
                                (dict.new number.Hash<Nat>))
                             record)
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/type.lux b/stdlib/source/lux/compiler/default/phase/analysis/type.lux
index 3eb574986..36fee29f8 100644
--- a/stdlib/source/lux/compiler/default/phase/analysis/type.lux
+++ b/stdlib/source/lux/compiler/default/phase/analysis/type.lux
@@ -21,12 +21,12 @@
   (All [a] (-> (tc.Check a) (Operation a)))
   (function (_ (^@ stateE [bundle state]))
     (case (action (get@ #.type-context state))
-      (#error.Error error)
-      ((///.fail error) stateE)
-
       (#error.Success [context' output])
       (#error.Success [[bundle (set@ #.type-context context' state)]
-                       output]))))
+                       output])
+
+      (#error.Error error)
+      ((///.fail error) stateE))))
 
 (def: #export with-fresh-env
   (All [a] (-> (Operation a) (Operation a)))
diff --git a/stdlib/source/lux/compiler/default/phase/extension.lux b/stdlib/source/lux/compiler/default/phase/extension.lux
index c87d8d54c..f5baf2a5b 100644
--- a/stdlib/source/lux/compiler/default/phase/extension.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension.lux
@@ -61,23 +61,26 @@
   (All [s i o]
     (-> Text (Handler s i o) (Operation s i o Any)))
   (function (_ [bundle state])
-    (if (dictionary.contains? name bundle)
-      (ex.throw cannot-overwrite name)
+    (case (dictionary.get name bundle)
+      #.None
       (#error.Success [[(dictionary.put name handler bundle) state]
-                       []]))))
+                       []])
+
+      _
+      (ex.throw cannot-overwrite name))))
 
 (def: #export (apply where phase [name parameters])
   (All [s i o]
     (-> Text (Phase s i o) (Extension i) (Operation s i o o)))
   (function (_ (^@ stateE [bundle state]))
     (case (dictionary.get name bundle)
-      #.None
-      (ex.throw unknown [where name bundle])
-      
       (#.Some handler)
       ((<| (//.timed (name-of ..apply) (%t name))
            ((handler name phase) parameters))
-       stateE))))
+       stateE)
+
+      #.None
+      (ex.throw unknown [where name bundle]))))
 
 (def: #export (localized get set transform)
   (All [s s' i o v]
@@ -87,11 +90,11 @@
     (function (_ [bundle state])
       (let [old (get state)]
         (case (operation [bundle (set (transform old) state)])
-          (#error.Error error)
-          (#error.Error error)
-
           (#error.Success [[bundle' state'] output])
-          (#error.Success [[bundle' (set old state')] output]))))))
+          (#error.Success [[bundle' (set old state')] output])
+
+          (#error.Error error)
+          (#error.Error error))))))
 
 (def: #export (temporary transform)
   (All [s i o v]
@@ -100,11 +103,11 @@
   (function (_ operation)
     (function (_ [bundle state])
       (case (operation [bundle (transform state)])
-        (#error.Error error)
-        (#error.Error error)
-
         (#error.Success [[bundle' state'] output])
-        (#error.Success [[bundle' state] output])))))
+        (#error.Success [[bundle' state] output])
+
+        (#error.Error error)
+        (#error.Error error)))))
 
 (def: #export (with-state state)
   (All [s i o v]
@@ -129,8 +132,8 @@
         (//.Operation [(Bundle s i o) s] v)))
   (function (_ [bundle state])
     (case (action state)
-      (#error.Error error)
-      (#error.Error error)
-
       (#error.Success [state' output])
-      (#error.Success [[bundle state'] output]))))
+      (#error.Success [[bundle state'] output])
+
+      (#error.Error error)
+      (#error.Error error))))
diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux
index 64edb791b..5fac5b1d0 100644
--- a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux
+++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux
@@ -1064,12 +1064,12 @@
                                               ## else
                                               (wrap #Fail)))))))]
     (case (list.search-all pass! candidates)
-      #.Nil
-      (////.throw no-candidates [class-name method-name (list.search-all hint! candidates)])
-      
       (#.Cons method #.Nil)
       (wrap method)
 
+      #.Nil
+      (////.throw no-candidates [class-name method-name (list.search-all hint! candidates)])
+      
       candidates
       (////.throw too-many-candidates [class-name method-name candidates]))))
 
@@ -1124,12 +1124,12 @@
                                          (if passes? (|>> #Pass) (|>> #Hint))
                                          (constructor-signature constructor))))))]
     (case (list.search-all pass! candidates)
-      #.Nil
-      (////.throw no-candidates [class-name ..constructor-method (list.search-all hint! candidates)])
-      
       (#.Cons constructor #.Nil)
       (wrap constructor)
 
+      #.Nil
+      (////.throw no-candidates [class-name ..constructor-method (list.search-all hint! candidates)])
+      
       candidates
       (////.throw too-many-candidates [class-name ..constructor-method candidates]))))
 
diff --git a/stdlib/source/lux/compiler/default/phase/translation.lux b/stdlib/source/lux/compiler/default/phase/translation.lux
index b1a224e80..8565cefcc 100644
--- a/stdlib/source/lux/compiler/default/phase/translation.lux
+++ b/stdlib/source/lux/compiler/default/phase/translation.lux
@@ -177,11 +177,11 @@
        (-> Text <inputT> (Operation anchor expression statement Any)))
      (function (_ (^@ state+ [bundle state]))
        (case (:: (get@ #host state) <name> label code)
-         (#error.Error error)
-         (ex.throw cannot-interpret error)
-         
          (#error.Success output)
-         (#error.Success [state+ output]))))]
+         (#error.Success [state+ output])
+
+         (#error.Error error)
+         (ex.throw cannot-interpret error))))]
 
   [evaluate! expression]
   [execute!  statement]
@@ -192,11 +192,11 @@
     (-> Name expression (Operation anchor expression statement [Text Any])))
   (function (_ (^@ stateE [bundle state]))
     (case (:: (get@ #host state) define! name code)
-      (#error.Error error)
-      (ex.throw cannot-interpret error)
-      
       (#error.Success output)
-      (#error.Success [stateE output]))))
+      (#error.Success [stateE output])
+
+      (#error.Error error)
+      (ex.throw cannot-interpret error))))
 
 (def: #export (save! name code)
   (All [anchor expression statement]
@@ -239,12 +239,12 @@
   (function (_ [bundle state])
     (let [cache (get@ #name-cache state)]
       (case (dictionary.get lux-name cache)
-        (#.Some old-host-name)
-        (ex.throw cannot-overwrite-lux-name [lux-name old-host-name host-name])
-
         #.None
         (#error.Success [[bundle
                           (update@ #name-cache
                                    (dictionary.put lux-name host-name)
                                    state)]
-                         []])))))
+                         []])
+
+        (#.Some old-host-name)
+        (ex.throw cannot-overwrite-lux-name [lux-name old-host-name host-name])))))
diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux
index 52ac38720..5ada2ad23 100644
--- a/stdlib/source/lux/compiler/default/syntax.lux
+++ b/stdlib/source/lux/compiler/default/syntax.lux
@@ -25,16 +25,15 @@
 ## [file-name, line, column] to keep track of their provenance and
 ## location, which is helpful for documentation and debugging.
 (.module:
-  [lux (#- int rev)
+  [lux #*
    [control
     monad
-    ["p" parser ("parser/." Monad<Parser>)]
     ["ex" exception (#+ exception:)]]
    [data
     ["." error (#+ Error)]
     ["." number]
     ["." text
-     ["l" lexer (#+ Offset Lexer)]
+     [lexer (#+ Offset)]
      format]
     [collection
      ["." list]
@@ -82,9 +81,6 @@
   [!n/- "lux i64 -"]
   )
 
-(type: #export Syntax
-  (-> Cursor (Lexer [Cursor Code])))
-
 (type: #export Aliases (Dictionary Text Text))
 (def: #export no-aliases Aliases (dictionary.new text.Hash<Text>))
 
@@ -121,42 +117,6 @@
 ## encoded on the parser.
 (def: #export name-separator ".")
 
-## These are very simple parsers that just cut chunks of text in
-## specific shapes and then use decoders already present in the
-## standard library to actually produce the values from the literals.
-(def: rich-digit
-  (Lexer Text)
-  (p.either l.decimal
-            (p.after (l.this "_") (parser/wrap ""))))
-
-(def: rich-digits^
-  (Lexer Text)
-  (l.and l.decimal
-         (l.some rich-digit)))
-
-(def: sign^ (l.one-of "+-"))
-
-(def: #export (frac where)
-  Syntax
-  (do p.Monad<Parser>
-    [chunk ($_ l.and
-               sign^
-               rich-digits^
-               (l.one-of ".")
-               rich-digits^
-               (p.default ""
-                          ($_ l.and
-                              (l.one-of "eE")
-                              sign^
-                              rich-digits^)))]
-    (case (:: number.Codec<Text,Frac> decode chunk)
-      (#.Left error)
-      (p.fail error)
-
-      (#.Right value)
-      (wrap [(update@ #.column (n/+ (text.size chunk)) where)
-             [where (#.Frac value)]]))))
-
 (exception: #export (end-of-file {module Text})
   (ex.report ["Module" (%t module)]))
 
@@ -179,13 +139,6 @@
 (exception: #export (cannot-close-composite-expression {closing-char Char})
   (ex.report ["Closing Character" (text.from-code closing-char)]))
 
-(def: (ast current-module aliases)
-  (-> Text Aliases Syntax)
-  (function (ast' where)
-    ($_ p.either
-        (..frac where)
-        )))
-
 (type: Parser
   (-> Source (Error [Source Code])))
 
@@ -272,11 +225,11 @@
 
 (template: (!guarantee-no-new-lines content body)
   (case ("lux text index" content (static text.new-line) 0)
-    (#.Some g!_)
-    (ex.throw ..text-cannot-contain-new-lines content)
+    #.None
+    body
 
     g!_
-    body))
+    (ex.throw ..text-cannot-contain-new-lines content)))
 
 (template: (!read-text where offset source-code)
   (case ("lux text index" source-code (static ..text-delimiter) offset)