From 6e30954da01860c6488eab66216c3c2e97b65ea5 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 28 Aug 2018 22:03:25 -0400
Subject: Micro-optimizations.

---
 stdlib/source/lux/type/check.lux | 51 +++++++++++++++++++++++++---------------
 1 file changed, 32 insertions(+), 19 deletions(-)

(limited to 'stdlib/source')

diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux
index 97ccc0626..e1324a691 100644
--- a/stdlib/source/lux/type/check.lux
+++ b/stdlib/source/lux/type/check.lux
@@ -16,14 +16,21 @@
      ["." set (#+ Set)]]]]
   ["." // ("type/." Equivalence<Type>)])
 
+(template: (!n/= reference subject)
+  ("lux i64 =" subject reference))
+
+(template: (!text/= reference subject)
+  ("lux text =" subject reference))
+
 (exception: #export (unknown-type-var {id Nat})
-  (nat/encode id))
+  (ex.report ["ID" (nat/encode id)]))
 
 (exception: #export (unbound-type-var {id Nat})
-  (nat/encode id))
+  (ex.report ["ID" (nat/encode id)]))
 
 (exception: #export (invalid-type-application {funcT Type} {argT Type})
-  (//.to-text (#.Apply argT funcT)))
+  (ex.report ["Type function" (//.to-text funcT)]
+             ["Type argument" (//.to-text argT)]))
 
 (exception: #export (cannot-rebind-var {id Nat} {type Type} {bound Type})
   (ex.report ["Var" (nat/encode id)]
@@ -109,7 +116,7 @@
 
     (#.Cons [var-id var-type]
             plist')
-    (if (n/= id var-id)
+    (if (!n/= id var-id)
       (#.Some var-type)
       (var::get id plist'))
     ))
@@ -126,7 +133,7 @@
 
     (#.Cons [var-id var-type]
             plist')
-    (if (n/= id var-id)
+    (if (!n/= id var-id)
       (#.Cons [var-id value]
               plist')
       (#.Cons [var-id var-type]
@@ -141,7 +148,7 @@
 
     (#.Cons [var-id var-type]
             plist')
-    (if (n/= id var-id)
+    (if (!n/= id var-id)
       plist'
       (#.Cons [var-id var-type]
               (var::remove id plist')))
@@ -283,7 +290,7 @@
         (#.Some (#.Some type))
         (case type
           (#.Var post)
-          (if (n/= id post)
+          (if (!n/= id post)
             (#error.Success [context output])
             (recur post (set.add post output)))
           
@@ -381,7 +388,7 @@
       (List Assumption)
       Var Var
       (Check (List Assumption)))
-  (if (n/= idE idA)
+  (if (!n/= idE idA)
     (check/wrap assumptions)
     (do Monad<Check>
       [ebound (attempt (peek idE))
@@ -587,15 +594,21 @@
          [#.ExQ ..existential])
 
         [(#.Primitive e-name e-params) (#.Primitive a-name a-params)]
-        (if (and (text/= e-name a-name)
-                 (n/= (list.size e-params)
-                      (list.size a-params)))
-          (do Monad<Check>
-            [assumptions (monad.fold Monad<Check>
-                                     (function (_ [e a] assumptions) (check' e a assumptions))
-                                     assumptions
-                                     (list.zip2 e-params a-params))]
-            (check/wrap assumptions))
+        (if (!text/= e-name a-name)
+          (loop [e-params e-params
+                 a-params a-params
+                 assumptions assumptions]
+            (case [e-params a-params]
+              [#.Nil #.Nil]
+              (check/wrap assumptions)
+              
+              [(#.Cons e-head e-tail) (#.Cons a-head a-tail)]
+              (do Monad<Check>
+                [assumptions' (check' e-head a-head assumptions)]
+                (recur e-tail a-tail assumptions'))
+
+              _
+              (fail "")))
           (fail ""))
 
         (^template [<compose>]
@@ -612,7 +625,7 @@
           (check' eO aO assumptions))
 
         [(#.Ex e!id) (#.Ex a!id)]
-        (if (n/= e!id a!id)
+        (if (!n/= e!id a!id)
           (check/wrap assumptions)
           (fail ""))
 
@@ -656,7 +669,7 @@
       (wrap (#.Primitive name paramsT+')))
 
     (^or (#.Parameter _) (#.Ex _) (#.Named _))
-    (:: Monad<Check> wrap inputT)
+    (check/wrap inputT)
 
     (^template [<tag>]
       (<tag> leftT rightT)
-- 
cgit v1.2.3