diff options
Diffstat (limited to 'stdlib/source/lux/lang/compiler/analysis/function.lux')
-rw-r--r-- | stdlib/source/lux/lang/compiler/analysis/function.lux | 103 |
1 files changed, 103 insertions, 0 deletions
diff --git a/stdlib/source/lux/lang/compiler/analysis/function.lux b/stdlib/source/lux/lang/compiler/analysis/function.lux new file mode 100644 index 000000000..b6e09f11a --- /dev/null +++ b/stdlib/source/lux/lang/compiler/analysis/function.lux @@ -0,0 +1,103 @@ +(.module: + [lux #- function] + (lux (control monad + ["ex" exception #+ exception:]) + (data [maybe] + [text] + text/format + (coll [list "list/" Fold<List> Monoid<List> Monad<List>])) + [macro] + (macro [code]) + (lang [type] + (type ["tc" check]) + [".L" scope])) + [///] + [// #+ Analysis Compiler] + [//type] + [//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 ""))])) + +(def: #export (function analyse function-name arg-name body) + (-> Compiler Text Text Code (Meta Analysis)) + (do macro.Monad<Meta> + [functionT macro.expected-type] + (loop [expectedT functionT] + (///.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 + (///.fail (ex.construct cannot-analyse [expectedT function-name arg-name body]))) + + (^template [<tag> <instancer>] + (<tag> _) + (do @ + [[_ instanceT] (//type.with-env <instancer>)] + (recur (maybe.assume (type.apply (list instanceT) expectedT))))) + ([#.UnivQ tc.existential] + [#.ExQ tc.var]) + + (#.Var id) + (do @ + [?expectedT' (//type.with-env + (tc.read id))] + (case ?expectedT' + (#.Some expectedT') + (recur expectedT') + + ## Inference + _ + (do @ + [[input-id inputT] (//type.with-env tc.var) + [output-id outputT] (//type.with-env tc.var) + #let [functionT (#.Function inputT outputT)] + functionA (recur functionT) + _ (//type.with-env + (tc.check expectedT functionT))] + (wrap functionA)) + )) + + (#.Function inputT outputT) + (<| (:: @ map (.function (_ [scope bodyA]) + (#//.Function (scopeL.environment scope) bodyA))) + //.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]) + (//type.with-type outputT) + (analyse body)) + + _ + (///.fail "") + ))))) + +(def: #export (apply analyse functionT functionA args) + (-> Compiler Type Analysis (List Code) (Meta Analysis)) + (///.with-stacked-errors + (.function (_ _) + (ex.construct cannot-apply [functionT args])) + (do macro.Monad<Meta> + [[applyT argsA] (//inference.general analyse functionT args)] + (wrap (//.apply [functionA argsA]))))) |