diff options
Diffstat (limited to 'new-luxc/source/luxc')
-rw-r--r-- | new-luxc/source/luxc/lang/analysis/function.lux | 111 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/variable.lux | 47 |
2 files changed, 0 insertions, 158 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/function.lux b/new-luxc/source/luxc/lang/analysis/function.lux deleted file mode 100644 index eaddfa5bb..000000000 --- a/new-luxc/source/luxc/lang/analysis/function.lux +++ /dev/null @@ -1,111 +0,0 @@ -(.module: - lux - (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]))) - (luxc ["&" lang] - (lang ["&." scope] - ["la" analysis #+ Analysis] - (analysis ["&." common] - ["&." inference]) - [".L" variable #+ Variable]))) - -(do-template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [Cannot-Analyse-Function] - [Invalid-Function-Type] - [Cannot-Apply-Function] - ) - -## [Analysers] -(def: #export (analyse-function analyse func-name arg-name body) - (-> &.Analyser Text Text Code (Meta Analysis)) - (do macro.Monad<Meta> - [functionT macro.expected-type] - (loop [expectedT functionT] - (&.with-stacked-errors - (function (_ _) - (ex.construct Cannot-Analyse-Function - (format " Type: " (%type expectedT) "\n" - "Function: " func-name "\n" - "Argument: " arg-name "\n" - " Body: " (%code body)))) - (case expectedT - (#.Named name unnamedT) - (recur unnamedT) - - (#.Apply argT funT) - (case (type.apply (list argT) funT) - (#.Some value) - (recur value) - - #.None - (&.throw Invalid-Function-Type (%type expectedT))) - - (^template [<tag> <instancer>] - (<tag> _) - (do @ - [[_ instanceT] (&.with-type-env <instancer>)] - (recur (maybe.assume (type.apply (list instanceT) expectedT))))) - ([#.UnivQ tc.existential] - [#.ExQ tc.var]) - - (#.Var id) - (do @ - [?expectedT' (&.with-type-env - (tc.read id))] - (case ?expectedT' - (#.Some expectedT') - (recur expectedT') - - _ - ## Inference - (do @ - [[input-id inputT] (&.with-type-env tc.var) - [output-id outputT] (&.with-type-env tc.var) - #let [funT (#.Function inputT outputT)] - funA (recur funT) - _ (&.with-type-env - (tc.check expectedT funT))] - (wrap funA)) - )) - - (#.Function inputT outputT) - (<| (:: @ map (function (_ [scope bodyA]) - (` ("lux function" [(~+ (list/map code.int (variableL.environment scope)))] - (~ bodyA))))) - &.with-scope - ## Functions have access not only to their argument, but - ## also to themselves, through a local variable. - (&scope.with-local [func-name expectedT]) - (&scope.with-local [arg-name inputT]) - (&.with-type outputT) - (analyse body)) - - _ - (&.fail "") - ))))) - -(def: #export (analyse-apply analyse funcT funcA args) - (-> &.Analyser Type Analysis (List Code) (Meta Analysis)) - (&.with-stacked-errors - (function (_ _) - (ex.construct Cannot-Apply-Function - (format " Function: " (%type funcT) "\n" - "Arguments:" (|> args - list.enumerate - (list/map (function (_ [idx argC]) - (format "\n " (%n idx) " " (%code argC)))) - (text.join-with ""))))) - (do macro.Monad<Meta> - [[applyT argsA] (&inference.general analyse funcT args)] - (wrap (la.apply argsA funcA))))) diff --git a/new-luxc/source/luxc/lang/variable.lux b/new-luxc/source/luxc/lang/variable.lux deleted file mode 100644 index b33574d19..000000000 --- a/new-luxc/source/luxc/lang/variable.lux +++ /dev/null @@ -1,47 +0,0 @@ -(.module: - lux - (lux (data (coll [list "list/" Functor<List>])))) - -(def: #export Variable Int) -(def: #export Register Nat) - -(def: #export (captured register) - (-> Register Variable) - (|> register n/inc nat-to-int (i/* -1))) - -(def: #export (local register) - (-> Register Variable) - (nat-to-int register)) - -(def: #export (local-register variable) - (-> Variable Register) - (int-to-nat variable)) - -(def: #export (captured-register variable) - (-> Variable Register) - (|> variable (i/* -1) int-to-nat n/dec)) - -(do-template [<name> <comp>] - [(def: #export (<name> var) - (-> Variable Bool) - (<comp> 0 var))] - - [self? i/=] - [local? i/>] - [captured? i/<] - ) - -(def: #export (from-ref ref) - (-> Ref Variable) - (case ref - (#.Local register) - (local register) - - (#.Captured register) - (captured register))) - -(def: #export (environment scope) - (-> Scope (List Variable)) - (|> scope - (get@ [#.captured #.mappings]) - (list/map (function (_ [_ [_ ref]]) (from-ref ref))))) |