- Migrated reference analysis to stdlib.

3 files changed, 1 insertions, 232 deletions

diff --git a/new-luxc/source/luxc/lang/analysis/reference.lux b/new-luxc/source/luxc/lang/analysis/reference.lux
deleted file mode 100644
index 56aba35de..000000000
--- a/new-luxc/source/luxc/lang/analysis/reference.lux
+++ /dev/null
@@ -1,57 +0,0 @@
-(.module:
-  lux
-  (lux (control monad)
-       [macro]
-       (macro [code])
-       (lang (type ["tc" check])))
-  (luxc ["&" lang]
-        (lang ["&." scope]
-              ["la" analysis #+ Analysis]
-              [".L" variable #+ Variable])))
-
-## [Analysers]
-(def: (analyse-definition def-name)
-  (-> Ident (Meta Analysis))
-  (do macro.Monad<Meta>
-    [[actualT def-anns _] (&.with-error-tracking
-                            (macro.find-def def-name))]
-    (case (macro.get-symbol-ann (ident-for #.alias) def-anns)
-      (#.Some real-def-name)
-      (analyse-definition real-def-name)
-
-      _
-      (do @
-        [_ (&.infer actualT)
-         def-name (macro.normalize def-name)]
-        (wrap (code.symbol def-name))))))
-
-(def: (analyse-variable var-name)
-  (-> Text (Meta (Maybe Analysis)))
-  (do macro.Monad<Meta>
-    [?var (&scope.find var-name)]
-    (case ?var
-      (#.Some [actualT ref])
-      (do @
-        [_ (&.infer actualT)]
-        (wrap (#.Some (` ((~ (code.int (variableL.from-ref ref))))))))
-
-      #.None
-      (wrap #.None))))
-
-(def: #export (analyse-reference reference)
-  (-> Ident (Meta Analysis))
-  (case reference
-    ["" simple-name]
-    (do macro.Monad<Meta>
-      [?var (analyse-variable simple-name)]
-      (case ?var
-        (#.Some varA)
-        (wrap varA)
-
-        #.None
-        (do @
-          [this-module macro.current-module-name]
-          (analyse-definition [this-module simple-name]))))
-
-    _
-    (analyse-definition reference)))
diff --git a/new-luxc/source/luxc/lang/scope.lux b/new-luxc/source/luxc/lang/scope.lux
deleted file mode 100644
index 82d7803e2..000000000
--- a/new-luxc/source/luxc/lang/scope.lux
+++ /dev/null
@@ -1,173 +0,0 @@
-(.module:
-  lux
-  (lux (control monad)
-       (data [text "text/" Eq<Text>]
-             text/format
-             [maybe "maybe/" Monad<Maybe>]
-             [product]
-             ["e" error]
-             (coll [list "list/" Functor<List> Fold<List> Monoid<List>]))
-       [macro])
-  (luxc ["&" lang]
-        (lang [".L" variable #+ Variable])))
-
-(type: Locals (Bindings Text [Type Nat]))
-(type: Captured (Bindings Text [Type Ref]))
-
-(def: (is-local? name scope)
-  (-> Text Scope Bool)
-  (|> scope
-      (get@ [#.locals #.mappings])
-      (&.pl-contains? name)))
-
-(def: (get-local name scope)
-  (-> Text Scope (Maybe [Type Ref]))
-  (|> scope
-      (get@ [#.locals #.mappings])
-      (&.pl-get name)
-      (maybe/map (function (_ [type value])
-                   [type (#.Local value)]))))
-
-(def: (is-captured? name scope)
-  (-> Text Scope Bool)
-  (|> scope
-      (get@ [#.captured #.mappings])
-      (&.pl-contains? name)))
-
-(def: (get-captured name scope)
-  (-> Text Scope (Maybe [Type Ref]))
-  (loop [idx +0
-         mappings (get@ [#.captured #.mappings] scope)]
-    (case mappings
-      #.Nil
-      #.None
-
-      (#.Cons [_name [_source-type _source-ref]] mappings')
-      (if (text/= name _name)
-        (#.Some [_source-type (#.Captured idx)])
-        (recur (n/inc idx) mappings')))))
-
-(def: (is-ref? name scope)
-  (-> Text Scope Bool)
-  (or (is-local? name scope)
-      (is-captured? name scope)))
-
-(def: (get-ref name scope)
-  (-> Text Scope (Maybe [Type Ref]))
-  (case (get-local name scope)
-    (#.Some type)
-    (#.Some type)
-
-    _
-    (get-captured name scope)))
-
-(def: #export (find name)
-  (-> Text (Meta (Maybe [Type Ref])))
-  (function (_ compiler)
-    (let [[inner outer] (|> compiler
-                            (get@ #.scopes)
-                            (list.split-with (|>> (is-ref? name) not)))]
-      (case outer
-        #.Nil
-        (#.Right [compiler #.None])
-
-        (#.Cons top-outer _)
-        (let [[ref-type init-ref] (maybe.default (undefined)
-                                                 (get-ref name top-outer))
-              [ref inner'] (list/fold (: (-> Scope [Ref (List Scope)] [Ref (List Scope)])
-                                         (function (_ scope ref+inner)
-                                           [(#.Captured (get@ [#.captured #.counter] scope))
-                                            (#.Cons (update@ #.captured
-                                                             (: (-> Captured Captured)
-                                                                (|>> (update@ #.counter n/inc)
-                                                                     (update@ #.mappings (&.pl-put name [ref-type (product.left ref+inner)]))))
-                                                             scope)
-                                                    (product.right ref+inner))]))
-                                      [init-ref #.Nil]
-                                      (list.reverse inner))
-              scopes (list/compose inner' outer)]
-          (#.Right [(set@ #.scopes scopes compiler)
-                    (#.Some [ref-type ref])]))
-        ))))
-
-(def: #export (with-local [name type] action)
-  (All [a] (-> [Text Type] (Meta a) (Meta a)))
-  (function (_ compiler)
-    (case (get@ #.scopes compiler)
-      (#.Cons head tail)
-      (let [old-mappings (get@ [#.locals #.mappings] head)
-            new-var-id (get@ [#.locals #.counter] head)
-            new-head (update@ #.locals
-                              (: (-> Locals Locals)
-                                 (|>> (update@ #.counter n/inc)
-                                      (update@ #.mappings (&.pl-put name [type new-var-id]))))
-                              head)]
-        (case (macro.run' (set@ #.scopes (#.Cons new-head tail) compiler)
-                          action)
-          (#e.Success [compiler' output])
-          (case (get@ #.scopes compiler')
-            (#.Cons head' tail')
-            (let [scopes' (#.Cons (set@ #.locals (get@ #.locals head) head')
-                                  tail')]
-              (#e.Success [(set@ #.scopes scopes' compiler')
-                           output]))
-
-            _
-            (error! "Invalid scope alteration/"))
-
-          (#e.Error error)
-          (#e.Error error)))
-
-      _
-      (#e.Error "Cannot create local binding without a scope."))
-    ))
-
-(do-template [<name> <val-type>]
-  [(def: <name>
-     (Bindings Text [Type <val-type>])
-     {#.counter +0
-      #.mappings (list)})]
-
-  [init-locals   Nat]
-  [init-captured Ref]
-  )
-
-(def: (scope parent-name child-name)
-  (-> (List Text) Text Scope)
-  {#.name     (list& child-name parent-name)
-   #.inner    +0
-   #.locals   init-locals
-   #.captured init-captured})
-
-(def: #export (with-scope name action)
-  (All [a] (-> Text (Meta a) (Meta a)))
-  (function (_ compiler)
-    (let [parent-name (case (get@ #.scopes compiler)
-                        #.Nil
-                        (list)
-                        
-                        (#.Cons top _)
-                        (get@ #.name top))]
-      (case (action (update@ #.scopes
-                             (|>> (#.Cons (scope parent-name name)))
-                             compiler))
-        (#e.Error error)
-        (#e.Error error)
-
-        (#e.Success [compiler' output])
-        (#e.Success [(update@ #.scopes
-                              (|>> list.tail (maybe.default (list)))
-                              compiler')
-                     output])
-        ))
-    ))
-
-(def: #export next-local
-  (Meta Nat)
-  (function (_ compiler)
-    (case (get@ #.scopes compiler)
-      #.Nil
-      (#e.Error "Cannot get next reference when there is no scope.")
-      
-      (#.Cons top _)
-      (#e.Success [compiler (get@ [#.locals #.counter] top)]))))
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux
index 99328a45f..0899eccf2 100644
--- a/new-luxc/source/luxc/lang/translation.lux
+++ b/new-luxc/source/luxc/lang/translation.lux
@@ -101,8 +101,7 @@
                       (analyse macroC)))
        [_macroT _macroM _macroV] (case macroA
                                    [_ (#.Symbol macro-name)]
-                                   (&.with-error-tracking
-                                     (macro.find-def macro-name))
+                                   (macro.find-def macro-name)
 
                                    _
                                    (&.throw Invalid-Macro (%code code)))