From 686a46f569b818681583e6ce75b37b25642b375b Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 14 Nov 2017 14:59:45 -0400
Subject: - Removed "lux text last-index" procedure. - Removed "lux text trim"
 procedure. - Modified "lux text clip" procedure. - Some bug fixes.

---
 new-luxc/source/luxc/lang/analysis/structure.lux | 75 ++++++++++++++++--------
 1 file changed, 52 insertions(+), 23 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 1f1ef15d7..d2107c640 100644
--- a/new-luxc/source/luxc/lang/analysis/structure.lux
+++ b/new-luxc/source/luxc/lang/analysis/structure.lux
@@ -85,26 +85,47 @@
          [#;ExQ tc;var])
 
         (#;Apply inputT funT)
-        (case (type;apply (list inputT) funT)
-          #;None
-          (&;throw Not-Quantified-Type (%type funT))
-          
-          (#;Some outputT)
-          (&;with-expected-type outputT
-            (analyse-sum analyse tag valueC)))
+        (case funT
+          (#;Var funT-id)
+          (do @
+            [?funT' (&;with-type-env (tc;read funT-id))]
+            (case ?funT'
+              (#;Some funT')
+              (&;with-expected-type (#;Apply inputT funT')
+                (analyse-sum analyse tag valueC))
+
+              _
+              (&;throw Not-Variant-Type (format " Type: " (%type expectedT) "\n"
+                                                "  Tag: " (%n tag) "\n"
+                                                "Value: " (%code  valueC)))))
+
+          _
+          (case (type;apply (list inputT) funT)
+            #;None
+            (&;throw Not-Quantified-Type (%type funT))
+            
+            (#;Some outputT)
+            (&;with-expected-type outputT
+              (analyse-sum analyse tag valueC))))
         
         _
         (&;throw Not-Variant-Type (format " Type: " (%type expectedT) "\n"
                                           "  Tag: " (%n tag) "\n"
                                           "Value: " (%code  valueC)))))))
 
-(def: (analyse-typed-product analyse members)
+(def: (analyse-typed-product analyse membersC+)
   (-> &;Analyser (List Code) (Meta la;Analysis))
   (do meta;Monad<Meta>
     [expectedT meta;expected-type]
     (loop [expectedT expectedT
-           members members]
-      (case [expectedT members]
+           membersC+ membersC+]
+      (case [expectedT membersC+]
+        ## If the tuple runs out, whatever expression is the last gets
+        ## matched to the remaining type.
+        [tailT (#;Cons tailC #;Nil)]
+        (&;with-expected-type tailT
+          (analyse tailC))
+
         ## If the type and the code are still ongoing, match each
         ## sub-expression to its corresponding type.
         [(#;Product leftT rightT) (#;Cons leftC rightC)]
@@ -114,12 +135,6 @@
            rightA (recur rightT rightC)]
           (wrap (` [(~ leftA) (~ rightA)])))
 
-        ## If the tuple runs out, whatever expression is the last gets
-        ## matched to the remaining type.
-        [tailT (#;Cons tailC #;Nil)]
-        (&;with-expected-type tailT
-          (analyse tailC))
-
         ## If, however, the type runs out but there is still enough
         ## tail, the remaining elements get packaged into another
         ## tuple, and analysed through the intermediation of a
@@ -190,13 +205,27 @@
          [#;ExQ tc;var])
 
         (#;Apply inputT funT)
-        (case (type;apply (list inputT) funT)
-          #;None
-          (&;throw Not-Quantified-Type (%type funT))
-          
-          (#;Some outputT)
-          (&;with-expected-type outputT
-            (analyse-product analyse membersC)))
+        (case funT
+          (#;Var funT-id)
+          (do @
+            [?funT' (&;with-type-env (tc;read funT-id))]
+            (case ?funT'
+              (#;Some funT')
+              (&;with-expected-type (#;Apply inputT funT')
+                (analyse-product analyse membersC))
+
+              _
+              (&;throw Not-Tuple-Type (format " Type: " (%type expectedT) "\n"
+                                              "Value: " (%code (` [(~@ membersC)]))))))
+
+          _
+          (case (type;apply (list inputT) funT)
+            #;None
+            (&;throw Not-Quantified-Type (%type funT))
+            
+            (#;Some outputT)
+            (&;with-expected-type outputT
+              (analyse-product analyse membersC))))
         
         _
         (&;throw Not-Tuple-Type (format " Type: " (%type expectedT) "\n"
-- 
cgit v1.2.3