- Re-organized analysis.

1 files changed, 0 insertions, 311 deletions

diff --git a/new-luxc/source/luxc/analyser/structure.lux b/new-luxc/source/luxc/analyser/structure.lux
deleted file mode 100644
index d523065ea..000000000
--- a/new-luxc/source/luxc/analyser/structure.lux
+++ /dev/null
@@ -1,311 +0,0 @@
-(;module:
-  lux
-  (lux (control [monad #+ do]
-                ["ex" exception #+ exception:]
-                pipe)
-       [function]
-       (concurrency ["A" atom])
-       (data [ident]
-             [number]
-             [product]
-             [maybe]
-             (coll [list "list/" Functor<List>]
-                   [dict #+ Dict])
-             [text]
-             text/format)
-       [meta]
-       (meta [code]
-             [type]
-             (type ["tc" check])))
-  (luxc ["&" base]
-        (lang ["la" analysis])
-        ["&;" module]
-        ["&;" scope]
-        (analyser ["&;" common]
-                  ["&;" inference])))
-
-(exception: #export Not-Variant-Type)
-(exception: #export Not-Tuple-Type)
-(exception: #export Cannot-Infer-Numeric-Tag)
-
-(type: Type-Error
-  (-> Type Text))
-
-(def: (not-quantified type)
-  Type-Error
-  (format "Not a quantified type: " (%type type)))
-
-(def: #export (analyse-sum analyse tag valueC)
-  (-> &;Analyser Nat Code (Meta la;Analysis))
-  (do meta;Monad<Meta>
-    [expectedT meta;expected-type]
-    (&;with-stacked-errors
-      (function [_] (Not-Variant-Type (format "  Tag: " (%n tag) "\n"
-                                              "Value: " (%code  valueC) "\n"
-                                              " Type: " (%type expectedT))))
-      (case expectedT
-        (#;Sum _)
-        (let [flat (type;flatten-variant expectedT)
-              type-size (list;size flat)]
-          (case (list;nth tag flat)
-            (#;Some variant-type)
-            (do @
-              [valueA (&;with-expected-type variant-type
-                        (analyse valueC))
-               temp &scope;next-local]
-              (wrap (la;sum tag type-size temp valueA)))
-
-            #;None
-            (&common;variant-out-of-bounds-error expectedT type-size tag)))
-
-        (#;Named name unnamedT)
-        (&;with-expected-type unnamedT
-          (analyse-sum analyse tag valueC))
-
-        (#;Var id)
-        (do @
-          [bound? (&;with-type-env
-                    (tc;bound? id))]
-          (if bound?
-            (do @
-              [expectedT' (&;with-type-env
-                            (tc;read id))]
-              (&;with-expected-type expectedT'
-                (analyse-sum analyse tag valueC)))
-            ## Cannot do inference when the tag is numeric.
-            ## This is because there is no way of knowing how many
-            ## cases the inferred sum type would have.
-            (&;throw Cannot-Infer-Numeric-Tag (format "  Tag: " (%n tag) "\n"
-                                                      "Value: " (%code  valueC) "\n"
-                                                      " Type: " (%type expectedT)))))
-
-        (#;UnivQ _)
-        (do @
-          [[var-id var] (&;with-type-env
-                          tc;existential)]
-          (&;with-expected-type (maybe;assume (type;apply (list var) expectedT))
-            (analyse-sum analyse tag valueC)))
-
-        (#;ExQ _)
-        (&common;with-var
-          (function [[var-id var]]
-            (&;with-expected-type (maybe;assume (type;apply (list var) expectedT))
-              (analyse-sum analyse tag valueC))))
-
-        (#;Apply inputT funT)
-        (case (type;apply (list inputT) funT)
-          #;None
-          (&;fail (not-quantified funT))
-          
-          (#;Some outputT)
-          (&;with-expected-type outputT
-            (analyse-sum analyse tag valueC)))
-        
-        _
-        (&;throw Not-Variant-Type (format "  Tag: " (%n tag) "\n"
-                                          "Value: " (%code  valueC) "\n"
-                                          " Type: " (%type expectedT)))))))
-
-(def: (analyse-typed-product analyse members)
-  (-> &;Analyser (List Code) (Meta la;Analysis))
-  (do meta;Monad<Meta>
-    [expectedT meta;expected-type]
-    (loop [expectedT expectedT
-           members members]
-      (case [expectedT members]
-        ## If the type and the code are still ongoing, match each
-        ## sub-expression to its corresponding type.
-        [(#;Product leftT rightT) (#;Cons leftC rightC)]
-        (do @
-          [leftA (&;with-expected-type leftT
-                   (analyse leftC))
-           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
-        ## temporary local variable.
-        ## The reason for this is that it is assumed that the type of
-        ## the tuple represents the expectations of the user.
-        ## If the type is for a 3-tuple, but a 5-tuple is provided, it
-        ## is assumed that the user intended the following layout:
-        ## [0, 1, [2, 3, 4]]
-        ## but that, for whatever reason, it was written in a flat
-        ## way.
-        ## The reason why an intermediate variable is used is that if
-        ## the code was just re-written with just tuple nesting, the
-        ## resulting analysis would have undone the explicity nesting,
-        ## since Product nodes rely on nesting inherently, thereby
-        ## blurring the line between what was wanted (the separation)
-        ## and what was analysed.
-        [tailT tailC]
-        (do @
-          [g!tail (meta;gensym "tail")]
-          (&;with-expected-type tailT
-            (analyse (` ((~' _lux_case) [(~@ tailC)]
-                         (~ g!tail)
-                         (~ g!tail))))))
-        ))))
-
-(def: #export (analyse-product analyse membersC)
-  (-> &;Analyser (List Code) (Meta la;Analysis))
-  (do meta;Monad<Meta>
-    [expectedT meta;expected-type]
-    (&;with-stacked-errors
-      (function [_] (Not-Tuple-Type (format " Type: " (%type expectedT) "\n"
-                                            "Value: " (%code (` [(~@ membersC)])))))
-      (case expectedT
-        (#;Product _)
-        (analyse-typed-product analyse membersC)
-
-        (#;Named name unnamedT)
-        (&;with-expected-type unnamedT
-          (analyse-product analyse membersC))
-
-        (#;Var id)
-        (do @
-          [bound? (&;with-type-env
-                    (tc;bound? id))]
-          (if bound?
-            (do @
-              [expectedT' (&;with-type-env
-                            (tc;read id))]
-              (&;with-expected-type expectedT'
-                (analyse-product analyse membersC)))
-            ## Must do inference...
-            (do @
-              [membersTA (monad;map @ (|>. analyse &common;with-unknown-type)
-                                    membersC)
-               _ (&;with-type-env
-                   (tc;check expectedT
-                             (type;tuple (list/map product;left membersTA))))]
-              (wrap (la;product (list/map product;right membersTA))))))
-
-        (#;UnivQ _)
-        (do @
-          [[var-id var] (&;with-type-env
-                          tc;existential)]
-          (&;with-expected-type (maybe;assume (type;apply (list var) expectedT))
-            (analyse-product analyse membersC)))
-
-        (#;ExQ _)
-        (&common;with-var
-          (function [[var-id var]]
-            (&;with-expected-type (maybe;assume (type;apply (list var) expectedT))
-              (analyse-product analyse membersC))))
-
-        (#;Apply inputT funT)
-        (case (type;apply (list inputT) funT)
-          #;None
-          (&;fail (not-quantified funT))
-          
-          (#;Some outputT)
-          (&;with-expected-type outputT
-            (analyse-product analyse membersC)))
-        
-        _
-        (&;throw Not-Tuple-Type (format " Type: " (%type expectedT) "\n"
-                                        "Value: " (%code (` [(~@ membersC)]))))
-        ))))
-
-(def: #export (analyse-tagged-sum analyse tag valueC)
-  (-> &;Analyser Ident Code (Meta la;Analysis))
-  (do meta;Monad<Meta>
-    [tag (meta;normalize tag)
-     [idx group variantT] (meta;resolve-tag tag)
-     expectedT meta;expected-type]
-    (case expectedT
-      (#;Var _)
-      (do @
-        [#let [case-size (list;size group)]
-         inferenceT (&inference;variant idx case-size variantT)
-         [inferredT valueA+] (&inference;apply-function analyse inferenceT (list valueC))
-         _ (&;with-type-env
-             (tc;check expectedT inferredT))
-         temp &scope;next-local]
-        (wrap (la;sum idx case-size temp (|> valueA+ list;head maybe;assume))))
-
-      _
-      (analyse-sum analyse idx valueC))))
-
-## There cannot be any ambiguity or improper syntax when analysing
-## records, so they must be normalized for further analysis.
-## Normalization just means that all the tags get resolved to their
-## canonical form (with their corresponding module identified).
-(def: #export (normalize record)
-  (-> (List [Code Code]) (Meta (List [Ident Code])))
-  (monad;map meta;Monad<Meta>
-             (function [[key val]]
-               (case key
-                 [_ (#;Tag key)]
-                 (do meta;Monad<Meta>
-                   [key (meta;normalize key)]
-                   (wrap [key val]))
-
-                 _
-                 (&;fail (format "Cannot use non-tag tokens in key positions in records: " (%code key)))))
-             record))
-
-## Lux already possesses the means to analyse tuples, so
-## re-implementing the same functionality for records makes no sense.
-## Records, thus, get transformed into tuples by ordering the elements.
-(def: #export (order record)
-  (-> (List [Ident Code]) (Meta [(List Code) Type]))
-  (case record
-    ## empty-record = empty-tuple = unit = []
-    #;Nil
-    (:: meta;Monad<Meta> wrap [(list) Unit])
-
-    (#;Cons [head-k head-v] _)
-    (do meta;Monad<Meta>
-      [head-k (meta;normalize head-k)
-       [_ tag-set recordT] (meta;resolve-tag head-k)
-       #let [size-record (list;size record)
-             size-ts (list;size tag-set)]
-       _ (if (n.= size-ts size-record)
-           (wrap [])
-           (&;fail (format "Record size does not match tag-set size." "\n"
-                           "Expected: " (|> size-ts nat-to-int %i) "\n"
-                           "  Actual: " (|> size-record nat-to-int %i) "\n"
-                           "For type: " (%type recordT))))
-       #let [tuple-range (list;n.range +0 (n.dec size-ts))
-             tag->idx (dict;from-list ident;Hash<Ident> (list;zip2 tag-set tuple-range))]
-       idx->val (monad;fold @
-                            (function [[key val] idx->val]
-                              (do @
-                                [key (meta;normalize key)]
-                                (case (dict;get key tag->idx)
-                                  #;None
-                                  (&;fail (format "Tag " (%code (code;tag key))
-                                                  " does not belong to tag-set for type " (%type recordT)))
-
-                                  (#;Some idx)
-                                  (if (dict;contains? idx idx->val)
-                                    (&;fail (format "Cannot repeat tag inside record: " (%code (code;tag key))))
-                                    (wrap (dict;put idx val idx->val))))))
-                            (: (Dict Nat Code)
-                               (dict;new number;Hash<Nat>))
-                            record)
-       #let [ordered-tuple (list/map (function [idx] (maybe;assume (dict;get idx idx->val)))
-                                     tuple-range)]]
-      (wrap [ordered-tuple recordT]))
-    ))
-
-(def: #export (analyse-record analyse members)
-  (-> &;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))))