diff options
author | Eduardo Julian | 2018-05-16 01:06:28 -0400 |
---|---|---|
committer | Eduardo Julian | 2018-05-16 01:06:28 -0400 |
commit | 273c2d517dbafbe6df4d9b9ac65ffd4749e63642 (patch) | |
tree | 03cd1d8db4fa575f557bea6d82167399c6e04752 /new-luxc/source/luxc | |
parent | 8ba6ac8952e3457b1a09e30ac5312168d48006d1 (diff) |
- Migrated reference analysis to stdlib.
Diffstat (limited to 'new-luxc/source/luxc')
-rw-r--r-- | new-luxc/source/luxc/lang.lux | 13 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/analysis/reference.lux | 57 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/scope.lux | 173 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/translation.lux | 3 |
4 files changed, 1 insertions, 245 deletions
diff --git a/new-luxc/source/luxc/lang.lux b/new-luxc/source/luxc/lang.lux index 28dd302c2..c4dff15ec 100644 --- a/new-luxc/source/luxc/lang.lux +++ b/new-luxc/source/luxc/lang.lux @@ -51,16 +51,3 @@ (if (n/= underflow idx) output (recur (n/dec idx) (format (|> (text.nth idx name) maybe.assume normalize-char) output))))) - -(exception: #export (Error {message Text}) - message) - -(def: #export (with-error-tracking action) - (All [a] (-> (Meta a) (Meta a))) - (function (_ compiler) - (case (action compiler) - (#e.Error error) - ((throw Error error) compiler) - - output - output))) 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))) |