From 6bbae1a36c351eaae4dc909714e7f3c7bfeaeca3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 16 May 2018 01:46:19 -0400 Subject: - Migrated function analysis to stdlib. --- stdlib/source/lux/lang/analysis.lux | 16 +++- stdlib/source/lux/lang/analysis/expression.lux | 4 +- stdlib/source/lux/lang/analysis/function.lux | 104 +++++++++++++++++++++++++ stdlib/source/lux/lang/scope.lux | 19 ++++- 4 files changed, 136 insertions(+), 7 deletions(-) create mode 100644 stdlib/source/lux/lang/analysis/function.lux (limited to 'stdlib/source') diff --git a/stdlib/source/lux/lang/analysis.lux b/stdlib/source/lux/lang/analysis.lux index 6b2ba097d..223f2fb29 100644 --- a/stdlib/source/lux/lang/analysis.lux +++ b/stdlib/source/lux/lang/analysis.lux @@ -55,6 +55,8 @@ (type: #export Tuple (List Analysis)) +(type: #export Application [Analysis (List Analysis)]) + (do-template [ ] [(def: (-> Analysis Analysis) @@ -103,8 +105,8 @@ (list/fold (function (_ left right) (#Structure (#Product left right))) last prevs))) -(def: #export (apply args func) - (-> (List Analysis) Analysis Analysis) +(def: #export (apply [func args]) + (-> Application Analysis) (list/fold (function (_ arg func) (#Apply arg func)) func args)) (type: #export Analyser @@ -141,3 +143,13 @@ _ #.None))) + +(def: #export (application analysis) + (-> Analysis Application) + (case analysis + (#Apply head func) + (let [[func' tail] (application func)] + [func' (#.Cons head tail)]) + + _ + [analysis (list)])) diff --git a/stdlib/source/lux/lang/analysis/expression.lux b/stdlib/source/lux/lang/analysis/expression.lux index 5013246aa..da1b27a10 100644 --- a/stdlib/source/lux/lang/analysis/expression.lux +++ b/stdlib/source/lux/lang/analysis/expression.lux @@ -13,9 +13,7 @@ (analysis [".A" type] [".A" primitive] [".A" structure] - [".A" reference] - ## [".A" function] - ) + [".A" reference]) ## [".L" macro] ## [".L" extension] ))) diff --git a/stdlib/source/lux/lang/analysis/function.lux b/stdlib/source/lux/lang/analysis/function.lux new file mode 100644 index 000000000..f6fea9bb0 --- /dev/null +++ b/stdlib/source/lux/lang/analysis/function.lux @@ -0,0 +1,104 @@ +(.module: + [lux #- function] + (lux (control monad + ["ex" exception #+ exception:]) + (data [maybe] + [text] + text/format + (coll [list "list/" Fold Monoid Monad])) + [macro] + (macro [code]) + [lang] + (lang [type] + (type ["tc" check]) + [".L" scope] + [".L" analysis #+ Analysis Analyser] + (analysis [".A" type] + [".A" inference])))) + +(exception: #export (cannot-analyse {expected Type} {function Text} {argument Text} {body Code}) + (ex.report ["Type" (%type expected)] + ["Function" function] + ["Argument" argument] + ["Body" (%code body)])) + +(exception: #export (cannot-apply {function Type} {arguments (List Code)}) + (ex.report [" Function" (%type function)] + ["Arguments" (|> arguments + list.enumerate + (list/map (.function (_ [idx argC]) + (format "\n " (%n idx) " " (%code argC)))) + (text.join-with ""))])) + +## [Analysers] +(def: #export (function analyse function-name arg-name body) + (-> Analyser Text Text Code (Meta Analysis)) + (do macro.Monad + [functionT macro.expected-type] + (loop [expectedT functionT] + (lang.with-stacked-errors + (.function (_ _) + (ex.construct cannot-analyse [expectedT function-name arg-name body])) + (case expectedT + (#.Named name unnamedT) + (recur unnamedT) + + (#.Apply argT funT) + (case (type.apply (list argT) funT) + (#.Some value) + (recur value) + + #.None + (lang.fail (ex.construct cannot-analyse [expectedT function-name arg-name body]))) + + (^template [ ] + ( _) + (do @ + [[_ instanceT] (typeA.with-env )] + (recur (maybe.assume (type.apply (list instanceT) expectedT))))) + ([#.UnivQ tc.existential] + [#.ExQ tc.var]) + + (#.Var id) + (do @ + [?expectedT' (typeA.with-env + (tc.read id))] + (case ?expectedT' + (#.Some expectedT') + (recur expectedT') + + _ + ## Inference + (do @ + [[input-id inputT] (typeA.with-env tc.var) + [output-id outputT] (typeA.with-env tc.var) + #let [functionT (#.Function inputT outputT)] + functionA (recur functionT) + _ (typeA.with-env + (tc.check expectedT functionT))] + (wrap functionA)) + )) + + (#.Function inputT outputT) + (<| (:: @ map (.function (_ [scope bodyA]) + (#analysisL.Function (scopeL.environment scope) bodyA))) + lang.with-scope + ## Functions have access not only to their argument, but + ## also to themselves, through a local variable. + (scopeL.with-local [function-name expectedT]) + (scopeL.with-local [arg-name inputT]) + (typeA.with-type outputT) + (analyse body)) + + _ + (lang.fail "") + ))))) + +(def: #export (apply analyse functionT functionA args) + (-> Analyser Type Analysis (List Code) (Meta Analysis)) + (lang.with-stacked-errors + (.function (_ _) + (ex.construct cannot-apply [functionT args])) + (do macro.Monad + [[applyT argsA] (inferenceA.general analyse functionT args)] + (wrap (analysisL.apply [functionA argsA]))))) diff --git a/stdlib/source/lux/lang/scope.lux b/stdlib/source/lux/lang/scope.lux index 45008ae24..1995338f4 100644 --- a/stdlib/source/lux/lang/scope.lux +++ b/stdlib/source/lux/lang/scope.lux @@ -9,7 +9,7 @@ (coll [list "list/" Functor Fold Monoid] (dictionary [plist]))) [macro]) - (// [analysis #+ Variable])) + (// [analysis #+ Variable Register])) (type: Locals (Bindings Text [Type Nat])) (type: Foreign (Bindings Text [Type Variable])) @@ -163,7 +163,7 @@ )) (def: #export next-local - (Meta Nat) + (Meta Register) (function (_ compiler) (case (get@ #.scopes compiler) #.Nil @@ -171,3 +171,18 @@ (#.Cons top _) (#e.Success [compiler (get@ [#.locals #.counter] top)])))) + +(def: (ref-to-variable ref) + (-> Ref Variable) + (case ref + (#.Local register) + (#analysis.Local register) + + (#.Captured register) + (#analysis.Foreign register))) + +(def: #export (environment scope) + (-> Scope (List Variable)) + (|> scope + (get@ [#.captured #.mappings]) + (list/map (function (_ [_ [_ ref]]) (ref-to-variable ref))))) -- cgit v1.2.3