aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/analysis/function.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/analysis/function.lux44
1 files changed, 21 insertions, 23 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/function.lux b/new-luxc/source/luxc/lang/analysis/function.lux
index 42a021577..0bb46aba1 100644
--- a/new-luxc/source/luxc/lang/analysis/function.lux
+++ b/new-luxc/source/luxc/lang/analysis/function.lux
@@ -38,7 +38,7 @@
(recur value)
#;None
- (&;fail (format "Cannot apply type " (%type funT) " to type " (%type argT))))
+ (&;throw Invalid-Function-Type (%type expectedT)))
(#;UnivQ _)
(do @
@@ -47,9 +47,9 @@
(recur (maybe;assume (type;apply (list var) expectedT))))
(#;ExQ _)
- (&common;with-var
- (function [[var-id var]]
- (recur (maybe;assume (type;apply (list var) expectedT)))))
+ (do @
+ [[var-id var] (&;with-type-env tc;var)]
+ (recur (maybe;assume (type;apply (list var) expectedT))))
(#;Var id)
(do @
@@ -61,25 +61,23 @@
(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))
- ))))))
+ (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)
+ 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]]