aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/analyser
diff options
context:
space:
mode:
authorEduardo Julian2017-05-31 21:35:39 -0400
committerEduardo Julian2017-05-31 21:35:39 -0400
commitaa3dcb411db1bfbf41ca59c334c6c792b9e40d0c (patch)
tree0095015807b18d65e9938cf9db686d8f29d87afb /new-luxc/source/luxc/analyser
parentb73f1c909d19d5492d6d9a7dc707a3b817c73619 (diff)
- Implemented some synthesis algorithms and tests for primitives, structures, procedures and function application.
- Some refactoring.
Diffstat (limited to 'new-luxc/source/luxc/analyser')
-rw-r--r--new-luxc/source/luxc/analyser/function.lux5
-rw-r--r--new-luxc/source/luxc/analyser/structure.lux55
2 files changed, 5 insertions, 55 deletions
diff --git a/new-luxc/source/luxc/analyser/function.lux b/new-luxc/source/luxc/analyser/function.lux
index 1aad8954e..5144534fb 100644
--- a/new-luxc/source/luxc/analyser/function.lux
+++ b/new-luxc/source/luxc/analyser/function.lux
@@ -100,7 +100,4 @@
[applyT argsA] (&inference;apply-function analyse funcT args)
_ (&;within-type-env
(TC;check expected applyT))]
- (wrap (L/fold (function [arg func]
- (#la;Apply arg func))
- funcA
- argsA)))))
+ (wrap (la;apply argsA funcA)))))
diff --git a/new-luxc/source/luxc/analyser/structure.lux b/new-luxc/source/luxc/analyser/structure.lux
index f93534463..37266b2fe 100644
--- a/new-luxc/source/luxc/analyser/structure.lux
+++ b/new-luxc/source/luxc/analyser/structure.lux
@@ -24,37 +24,6 @@
(analyser ["&;" common]
["&;" inference])))
-## Variants get analysed as binary sum types for the sake of semantic
-## simplicity.
-## This is because you can encode a variant of any size using just
-## binary sums by nesting them.
-
-(do-template [<name> <side>]
- [(def: (<name> inner)
- (-> la;Analysis la;Analysis)
- (#la;Sum (<side> inner)))]
-
- [sum-left #;Left]
- [sum-right #;Right])
-
-(def: (variant tag size temp value)
- (-> Nat Nat Nat la;Analysis la;Analysis)
- (if (n.= (n.dec size) tag)
- (if (n.= +1 tag)
- (sum-right value)
- (L/fold (function;const sum-left)
- (sum-right value)
- (list;n.range +0 (n.- +2 tag))))
- (L/fold (function;const sum-left)
- (case value
- (#la;Sum _)
- (#la;Case value (list [(#la;BindP temp)
- (#la;Relative (#;Local temp))]))
-
- _
- value)
- (list;n.range +0 tag))))
-
(def: #export (analyse-sum analyse tag valueC)
(-> &;Analyser Nat Code (Lux la;Analysis))
(do Monad<Lux>
@@ -71,7 +40,7 @@
[valueA (&;with-expected-type variant-type
(analyse valueC))
temp &env;next-local]
- (wrap (variant tag type-size temp valueA)))
+ (wrap (la;sum tag type-size temp valueA)))
#;None
(&common;variant-out-of-bounds-error expected type-size tag)))
@@ -111,22 +80,6 @@
_
(&;fail "")))))
-## Tuples get analysed into binary products for the sake of semantic
-## simplicity, since products/pairs can encode tuples of any length
-## through nesting.
-
-(def: (product members)
- (-> (List la;Analysis) la;Analysis)
- (case members
- #;Nil
- #la;Unit
-
- (#;Cons singleton #;Nil)
- singleton
-
- (#;Cons left right)
- (#la;Product left (product right))))
-
(def: (analyse-typed-product analyse members)
(-> &;Analyser (List Code) (Lux la;Analysis))
(do Monad<Lux>
@@ -206,7 +159,7 @@
_ (&;within-type-env
(TC;check expected
(type;tuple (L/map product;left membersTA))))]
- (wrap (product (L/map product;right membersTA))))))
+ (wrap (la;product (L/map product;right membersTA))))))
(#;UnivQ _)
(do @
@@ -237,7 +190,7 @@
_ (&;within-type-env
(TC;check expectedT inferredT))
temp &env;next-local]
- (wrap (variant idx case-size temp (|> valueA+ list;head assume)))))
+ (wrap (la;sum idx case-size temp (|> valueA+ list;head assume)))))
## There cannot be any ambiguity or improper syntax when analysing
## records, so they must be normalized for further analysis.
@@ -312,4 +265,4 @@
[inferredT membersA] (&inference;apply-function analyse inferenceT members)
_ (&;within-type-env
(TC;check expectedT inferredT))]
- (wrap (product membersA))))
+ (wrap (la;product membersA))))