From 2a3946e713821880ecc47580e754315349f2fe73 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 13 Nov 2017 20:02:18 -0400
Subject: - Type-vars no longer get deleted. - Fixed some bugs.
---
new-luxc/source/luxc/lang/analysis/case.lux | 2 +-
new-luxc/source/luxc/lang/analysis/common.lux | 25 +++++++++++-------------
new-luxc/source/luxc/lang/analysis/function.lux | 5 +----
new-luxc/source/luxc/lang/analysis/inference.lux | 12 +++++++-----
new-luxc/source/luxc/lang/analysis/structure.lux | 18 +++++++----------
new-luxc/source/luxc/lang/analysis/type.lux | 12 ++++++------
6 files changed, 33 insertions(+), 41 deletions(-)
(limited to 'new-luxc/source/luxc/lang/analysis')
diff --git a/new-luxc/source/luxc/lang/analysis/case.lux b/new-luxc/source/luxc/lang/analysis/case.lux
index f68733d7f..5f8ed344f 100644
--- a/new-luxc/source/luxc/lang/analysis/case.lux
+++ b/new-luxc/source/luxc/lang/analysis/case.lux
@@ -46,7 +46,7 @@
(#;Var id)
(do meta;Monad
[? (&;with-type-env
- (tc;bound? id))]
+ (tc;concrete? id))]
(if ?
(do @
[type' (&;with-type-env
diff --git a/new-luxc/source/luxc/lang/analysis/common.lux b/new-luxc/source/luxc/lang/analysis/common.lux
index 4cbf5aedf..4d16e4ae6 100644
--- a/new-luxc/source/luxc/lang/analysis/common.lux
+++ b/new-luxc/source/luxc/lang/analysis/common.lux
@@ -1,7 +1,7 @@
(;module:
lux
(lux (control monad
- pipe)
+ ["ex" exception #+ exception:])
(data text/format
[product])
[meta #+ Monad]
@@ -14,28 +14,25 @@
(All [a] (-> (Meta Analysis) (Meta [Type Analysis])))
(do Monad
[[var-id var-type] (&;with-type-env
- tc;create)
+ tc;var)
analysis (&;with-expected-type var-type
action)
analysis-type (&;with-type-env
- (tc;clean var-id var-type))
- _ (&;with-type-env
- (tc;delete var-id))]
+ (tc;clean var-id var-type))]
(wrap [analysis-type analysis])))
(def: #export (with-var body)
(All [a] (-> (-> [Nat Type] (Meta a)) (Meta a)))
(do Monad
[[id var] (&;with-type-env
- tc;create)
- output (body [id var])
- _ (&;with-type-env
- (tc;delete id))]
- (wrap output)))
+ tc;var)]
+ (body [id var])))
+
+(exception: #export Variant-Tag-Out-Of-Bounds)
(def: #export (variant-out-of-bounds-error type size tag)
(All [a] (-> Type Nat Nat (Meta a)))
- (&;fail (format "Trying to create variant with tag beyond type's limitations." "\n"
- " Tag: " (%i (nat-to-int tag)) "\n"
- "Size: " (%i (nat-to-int size)) "\n"
- "Type: " (%type type))))
+ (&;throw Variant-Tag-Out-Of-Bounds
+ (format " Tag: " (%n tag) "\n"
+ "Variant Size: " (%n size) "\n"
+ "Variant Type: " (%type type))))
diff --git a/new-luxc/source/luxc/lang/analysis/function.lux b/new-luxc/source/luxc/lang/analysis/function.lux
index 5a6df4d3e..42a021577 100644
--- a/new-luxc/source/luxc/lang/analysis/function.lux
+++ b/new-luxc/source/luxc/lang/analysis/function.lux
@@ -108,8 +108,5 @@
(format "\n " (%n idx) " " (%code argC))))
(text;join-with "")))))
(do meta;Monad
- [expectedT meta;expected-type
- [applyT argsA] (&inference;apply-function analyse funcT args)
- _ (&;with-type-env
- (tc;check expectedT applyT))]
+ [[applyT argsA] (&inference;apply-function analyse funcT args)]
(wrap (la;apply argsA funcA)))))
diff --git a/new-luxc/source/luxc/lang/analysis/inference.lux b/new-luxc/source/luxc/lang/analysis/inference.lux
index fea685024..e2866ac87 100644
--- a/new-luxc/source/luxc/lang/analysis/inference.lux
+++ b/new-luxc/source/luxc/lang/analysis/inference.lux
@@ -99,7 +99,9 @@
(-> &;Analyser Type (List Code) (Meta [Type (List Analysis)]))
(case args
#;Nil
- (:: Monad wrap [inferT (list)])
+ (do Monad
+ [_ (&;infer inferT)]
+ (wrap [inferT (list)]))
(#;Cons argC args')
(case inferT
@@ -113,7 +115,7 @@
[[outputT argsA] (apply-function analyse (maybe;assume (type;apply (list varT) inferT)) args)]
(do @
[? (&;with-type-env
- (tc;bound? var-id))
+ (tc;concrete? var-id))
## Quantify over the type if genericity/parametricity
## is discovered.
outputT' (if ?
@@ -145,13 +147,13 @@
## things together more easily.
(#;Function inputT outputT)
(do Monad
- [argA (&;with-stacked-errors
+ [[outputT' args'A] (apply-function analyse outputT args')
+ argA (&;with-stacked-errors
(function [_] (Cannot-Infer-Argument
(format "Inferred Type: " (%type inputT) "\n"
" Argument: " (%code argC))))
(&;with-expected-type inputT
- (analyse argC)))
- [outputT' args'A] (apply-function analyse outputT args')]
+ (analyse argC)))]
(wrap [outputT' (list& argA args'A)]))
_
diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux
index 5cac1a0d3..9308fcfef 100644
--- a/new-luxc/source/luxc/lang/analysis/structure.lux
+++ b/new-luxc/source/luxc/lang/analysis/structure.lux
@@ -64,9 +64,9 @@
(#;Var id)
(do @
- [bound? (&;with-type-env
- (tc;bound? id))]
- (if bound?
+ [concrete? (&;with-type-env
+ (tc;concrete? id))]
+ (if concrete?
(do @
[expectedT' (&;with-type-env
(tc;read id))]
@@ -171,9 +171,9 @@
(#;Var id)
(do @
- [bound? (&;with-type-env
- (tc;bound? id))]
- (if bound?
+ [concrete? (&;with-type-env
+ (tc;concrete? id))]
+ (if concrete?
(do @
[expectedT' (&;with-type-env
(tc;read id))]
@@ -227,8 +227,6 @@
[#let [case-size (list;size group)]
inferenceT (&inference;variant idx case-size variantT)
[inferredT valueA+] (&inference;apply-function analyse inferenceT (list valueC))
- _ (&;with-type-env
- (tc;check expectedT inferredT))
temp &scope;next-local]
(wrap (la;sum idx case-size temp (|> valueA+ list;head maybe;assume))))
@@ -308,9 +306,7 @@
(#;Var _)
(do @
[inferenceT (&inference;record recordT)
- [inferredT membersA] (&inference;apply-function analyse inferenceT membersC)
- _ (&;with-type-env
- (tc;check expectedT inferredT))]
+ [inferredT membersA] (&inference;apply-function analyse inferenceT membersC)]
(wrap (la;product membersA)))
_
diff --git a/new-luxc/source/luxc/lang/analysis/type.lux b/new-luxc/source/luxc/lang/analysis/type.lux
index 74bb712f4..0a8abd76b 100644
--- a/new-luxc/source/luxc/lang/analysis/type.lux
+++ b/new-luxc/source/luxc/lang/analysis/type.lux
@@ -1,8 +1,8 @@
(;module:
lux
(lux (control monad)
- [meta #+ Monad]
- (meta (type ["TC" check])))
+ [meta]
+ (meta (type ["tc" check])))
(luxc ["&" base]
(lang ["la" analysis #+ Analysis])))
@@ -11,21 +11,21 @@
## computing Lux type values.
(def: #export (analyse-check analyse eval type value)
(-> &;Analyser &;Eval Code Code (Meta Analysis))
- (do Monad
+ (do meta;Monad
[actualT (eval Type type)
#let [actualT (:! Type actualT)]
expectedT meta;expected-type
_ (&;with-type-env
- (TC;check expectedT actualT))]
+ (tc;check expectedT actualT))]
(&;with-expected-type actualT
(analyse value))))
(def: #export (analyse-coerce analyse eval type value)
(-> &;Analyser &;Eval Code Code (Meta Analysis))
- (do Monad
+ (do meta;Monad
[actualT (eval Type type)
expectedT meta;expected-type
_ (&;with-type-env
- (TC;check expectedT (:! Type actualT)))]
+ (tc;check expectedT (:! Type actualT)))]
(&;with-expected-type Top
(analyse value))))
--
cgit v1.2.3