From dd5220e13b03c8f85972feac535a34ef64525222 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 9 May 2017 17:48:27 -0400 Subject: - Added tests for some kinds of analysis. - WIP: Porting more code. --- new-luxc/source/luxc/analyser/common.lux | 7 +---- new-luxc/source/luxc/analyser/lux.lux | 52 +++++++++++++++---------------- new-luxc/source/luxc/analyser/pattern.lux | 3 ++ 3 files changed, 30 insertions(+), 32 deletions(-) create mode 100644 new-luxc/source/luxc/analyser/pattern.lux (limited to 'new-luxc/source/luxc/analyser') diff --git a/new-luxc/source/luxc/analyser/common.lux b/new-luxc/source/luxc/analyser/common.lux index e77819779..ed2b6eba7 100644 --- a/new-luxc/source/luxc/analyser/common.lux +++ b/new-luxc/source/luxc/analyser/common.lux @@ -8,12 +8,7 @@ [type] (type ["TC" check])) (luxc ["&" base] - lang)) - -(def: #export get-type - (-> Analysis Type) - (|>. product;left - product;left)) + (lang analysis))) (def: #export (replace-type replacement analysis) (-> Type Analysis Analysis) diff --git a/new-luxc/source/luxc/analyser/lux.lux b/new-luxc/source/luxc/analyser/lux.lux index f0e9a3538..e215412c6 100644 --- a/new-luxc/source/luxc/analyser/lux.lux +++ b/new-luxc/source/luxc/analyser/lux.lux @@ -15,7 +15,7 @@ [type] (type ["TC" check])) (luxc ["&" base] - [lang #*] + (lang ["la" analysis #+ Analysis]) ["&;" module] ["&;" env] (analyser ["&;" common]))) @@ -28,15 +28,15 @@ _ (&;within-type-env (TC;check expected ))] (wrap [[expected cursor] - (#lang;Primitive ( value))])))] - - [analyse-bool Bool #lang;Bool] - [analyse-nat Nat #lang;Nat] - [analyse-int Int #lang;Int] - [analyse-deg Deg #lang;Deg] - [analyse-real Real #lang;Real] - [analyse-char Char #lang;Char] - [analyse-text Text #lang;Text] + ( value)])))] + + [analyse-bool Bool #la;Bool] + [analyse-nat Nat #la;Nat] + [analyse-int Int #la;Int] + [analyse-deg Deg #la;Deg] + [analyse-real Real #la;Real] + [analyse-char Char #la;Char] + [analyse-text Text #la;Text] ) (def: #export (analyse-unit cursor) @@ -46,9 +46,9 @@ _ (&;within-type-env (TC;check expected Unit))] (wrap [[expected cursor] - (#lang;Primitive #lang;Unit)]))) + #la;Unit]))) -(def: #export (analyse-definition cursor def-name) +(def: (analyse-definition cursor def-name) (-> Cursor Ident (Lux Analysis)) (do Monad [actual (macro;find-def-type def-name) @@ -56,9 +56,9 @@ _ (&;within-type-env (TC;check expected actual))] (wrap [[expected cursor] - (#lang;Reference (#lang;Absolute def-name))]))) + (#la;Absolute def-name)]))) -(def: #export (analyse-variable cursor var-name) +(def: (analyse-variable cursor var-name) (-> Cursor Text (Lux (Maybe Analysis))) (do Monad [?var (&env;find var-name)] @@ -69,7 +69,7 @@ _ (&;within-type-env (TC;check expected actual)) #let [analysis [[expected cursor] - (#lang;Reference (#lang;Relative ref))]]] + (#la;Relative ref)]]] (wrap (#;Some analysis))) #;None @@ -94,7 +94,7 @@ (analyse-definition cursor reference))) (def: #export (analyse-check analyse eval cursor type value) - (-> Analyser Eval Cursor Code Code (Lux Analysis)) + (-> &;Analyser &;Eval Cursor Code Code (Lux Analysis)) (do Monad [actual (eval Type type) #let [actual (:! Type actual)] @@ -105,7 +105,7 @@ (analyse eval value)))) (def: #export (analyse-coerce analyse eval cursor type value) - (-> Analyser Eval Cursor Code Code (Lux Analysis)) + (-> &;Analyser &;Eval Cursor Code Code (Lux Analysis)) (do Monad [actual (eval Type type) #let [actual (:! Type actual)] @@ -134,7 +134,7 @@ (analyse member))) (list;zip2 member-types members)))] (wrap [[expected cursor] - (#lang;Structure (#lang;Tuple =tuple))])) + (#la;Tuple =tuple)])) (n.< num-types num-members) (do @ @@ -149,7 +149,7 @@ (analyse (default (undefined) (list;last members))))] (wrap [[expected cursor] - (#lang;Structure (#lang;Tuple (L/append =prevs (list =last))))])) + (#la;Tuple (L/append =prevs (list =last)))])) ## (n.> num-types num-members) (do @ @@ -164,14 +164,14 @@ (list;last member-types)) (analyse-typed-tuple analyse cursor tail-xs))] (wrap [[expected cursor] - (#lang;Structure (#lang;Tuple (L/append =prevs (list =last))))])) + (#la;Tuple (L/append =prevs (list =last)))])) )))) (def: (tuple cursor members) (-> Cursor (List Analysis) Analysis) - (let [tuple-type (type;tuple (L/map &common;get-type members))] + (let [tuple-type (type;tuple (L/map la;get-type members))] [[tuple-type cursor] - (#lang;Structure (#lang;Tuple members))])) + (#la;Tuple members)])) (def: #export (analyse-tuple analyse cursor members) (-> (-> Code (Lux Analysis)) Cursor @@ -200,7 +200,7 @@ members) #let [=tuple (tuple cursor =members)] _ (&;within-type-env - (TC;check expected (&common;get-type =tuple)))] + (TC;check expected (la;get-type =tuple)))] (wrap (&common;replace-type expected =tuple))))) _ @@ -212,7 +212,7 @@ (analyse-tuple analyse cursor members)) =tuple (foldM @ &common;clean =tuple bindings) _ (&;within-type-env - (TC;check expected (&common;get-type =tuple)))] + (TC;check expected (la;get-type =tuple)))] (wrap (&common;replace-type expected =tuple))) (&;fail (format "Invalid type for tuple: " (%type expected)))) ))) @@ -235,7 +235,7 @@ =value (&;with-expected-type variant-type (analyse value))] (wrap [[expected cursor] - (#lang;Structure (#lang;Variant tag last? =value))])) + (#la;Variant tag last? =value)])) (&;fail (format "Trying to create variant with tag beyond type's limitations." "\n" " Tag: " (%n tag) "\n" "Type size: " (%n type-size) "\n" @@ -250,6 +250,6 @@ (analyse-variant analyse cursor tag value)) =variant (foldM @ &common;clean =variant bindings) _ (&;within-type-env - (TC;check expected (&common;get-type =variant)))] + (TC;check expected (la;get-type =variant)))] (wrap (&common;replace-type expected =variant))) (&;fail (format "Invalid type for variant: " (%type expected))))))) diff --git a/new-luxc/source/luxc/analyser/pattern.lux b/new-luxc/source/luxc/analyser/pattern.lux new file mode 100644 index 000000000..f4a14d855 --- /dev/null +++ b/new-luxc/source/luxc/analyser/pattern.lux @@ -0,0 +1,3 @@ +(;module: + lux) + -- cgit v1.2.3