WIP

- Simplified the Analysis type, by removing all meta-data.
- Added analysis of function calls.
- Added analysis of common Lux procedures.
- Lots of refactoring.

1 files changed, 0 insertions, 397 deletions

diff --git a/new-luxc/source/luxc/analyser/lux.lux b/new-luxc/source/luxc/analyser/lux.lux
deleted file mode 100644
index 7bce8ed8d..000000000
--- a/new-luxc/source/luxc/analyser/lux.lux
+++ /dev/null
@@ -1,397 +0,0 @@
-(;module:
-  lux
-  (lux (control monad
-                pipe)
-       [io #- run]
-       (concurrency ["A" atom])
-       (data ["E" error]
-             [text "T/" Eq<Text>]
-             text/format
-             (coll [list "L/" Fold<List> Monoid<List> Monad<List>]
-                   ["D" dict])
-             [number]
-             [product])
-       [macro #+ Monad<Lux>]
-       [type]
-       (type ["TC" check]))
-  (luxc ["&" base]
-        (lang ["la" analysis #+ Analysis])
-        ["&;" module]
-        ["&;" env]
-        (analyser ["&;" common])))
-
-(do-template [<name> <type> <tag>]
-  [(def: #export (<name> cursor value)
-     (-> Cursor <type> (Lux Analysis))
-     (do Monad<Lux>
-       [expected macro;expected-type
-        _ (&;within-type-env
-           (TC;check expected <type>))]
-       (wrap [[expected cursor]
-              (<tag> value)])))]
-
-  [analyse-bool Bool #la;Bool]
-  [analyse-nat  Nat  #la;Nat]
-  [analyse-int  Int  #la;Int]
-  [analyse-deg  Deg  #la;Deg]
-  [analyse-real Real #la;Real]
-  [analyse-char Char #la;Char]
-  [analyse-text Text #la;Text]
-  )
-
-(def: #export (analyse-unit cursor)
-  (-> Cursor (Lux Analysis))
-  (do Monad<Lux>
-    [expected macro;expected-type
-     _ (&;within-type-env
-        (TC;check expected Unit))]
-    (wrap [[expected cursor]
-           #la;Unit])))
-
-(def: (analyse-definition cursor def-name)
-  (-> Cursor Ident (Lux Analysis))
-  (do Monad<Lux>
-    [actual (macro;find-def-type def-name)
-     expected macro;expected-type
-     _ (&;within-type-env
-        (TC;check expected actual))]
-    (wrap [[expected cursor]
-           (#la;Absolute def-name)])))
-
-(def: (analyse-variable cursor var-name)
-  (-> Cursor Text (Lux (Maybe Analysis)))
-  (do Monad<Lux>
-    [?var (&env;find var-name)]
-    (case ?var
-      (#;Some [actual ref])
-      (do @
-        [expected macro;expected-type
-         _ (&;within-type-env
-            (TC;check expected actual))
-         #let [analysis [[expected cursor]
-                         (#la;Relative ref)]]]
-        (wrap (#;Some analysis)))
-
-      #;None
-      (wrap #;None))))
-
-(def: #export (analyse-reference cursor reference)
-  (-> Cursor Ident (Lux Analysis))
-  (case reference
-    ["" simple-name]
-    (do Monad<Lux>
-      [?var (analyse-variable cursor simple-name)]
-      (case ?var
-        (#;Some analysis)
-        (wrap analysis)
-
-        #;None
-        (do @
-          [this-module macro;current-module-name]
-          (analyse-definition cursor [this-module simple-name]))))
-
-    _
-    (analyse-definition cursor reference)))
-
-(def: #export (analyse-check analyse eval cursor type value)
-  (-> &;Analyser &;Eval Cursor Code Code (Lux Analysis))
-  (do Monad<Lux>
-    [actual (eval Type type)
-     #let [actual (:! Type actual)]
-     expected macro;expected-type
-     _ (&;within-type-env
-        (TC;check expected actual))]
-    (&;with-expected-type actual
-      (analyse eval value))))
-
-(def: #export (analyse-coerce analyse eval cursor type value)
-  (-> &;Analyser &;Eval Cursor Code Code (Lux Analysis))
-  (do Monad<Lux>
-    [actual (eval Type type)
-     #let [actual (:! Type actual)]
-     expected macro;expected-type
-     _ (&;within-type-env
-        (TC;check expected actual))
-     =value (&;with-expected-type Top
-              (analyse eval value))]
-    (wrap (&common;replace-type expected =value))))
-
-(def: (analyse-typed-tuple analyse cursor members)
-  (-> (-> Code (Lux Analysis)) Cursor
-      (List Code)
-      (Lux Analysis))
-  (do Monad<Lux>
-    [expected macro;expected-type]
-    (let [member-types (type;flatten-tuple expected)
-          num-types (list;size member-types)
-          num-members (list;size members)]
-      (cond (n.= num-types num-members)
-            (do @
-              [=tuple (: (Lux (List Analysis))
-                         (mapM @
-                               (function [[expected member]]
-                                 (&;with-expected-type expected
-                                   (analyse member)))
-                               (list;zip2 member-types members)))]
-              (wrap [[expected cursor]
-                     (#la;Tuple =tuple)]))
-
-            (n.< num-types num-members)
-            (do @
-              [#let [[head-ts tail-ts] (list;split (n.- +2 num-members)
-                                                   member-types)]
-               =prevs (mapM @
-                            (function [[expected member]]
-                              (&;with-expected-type expected
-                                (analyse member)))
-                            (list;zip2 head-ts members))
-               =last (&;with-expected-type (type;tuple tail-ts)
-                       (analyse (default (undefined)
-                                  (list;last members))))]
-              (wrap [[expected cursor]
-                     (#la;Tuple (L/append =prevs (list =last)))]))
-
-            ## (n.> num-types num-members)
-            (do @
-              [#let [[head-xs tail-xs] (list;split (n.- +2 num-types)
-                                                   members)]
-               =prevs (mapM @
-                            (function [[expected member]]
-                              (&;with-expected-type expected
-                                (analyse member)))
-                            (list;zip2 member-types head-xs))
-               =last (&;with-expected-type (default (undefined)
-                                             (list;last member-types))
-                       (analyse-typed-tuple analyse cursor tail-xs))]
-              (wrap [[expected cursor]
-                     (#la;Tuple (L/append =prevs (list =last)))]))
-            ))))
-
-(def: (tuple cursor members)
-  (-> Cursor (List Analysis) Analysis)
-  (let [tuple-type (type;tuple (L/map la;get-type members))]
-    [[tuple-type cursor]
-     (#la;Tuple members)]))
-
-(def: #export (analyse-tuple analyse cursor members)
-  (-> (-> Code (Lux Analysis)) Cursor
-      (List Code)
-      (Lux Analysis))
-  (do Monad<Lux>
-    [expected macro;expected-type]
-    (case expected
-      (#;Product _)
-      (analyse-typed-tuple analyse cursor members)
-
-      (#;Var id)
-      (do @
-        [bound? (&;within-type-env
-                 (TC;bound? id))]
-        (if bound?
-          (do @
-            [expected' (&;within-type-env
-                        (TC;read-var id))
-             =tuple (&;with-expected-type expected'
-                      (analyse-tuple analyse cursor members))]
-            (wrap (&common;replace-type expected =tuple)))
-          (do @
-            [=members (mapM @ (<|. &common;with-unknown-type
-                                   analyse)
-                            members)
-             #let [=tuple (tuple cursor =members)]
-             _ (&;within-type-env
-                (TC;check expected (la;get-type =tuple)))]
-            (wrap (&common;replace-type expected =tuple)))))
-
-      _
-      (if (type;quantified? expected)
-        (do @
-          [[bindings expected'] (&;within-type-env
-                                 (&common;realize expected))
-           =tuple (&;with-expected-type expected'
-                    (analyse-tuple analyse cursor members))
-           =tuple (foldM @ &common;clean =tuple bindings)
-           _ (&;within-type-env
-              (TC;check expected (la;get-type =tuple)))]
-          (wrap (&common;replace-type expected =tuple)))
-        (&;fail (format "Invalid type for tuple: " (%type expected))))
-      )))
-
-(def: #export (analyse-variant analyse cursor tag value)
-  (-> (-> Code (Lux Analysis)) Cursor
-      Nat Code
-      (Lux Analysis))
-  (do Monad<Lux>
-    [expected macro;expected-type]
-    (case expected
-      (#;Sum _)
-      (let [flat (type;flatten-variant expected)
-            type-size (list;size flat)]
-        (if (n.< type-size tag)
-          (do @
-            [#let [last? (n.= tag (n.dec type-size))
-                   variant-type (default (undefined)
-                                  (list;nth tag flat))]
-             =value (&;with-expected-type variant-type
-                      (analyse value))]
-            (wrap [[expected cursor]
-                   (#la;Variant tag last? =value)]))
-          (&;fail (format "Trying to create variant with tag beyond type's limitations." "\n"
-                          "      Tag: " (%n tag) "\n"
-                          "Type size: " (%n type-size) "\n"
-                          "     Type: " (%type expected) "\n"))))
-
-      _
-      (if (type;quantified? expected)
-        (do @
-          [[bindings expected'] (&;within-type-env
-                                 (&common;realize expected))
-           =variant (&;with-expected-type expected'
-                      (analyse-variant analyse cursor tag value))
-           =variant (foldM @ &common;clean =variant bindings)
-           _ (&;within-type-env
-              (TC;check expected (la;get-type =variant)))]
-          (wrap (&common;replace-type expected =variant)))
-        (&;fail (format "Invalid type for variant: " (%type expected)))))))
-
-## Functions
-(def: (maybe-to-lux input)
-  (All [a] (-> (Maybe a) (Lux a)))
-  (case input
-    #;None
-    (&;fail "")
-
-    (#;Some value)
-    (:: Monad<Lux> wrap value)))
-
-(def: (with-var body)
-  (All [a] (-> (-> [Nat Type] (Lux a)) (Lux a)))
-  (do Monad<Lux>
-    [[id var] (&;within-type-env TC;create-var)
-     output (body [id var])
-     _ (&;within-type-env (TC;delete-var id))]
-    (wrap output)))
-
-(def: (bind-var var-id bound-idx type)
-  (-> Nat Nat Type Type)
-  (case type
-    (#;Host name params)
-    (#;Host name (L/map (bind-var var-id bound-idx) params))
-
-    (^template [<tag>]
-      (<tag> left right)
-      (<tag> (bind-var var-id bound-idx left)
-             (bind-var var-id bound-idx right)))
-    ([#;Sum]
-     [#;Product]
-     [#;Function]
-     [#;App])
-    
-    (#;Var id)
-    (if (n.= var-id id)
-      (#;Bound bound-idx)
-      type)
-
-    (^template [<tag>]
-      (<tag> env quantified)
-      (<tag> (L/map (bind-var var-id bound-idx) env)
-             (bind-var var-id (n.+ +2 bound-idx) quantified)))
-    ([#;UnivQ]
-     [#;ExQ])
-    
-    (#;Named name unnamed)
-    (#;Named name
-             (bind-var var-id bound-idx unnamed))
-
-    _
-    type))
-
-(def: #export (analyse-function analyse cursor func-name arg-name body)
-  (-> (-> Code (Lux Analysis)) Cursor
-      Text Text Code
-      (Lux Analysis))
-  (do Monad<Lux>
-    [expected macro;expected-type]
-    (&;with-try
-      (function [error]
-        (let [raw (format "Functions require function types: " (type;to-text expected))]
-          (&;fail (if (T/= "" error)
-                    raw
-                    (format error "\n" raw)))))
-      (case expected
-        (#;Named name unnamed)
-        (do @
-          [=function (&;with-expected-type unnamed
-                       (analyse-function analyse cursor func-name arg-name body))]
-          (wrap (&common;replace-type expected =function)))
-
-        (#;App funT argT)
-        (do @
-          [fully-applied (maybe-to-lux (type;apply-type funT argT))
-           =function (&;with-expected-type fully-applied
-                       (analyse-function analyse cursor func-name arg-name body))]
-          (wrap (&common;replace-type expected =function)))
-        
-        (#;UnivQ _)
-        (do @
-          [[var-id var] (&;within-type-env
-                         TC;existential)
-           expected' (maybe-to-lux (type;apply-type expected var))
-           =function (&;with-expected-type expected'
-                       (analyse-function analyse cursor func-name arg-name body))]
-          (wrap (&common;replace-type expected =function)))
-
-        (#;ExQ _)
-        (with-var
-          (function [[var-id var]]
-            (do @
-              [expected' (maybe-to-lux (type;apply-type expected var))
-               =function (&;with-expected-type expected'
-                           (analyse-function analyse cursor func-name arg-name body))]
-              (&common;clean var =function))))
-        
-        (#;Var id)
-        (do @
-          [? (&;within-type-env
-              (TC;bound? id))]
-          (if ?
-            (do @
-              [expected' (&;within-type-env
-                          (TC;read-var id))]
-              (&;with-expected-type expected'
-                (analyse-function analyse cursor func-name arg-name body)))
-            ## Inference
-            (with-var
-              (function [[input-id inputT]]
-                (with-var
-                  (function [[output-id outputT]]
-                    (do @
-                      [#let [funT (#;Function inputT outputT)]
-                       =function (&;with-expected-type funT
-                                   (analyse-function analyse cursor func-name arg-name body))
-                       funT' (&;within-type-env
-                              (TC;clean output-id funT))
-                       concrete-input? (&;within-type-env
-                                        (TC;bound? input-id))
-                       funT'' (if concrete-input?
-                                (&;within-type-env
-                                 (TC;clean input-id funT'))
-                                (wrap (#;UnivQ (list) (bind-var input-id +1 funT'))))
-                       _ (&;within-type-env
-                          (TC;check expected funT''))]
-                      (wrap (&common;replace-type expected =function)))
-                    ))))))
-
-        (#;Function inputT outputT)
-        (do @
-          [[=scope =body] (&;with-scope
-                            (&env;with-local [func-name expected]
-                              (&env;with-local [arg-name inputT]
-                                (&;with-expected-type outputT
-                                  (analyse body)))))]
-          (wrap [[expected cursor]
-                 (#la;Function =scope =body)]))
-        
-        _
-        (&;fail "")
-        ))))