aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/analyser/function.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/analyser/function.lux')
-rw-r--r--new-luxc/source/luxc/analyser/function.lux111
1 files changed, 0 insertions, 111 deletions
diff --git a/new-luxc/source/luxc/analyser/function.lux b/new-luxc/source/luxc/analyser/function.lux
deleted file mode 100644
index 3d2da6326..000000000
--- a/new-luxc/source/luxc/analyser/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>]))
- [meta]
- (meta [code]
- [type]
- (type ["tc" check])))
- (luxc ["&" base]
- (lang ["la" analysis #+ Analysis]
- [";L" variable #+ Variable])
- ["&;" scope]
- (analyser ["&;" common]
- ["&;" inference])))
-
-(exception: #export Invalid-Function-Type)
-(exception: #export Cannot-Apply-Function)
-
-## [Analysers]
-(def: #export (analyse-function analyse func-name arg-name body)
- (-> &;Analyser Text Text Code (Meta Analysis))
- (do meta;Monad<Meta>
- [functionT meta;expected-type]
- (loop [expectedT functionT]
- (&;with-stacked-errors
- (function [_] (Invalid-Function-Type (%type expectedT)))
- (case expectedT
- (#;Named name unnamedT)
- (recur unnamedT)
-
- (#;Apply argT funT)
- (case (type;apply (list argT) funT)
- (#;Some value)
- (recur value)
-
- #;None
- (&;fail (format "Cannot apply type " (%type funT) " to type " (%type argT))))
-
- (#;UnivQ _)
- (do @
- [[var-id var] (&;with-type-env
- tc;existential)]
- (recur (maybe;assume (type;apply (list var) expectedT))))
-
- (#;ExQ _)
- (&common;with-var
- (function [[var-id var]]
- (recur (maybe;assume (type;apply (list var) expectedT)))))
-
- (#;Var id)
- (do @
- [? (&;with-type-env
- (tc;concrete? id))]
- (if ?
- (do @
- [expectedT' (&;with-type-env
- (tc;read id))]
- (recur expectedT'))
- ## Inference
- (&common;with-var
- (function [[input-id inputT]]
- (&common;with-var
- (function [[output-id outputT]]
- (do @
- [#let [funT (#;Function inputT outputT)]
- funA (recur funT)
- funT' (&;with-type-env
- (tc;clean output-id funT))
- concrete-input? (&;with-type-env
- (tc;concrete? input-id))
- funT'' (if concrete-input?
- (&;with-type-env
- (tc;clean input-id funT'))
- (wrap (type;univ-q +1 (&inference;replace-var input-id +1 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-expected-type outputT)
- (analyse body))
-
- _
- (&;fail "")
- )))))
-
-(def: #export (analyse-apply analyse funcT funcA args)
- (-> &;Analyser Type Analysis (List Code) (Meta Analysis))
- (&;with-stacked-errors
- (function [_]
- (Cannot-Apply-Function (format " Function: " (%type funcT) "\n"
- "Arguments: " (|> args (list/map %code) (text;join-with " ")))))
- (do meta;Monad<Meta>
- [expected meta;expected-type
- [applyT argsA] (&inference;apply-function analyse funcT args)
- _ (&;with-type-env
- (tc;check expected applyT))]
- (wrap (la;apply argsA funcA)))))