From ca297162d5416a8c7b8af5f27757900d82d3ad03 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 12 Nov 2017 23:49:34 -0400
Subject: - Fixed some bugs. - Improved error reporting. - Optimized
 pattern-matching a bit.

---
 new-luxc/source/luxc/lang/analysis/structure.lux | 30 ++++++++++++++----------
 1 file changed, 18 insertions(+), 12 deletions(-)

(limited to 'new-luxc/source/luxc/lang/analysis/structure.lux')

diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux
index 0284245e1..5cac1a0d3 100644
--- a/new-luxc/source/luxc/lang/analysis/structure.lux
+++ b/new-luxc/source/luxc/lang/analysis/structure.lux
@@ -40,9 +40,9 @@
   (do meta;Monad<Meta>
     [expectedT meta;expected-type]
     (&;with-stacked-errors
-      (function [_] (Not-Variant-Type (format "  Tag: " (%n tag) "\n"
+      (function [_] (Not-Variant-Type (format " Type: " (%type expectedT) "\n"
                                               "Value: " (%code  valueC) "\n"
-                                              " Type: " (%type expectedT))))
+                                              "  Tag: " (%n tag))))
       (case expectedT
         (#;Sum _)
         (let [flat (type;flatten-variant expectedT)
@@ -102,9 +102,9 @@
             (analyse-sum analyse tag valueC)))
         
         _
-        (&;throw Not-Variant-Type (format "  Tag: " (%n tag) "\n"
-                                          "Value: " (%code  valueC) "\n"
-                                          " Type: " (%type expectedT)))))))
+        (&;throw Not-Variant-Type (format " Type: " (%type expectedT) "\n"
+                                          "  Tag: " (%n tag) "\n"
+                                          "Value: " (%code  valueC)))))))
 
 (def: (analyse-typed-product analyse members)
   (-> &;Analyser (List Code) (Meta la;Analysis))
@@ -302,10 +302,16 @@
   (-> &;Analyser (List [Code Code]) (Meta la;Analysis))
   (do meta;Monad<Meta>
     [members (normalize members)
-     [members recordT] (order members)
-     expectedT meta;expected-type
-     inferenceT (&inference;record recordT)
-     [inferredT membersA] (&inference;apply-function analyse inferenceT members)
-     _ (&;with-type-env
-         (tc;check expectedT inferredT))]
-    (wrap (la;product membersA))))
+     [membersC recordT] (order members)
+     expectedT meta;expected-type]
+    (case expectedT
+      (#;Var _)
+      (do @
+        [inferenceT (&inference;record recordT)
+         [inferredT membersA] (&inference;apply-function analyse inferenceT membersC)
+         _ (&;with-type-env
+             (tc;check expectedT inferredT))]
+        (wrap (la;product membersA)))
+
+      _
+      (analyse-product analyse membersC))))
-- 
cgit v1.2.3