From 273c2d517dbafbe6df4d9b9ac65ffd4749e63642 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 16 May 2018 01:06:28 -0400 Subject: - Migrated reference analysis to stdlib. --- stdlib/source/lux/lang/analysis/expression.lux | 6 +- stdlib/source/lux/lang/analysis/reference.lux | 56 ++++++++ stdlib/source/lux/lang/scope.lux | 173 +++++++++++++++++++++++++ 3 files changed, 232 insertions(+), 3 deletions(-) create mode 100644 stdlib/source/lux/lang/analysis/reference.lux create mode 100644 stdlib/source/lux/lang/scope.lux (limited to 'stdlib/source') diff --git a/stdlib/source/lux/lang/analysis/expression.lux b/stdlib/source/lux/lang/analysis/expression.lux index a22e3d32b..5013246aa 100644 --- a/stdlib/source/lux/lang/analysis/expression.lux +++ b/stdlib/source/lux/lang/analysis/expression.lux @@ -13,8 +13,8 @@ (analysis [".A" type] [".A" primitive] [".A" structure] + [".A" reference] ## [".A" function] - ## [".A" reference] ) ## [".L" macro] ## [".L" extension] @@ -79,8 +79,8 @@ (^ (#.Record pairs)) (structureA.record analyse pairs) - ## (#.Symbol reference) - ## (referenceA.analyse-reference reference) + (#.Symbol reference) + (referenceA.reference reference) ## (^ (#.Form (list& [_ (#.Text proc-name)] proc-args))) ## (do macro.Monad diff --git a/stdlib/source/lux/lang/analysis/reference.lux b/stdlib/source/lux/lang/analysis/reference.lux new file mode 100644 index 000000000..4192ed118 --- /dev/null +++ b/stdlib/source/lux/lang/analysis/reference.lux @@ -0,0 +1,56 @@ +(.module: + lux + (lux (control monad) + [macro] + (macro [code]) + [lang] + (lang (type ["tc" check]) + [".L" scope] + [".L" analysis #+ Analysis] + (analysis [".A" type])))) + +## [Analysers] +(def: (definition def-name) + (-> Ident (Meta Analysis)) + (do macro.Monad + [[actualT def-anns _] (macro.find-def def-name)] + (case (macro.get-symbol-ann (ident-for #.alias) def-anns) + (#.Some real-def-name) + (definition real-def-name) + + _ + (do @ + [_ (typeA.infer actualT)] + (:: @ map (|>> #analysisL.Constant) + (macro.normalize def-name)))))) + +(def: (variable var-name) + (-> Text (Meta (Maybe Analysis))) + (do macro.Monad + [?var (scopeL.find var-name)] + (case ?var + (#.Some [actualT ref]) + (do @ + [_ (typeA.infer actualT)] + (wrap (#.Some (#analysisL.Variable ref)))) + + #.None + (wrap #.None)))) + +(def: #export (reference reference) + (-> Ident (Meta Analysis)) + (case reference + ["" simple-name] + (do macro.Monad + [?var (variable simple-name)] + (case ?var + (#.Some varA) + (wrap varA) + + #.None + (do @ + [this-module macro.current-module-name] + (definition [this-module simple-name])))) + + _ + (definition reference))) diff --git a/stdlib/source/lux/lang/scope.lux b/stdlib/source/lux/lang/scope.lux new file mode 100644 index 000000000..45008ae24 --- /dev/null +++ b/stdlib/source/lux/lang/scope.lux @@ -0,0 +1,173 @@ +(.module: + lux + (lux (control monad) + (data [text "text/" Eq] + text/format + [maybe "maybe/" Monad] + [product] + ["e" error] + (coll [list "list/" Functor Fold Monoid] + (dictionary [plist]))) + [macro]) + (// [analysis #+ Variable])) + +(type: Locals (Bindings Text [Type Nat])) +(type: Foreign (Bindings Text [Type Variable])) + +(def: (is-local? name scope) + (-> Text Scope Bool) + (|> scope + (get@ [#.locals #.mappings]) + (plist.contains? name))) + +(def: (get-local name scope) + (-> Text Scope (Maybe [Type Variable])) + (|> scope + (get@ [#.locals #.mappings]) + (plist.get name) + (maybe/map (function (_ [type value]) + [type (#analysis.Local value)])))) + +(def: (is-captured? name scope) + (-> Text Scope Bool) + (|> scope + (get@ [#.captured #.mappings]) + (plist.contains? name))) + +(def: (get-captured name scope) + (-> Text Scope (Maybe [Type Variable])) + (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 (#analysis.Foreign idx)]) + (recur (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 Variable])) + (case (get-local name scope) + (#.Some type) + (#.Some type) + + _ + (get-captured name scope))) + +(def: #export (find name) + (-> Text (Meta (Maybe [Type Variable]))) + (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 [Variable (List Scope)] [Variable (List Scope)]) + (function (_ scope ref+inner) + [(#analysis.Foreign (get@ [#.captured #.counter] scope)) + (#.Cons (update@ #.captured + (: (-> Foreign Foreign) + (|>> (update@ #.counter inc) + (update@ #.mappings (plist.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 inc) + (update@ #.mappings (plist.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 [ ] + [(def: + (Bindings Text [Type ]) + {#.counter +0 + #.mappings (list)})] + + [init-locals Nat] + [init-captured Variable] + ) + +(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)])))) -- cgit v1.2.3