diff options
Diffstat (limited to 'new-luxc/source/luxc/analyser')
| -rw-r--r-- | new-luxc/source/luxc/analyser/case.lux | 39 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/case/coverage.lux | 82 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/function.lux | 16 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/primitive.lux | 27 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/procedure/common.lux | 17 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/procedure/host.jvm.lux | 58 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/reference.lux | 10 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/structure.lux | 2 |
8 files changed, 139 insertions, 112 deletions
diff --git a/new-luxc/source/luxc/analyser/case.lux b/new-luxc/source/luxc/analyser/case.lux index b17dbcbfd..29256865a 100644 --- a/new-luxc/source/luxc/analyser/case.lux +++ b/new-luxc/source/luxc/analyser/case.lux @@ -25,6 +25,7 @@ (exception: #export Cannot-Match-Type-With-Pattern) (exception: #export Sum-Type-Has-No-Case) (exception: #export Unrecognized-Pattern-Syntax) +(exception: #export Cannot-Simplify-Type-For-Pattern-Matching) (def: (pattern-error type pattern) (-> Type Code Text) @@ -51,7 +52,7 @@ [type' (&;with-type-env (tc;read id))] (simplify-case-type type')) - (&;fail (format "Cannot simplify type for pattern-matching: " (%type type))))) + (&;throw Cannot-Simplify-Type-For-Pattern-Matching (%type type)))) (#;Named name unnamedT) (simplify-case-type unnamedT) @@ -98,26 +99,26 @@ [outputA (&scope;with-local [name inputT] next) idx &scope;next-local] - (wrap [(#la;BindP idx) outputA]))) + (wrap [(` ("lux case bind" (~ (code;nat idx)))) outputA]))) [cursor (#;Symbol ident)] (&;with-cursor cursor (&;fail (format "Symbols must be unqualified inside patterns: " (%ident ident)))) - (^template [<type> <code-tag> <pattern-tag>] + (^template [<type> <code-tag>] [cursor (<code-tag> test)] (&;with-cursor cursor (do meta;Monad<Meta> [_ (&;with-type-env (tc;check inputT <type>)) outputA next] - (wrap [(<pattern-tag> test) outputA])))) - ([Bool #;Bool #la;BoolP] - [Nat #;Nat #la;NatP] - [Int #;Int #la;IntP] - [Deg #;Deg #la;DegP] - [Frac #;Frac #la;FracP] - [Text #;Text #la;TextP]) + (wrap [pattern outputA])))) + ([Bool #;Bool] + [Nat #;Nat] + [Int #;Int] + [Deg #;Deg] + [Frac #;Frac] + [Text #;Text]) (^ [cursor (#;Tuple (list))]) (&;with-cursor cursor @@ -125,7 +126,7 @@ [_ (&;with-type-env (tc;check inputT Unit)) outputA next] - (wrap [(#la;TupleP (list)) outputA]))) + (wrap [(` ("lux case tuple" [])) outputA]))) (^ [cursor (#;Tuple (list singleton))]) (analyse-pattern #;None inputT singleton next) @@ -165,7 +166,8 @@ [nextA next] (wrap [(list) nextA])) matches)] - (wrap [(#la;TupleP memberP+) thenA]))) + (wrap [(` ("lux case tuple" [(~@ memberP+)])) + thenA]))) _ (&;fail (pattern-error inputT pattern)) @@ -202,11 +204,11 @@ (type;variant (list;drop (n.dec num-cases) flat-sum)) (` [(~@ values)]) next)] - (wrap [(#la;VariantP idx num-cases testP) + (wrap [(` ("lux case variant" (~ (code;nat idx)) (~ (code;nat num-cases)) (~ testP))) nextA])) (do meta;Monad<Meta> [[testP nextA] (analyse-pattern #;None case-type (` [(~@ values)]) next)] - (wrap [(#la;VariantP idx num-cases testP) + (wrap [(` ("lux case variant" (~ (code;nat idx)) (~ (code;nat num-cases)) (~ testP))) nextA]))) _ @@ -245,10 +247,9 @@ (function [[patternT bodyT]] (analyse-pattern #;None inputT patternT (analyse bodyT))) branchesT) - _ (case (monad;fold e;Monad<Error> - &&coverage;merge - (|> outputH product;left &&coverage;determine) - (list/map (|>. product;left &&coverage;determine) outputT)) + outputHC (|> outputH product;left &&coverage;determine) + outputTC (monad;map @ (|>. product;left &&coverage;determine) outputT) + _ (case (monad;fold e;Monad<Error> &&coverage;merge outputHC outputTC) (#e;Success coverage) (if (&&coverage;exhaustive? coverage) (wrap []) @@ -256,4 +257,4 @@ (#e;Error error) (&;fail error))] - (wrap (#la;Case inputA (#;Cons outputH outputT)))))) + (wrap (` ("lux case" (~ inputA) (~ (code;record (list& outputH outputT))))))))) diff --git a/new-luxc/source/luxc/analyser/case/coverage.lux b/new-luxc/source/luxc/analyser/case/coverage.lux index cb066a2bf..554aea1a8 100644 --- a/new-luxc/source/luxc/analyser/case/coverage.lux +++ b/new-luxc/source/luxc/analyser/case/coverage.lux @@ -1,13 +1,17 @@ (;module: lux (lux (control [monad #+ do] + ["ex" exception #+ exception:] eq) - (data [bool "B/" Eq<Bool>] + (data [bool "bool/" Eq<Bool>] [number] ["e" error "error/" Monad<Error>] - (coll [list "L/" Fold<List>] - ["D" dict]))) - (luxc (lang ["la" analysis]))) + text/format + (coll [list "list/" Fold<List>] + [dict #+ Dict])) + [meta "meta/" Monad<Meta>]) + (luxc ["&" base] + (lang ["la" analysis]))) ## The coverage of a pattern-matching expression summarizes how well ## all the possible values of an input are being covered by the @@ -24,7 +28,7 @@ (type: #export #rec Coverage #Partial (#Bool Bool) - (#Variant Nat (D;Dict Nat Coverage)) + (#Variant Nat (Dict Nat Coverage)) (#Seq Coverage Coverage) (#Alt Coverage Coverage) #Exhaustive) @@ -38,52 +42,60 @@ _ false)) +(exception: #export Unknown-Pattern) + (def: #export (determine pattern) - (-> la;Pattern Coverage) + (-> la;Pattern (Meta Coverage)) (case pattern ## Binding amounts to exhaustive coverage because any value can be ## matched that way. ## Unit [] amounts to exhaustive coverage because there is only one ## possible value, so matching against it covers all cases. - (^or (#la;BindP _) (^ (#la;TupleP (list)))) - #Exhaustive + (^or (^code ("lux case bind" (~ _))) (^code ("lux case tuple" []))) + (meta/wrap #Exhaustive) - (^ (#la;TupleP (list singleton))) + (^code ("lux case tuple" [(~ singleton)])) (determine singleton) ## Primitive patterns always have partial coverage because there ## are too many possibilities as far as values go. - (^or (#la;NatP _) (#la;IntP _) (#la;DegP _) - (#la;FracP _) (#la;TextP _)) - #Partial + (^or [_ (#;Nat _)] [_ (#;Int _)] [_ (#;Deg _)] + [_ (#;Frac _)] [_ (#;Text _)]) + (meta/wrap #Partial) ## Bools are the exception, since there is only "true" and ## "false", which means it is possible for boolean ## pattern-matching to become exhaustive if complementary parts meet. - (#la;BoolP value) - (#Bool value) + [_ (#;Bool value)] + (meta/wrap (#Bool value)) ## Tuple patterns can be exhaustive if there is exhaustiveness for all of ## their sub-patterns. - (#la;TupleP subs) + (^code ("lux case tuple" [(~@ subs)])) (loop [subs subs] (case subs #;Nil - #Exhaustive + (meta/wrap #Exhaustive) (#;Cons sub subs') - (let [post (recur subs')] + (do meta;Monad<Meta> + [pre (determine sub) + post (recur subs')] (if (exhaustive? post) - (determine sub) - (#Seq (determine sub) - post))))) + (wrap pre) + (wrap (#Seq pre post)))))) ## Variant patterns can be shown to be exhaustive if all the possible ## cases are handled exhaustively. - (#la;VariantP tag-id num-tags sub) - (#Variant num-tags - (|> (D;new number;Hash<Nat>) - (D;put tag-id (determine sub)))))) + (^code ("lux case variant" (~ [_ (#;Nat tag-id)]) (~ [_ (#;Nat num-tags)]) (~ sub))) + (do meta;Monad<Meta> + [=sub (determine sub)] + (wrap (#Variant num-tags + (|> (dict;new number;Hash<Nat>) + (dict;put tag-id =sub))))) + + _ + (&;throw Unknown-Pattern (%code pattern)))) (def: (xor left right) (-> Bool Bool Bool) @@ -116,11 +128,11 @@ true [(#Bool sideR) (#Bool sideS)] - (B/= sideR sideS) + (bool/= sideR sideS) [(#Variant allR casesR) (#Variant allS casesS)] (and (n.= allR allS) - (:: (D;Eq<Dict> =) = casesR casesS)) + (:: (dict;Eq<Dict> =) = casesR casesS)) [(#Seq leftR rightR) (#Seq leftS rightS)] (and (= leftR leftS) @@ -166,23 +178,23 @@ (cond (not (n.= allSF allA)) (e;fail "Variants do not match.") - (:: (D;Eq<Dict> Eq<Coverage>) = casesSF casesA) + (:: (dict;Eq<Dict> Eq<Coverage>) = casesSF casesA) redundant-pattern ## else (do e;Monad<Error> [casesM (monad;fold @ (function [[tagA coverageA] casesSF'] - (case (D;get tagA casesSF') + (case (dict;get tagA casesSF') (#;Some coverageSF) (do @ [coverageM (merge coverageA coverageSF)] - (wrap (D;put tagA coverageM casesSF'))) + (wrap (dict;put tagA coverageM casesSF'))) #;None - (wrap (D;put tagA coverageA casesSF')))) - casesSF (D;entries casesA))] - (wrap (if (let [case-coverages (D;values casesM)] + (wrap (dict;put tagA coverageA casesSF')))) + casesSF (dict;entries casesA))] + (wrap (if (let [case-coverages (dict;values casesM)] (and (n.= allSF (list;size case-coverages)) (list;every? exhaustive? case-coverages))) #Exhaustive @@ -272,9 +284,9 @@ #;None (case (list;reverse possibilities) (#;Cons last prevs) - (wrap (L/fold (function [left right] (#Alt left right)) - last - prevs)) + (wrap (list/fold (function [left right] (#Alt left right)) + last + prevs)) #;Nil (undefined))))) diff --git a/new-luxc/source/luxc/analyser/function.lux b/new-luxc/source/luxc/analyser/function.lux index 55896480e..3d2da6326 100644 --- a/new-luxc/source/luxc/analyser/function.lux +++ b/new-luxc/source/luxc/analyser/function.lux @@ -6,11 +6,13 @@ [text] text/format (coll [list "list/" Fold<List> Monoid<List> Monad<List>])) - [meta #+ Monad<Meta>] - (meta [type] + [meta] + (meta [code] + [type] (type ["tc" check]))) (luxc ["&" base] - (lang ["la" analysis #+ Analysis]) + (lang ["la" analysis #+ Analysis] + [";L" variable #+ Variable]) ["&;" scope] (analyser ["&;" common] ["&;" inference]))) @@ -21,7 +23,7 @@ ## [Analysers] (def: #export (analyse-function analyse func-name arg-name body) (-> &;Analyser Text Text Code (Meta Analysis)) - (do Monad<Meta> + (do meta;Monad<Meta> [functionT meta;expected-type] (loop [expectedT functionT] (&;with-stacked-errors @@ -80,7 +82,9 @@ )))))) (#;Function inputT outputT) - (<| (:: @ map (|>. #la;Function)) + (<| (:: @ 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. @@ -99,7 +103,7 @@ (function [_] (Cannot-Apply-Function (format " Function: " (%type funcT) "\n" "Arguments: " (|> args (list/map %code) (text;join-with " "))))) - (do Monad<Meta> + (do meta;Monad<Meta> [expected meta;expected-type [applyT argsA] (&inference;apply-function analyse funcT args) _ (&;with-type-env diff --git a/new-luxc/source/luxc/analyser/primitive.lux b/new-luxc/source/luxc/analyser/primitive.lux index 0023e43e0..c7f7243fd 100644 --- a/new-luxc/source/luxc/analyser/primitive.lux +++ b/new-luxc/source/luxc/analyser/primitive.lux @@ -1,8 +1,9 @@ (;module: lux (lux (control monad) - [meta #+ Monad<Meta>] - (meta (type ["TC" check]))) + [meta] + (meta [code] + (type ["tc" check]))) (luxc ["&" base] (lang ["la" analysis #+ Analysis]))) @@ -10,24 +11,24 @@ (do-template [<name> <type> <tag>] [(def: #export (<name> value) (-> <type> (Meta Analysis)) - (do Monad<Meta> + (do meta;Monad<Meta> [expected meta;expected-type _ (&;with-type-env - (TC;check expected <type>))] + (tc;check expected <type>))] (wrap (<tag> value))))] - [analyse-bool Bool #la;Bool] - [analyse-nat Nat #la;Nat] - [analyse-int Int #la;Int] - [analyse-deg Deg #la;Deg] - [analyse-frac Frac #la;Frac] - [analyse-text Text #la;Text] + [analyse-bool Bool code;bool] + [analyse-nat Nat code;nat] + [analyse-int Int code;int] + [analyse-deg Deg code;deg] + [analyse-frac Frac code;frac] + [analyse-text Text code;text] ) (def: #export analyse-unit (Meta Analysis) - (do Monad<Meta> + (do meta;Monad<Meta> [expected meta;expected-type _ (&;with-type-env - (TC;check expected Unit))] - (wrap #la;Unit))) + (tc;check expected Unit))] + (wrap (` [])))) diff --git a/new-luxc/source/luxc/analyser/procedure/common.lux b/new-luxc/source/luxc/analyser/procedure/common.lux index f64c537cb..0fad41958 100644 --- a/new-luxc/source/luxc/analyser/procedure/common.lux +++ b/new-luxc/source/luxc/analyser/procedure/common.lux @@ -7,8 +7,9 @@ (coll [list "list/" Functor<List>] [array] [dict #+ Dict])) - [meta #+ Monad<Meta>] - (meta (type ["tc" check])) + [meta] + (meta [code] + (type ["tc" check])) [io]) (luxc ["&" base] (lang ["la" analysis]) @@ -48,7 +49,7 @@ (function [analyse eval args] (let [num-actual (list;size args)] (if (n.= num-expected num-actual) - (do Monad<Meta> + (do meta;Monad<Meta> [argsA (monad;map @ (function [[argT argC]] (&;with-expected-type argT @@ -57,7 +58,7 @@ expected meta;expected-type _ (&;with-type-env (tc;check expected output-type))] - (wrap (#la;Procedure proc argsA))) + (wrap (la;procedure proc argsA))) (&;fail (wrong-arity proc num-expected num-actual))))))) (def: #export (nullary valueT proc) @@ -95,7 +96,7 @@ (function [[var-id varT]] (case args (^ (list opC)) - (do Monad<Meta> + (do meta;Monad<Meta> [opA (&;with-expected-type (type (io;IO varT)) (analyse opC)) outputT (&;with-type-env @@ -103,7 +104,7 @@ expected meta;expected-type _ (&;with-type-env (tc;check expected outputT))] - (wrap (#la;Procedure proc (list opA)))) + (wrap (la;procedure proc (list opA)))) _ (&;fail (wrong-arity proc +1 (list;size args)))))))) @@ -352,7 +353,7 @@ (function [[var-id varT]] (case args (^ (list initC)) - (do Monad<Meta> + (do meta;Monad<Meta> [initA (&;with-expected-type varT (analyse initC)) outputT (&;with-type-env @@ -360,7 +361,7 @@ expected meta;expected-type _ (&;with-type-env (tc;check expected outputT))] - (wrap (#la;Procedure proc (list initA)))) + (wrap (la;procedure proc (list initA)))) _ (&;fail (wrong-arity proc +1 (list;size args)))))))) diff --git a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux index 4db7b4dda..015379a1b 100644 --- a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux @@ -15,7 +15,8 @@ [array] [dict #+ Dict])) [meta "meta/" Monad<Meta>] - (meta ["s" syntax] + (meta [code] + ["s" syntax] [type] (type ["tc" check])) [host]) @@ -156,7 +157,7 @@ [arrayA (&;with-expected-type (type (Array varT)) (analyse arrayC)) _ (&;infer Nat)] - (wrap (#la;Procedure proc (list arrayA)))) + (wrap (la;procedure proc (list arrayA)))) _ (&;fail (@;wrong-arity proc +1 (list;size args)))))))) @@ -196,7 +197,7 @@ (&;fail (invalid-array-type expectedT))))) _ (&;assert "Must have at least 1 level of nesting in array type." (n.> +0 level))] - (wrap (#la;Procedure proc (list (#la;Nat (n.dec level)) (#la;Text elem-class) lengthA)))) + (wrap (la;procedure proc (list (code;nat (n.dec level)) (code;text elem-class) lengthA)))) _ (&;fail (@;wrong-arity proc +1 (list;size args)))))) @@ -275,7 +276,7 @@ idxA (&;with-expected-type Nat (analyse idxC)) _ (&;infer elemT)] - (wrap (#la;Procedure proc (list (#la;Text elem-class) idxA arrayA)))) + (wrap (la;procedure proc (list (code;text elem-class) idxA arrayA)))) _ (&;fail (@;wrong-arity proc +2 (list;size args)))))))) @@ -298,7 +299,7 @@ valueA (&;with-expected-type valueT (analyse valueC)) _ (&;infer (type (Array elemT)))] - (wrap (#la;Procedure proc (list (#la;Text elem-class) idxA valueA arrayA)))) + (wrap (la;procedure proc (list (code;text elem-class) idxA valueA arrayA)))) _ (&;fail (@;wrong-arity proc +3 (list;size args)))))))) @@ -321,7 +322,7 @@ (do meta;Monad<Meta> [expectedT meta;expected-type _ (check-object expectedT)] - (wrap (#la;Procedure proc (list)))) + (wrap (la;procedure proc (list)))) _ (&;fail (@;wrong-arity proc +0 (list;size args)))))) @@ -340,7 +341,7 @@ (tc;read var-id)) _ (check-object objectT) _ (&;infer Bool)] - (wrap (#la;Procedure proc (list objectA)))) + (wrap (la;procedure proc (list objectA)))) _ (&;fail (@;wrong-arity proc +1 (list;size args)))))))) @@ -359,7 +360,7 @@ (tc;read var-id)) _ (check-object monitorT) exprA (analyse exprC)] - (wrap (#la;Procedure proc (list monitorA exprA)))) + (wrap (la;procedure proc (list monitorA exprA)))) _ (&;fail (@;wrong-arity proc +2 (list;size args)))))))) @@ -465,7 +466,7 @@ (wrap []) (&;throw Not-Throwable exception-class))) _ (&;infer Bottom)] - (wrap (#la;Procedure proc (list exceptionA)))) + (wrap (la;procedure proc (list exceptionA)))) _ (&;fail (@;wrong-arity proc +1 (list;size args)))))))) @@ -480,7 +481,7 @@ (do meta;Monad<Meta> [_ (load-class class) _ (&;infer (#;Primitive "java.lang.Class" (list (#;Primitive class (list)))))] - (wrap (#la;Procedure proc (list (#la;Text class))))) + (wrap (la;procedure proc (list (code;text class))))) _ (&;fail (format "Wrong syntax for '" proc "'."))) @@ -509,7 +510,7 @@ (if ? (do @ [_ (&;infer Bool)] - (wrap (#la;Procedure proc (list (#la;Text class))))) + (wrap (la;procedure proc (list (code;text class))))) (&;throw Cannot-Be-Instance (format object-class " !<= " class)))) _ @@ -801,7 +802,8 @@ (do meta;Monad<Meta> [[fieldT final?] (static-field class field) [unboxed castT] (infer-out fieldT)] - (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed))))) + (wrap (la;procedure proc (list (code;text class) (code;text field) + (code;text unboxed))))) _ (&;fail (format "Wrong syntax for '" proc "'."))) @@ -824,7 +826,8 @@ _ (&;with-type-env (tc;check fieldT valueT)) _ (&;infer Unit)] - (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed) valueA)))) + (wrap (la;procedure proc (list (code;text class) (code;text field) + (code;text unboxed) valueA)))) _ (&;fail (format "Wrong syntax for '" proc "'."))) @@ -843,7 +846,8 @@ [[objectT objectA] (analyse-object class analyse objectC) [fieldT final?] (virtual-field class field objectT) [unboxed castT] (infer-out fieldT)] - (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed) objectA)))) + (wrap (la;procedure proc (list (code;text class) (code;text field) + (code;text unboxed) objectA)))) _ (&;fail (format "Wrong syntax for '" proc "'."))) @@ -867,7 +871,7 @@ _ (&;with-type-env (tc;check fieldT valueT)) _ (&;infer objectT)] - (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed) valueA objectA)))) + (wrap (la;procedure proc (list (code;text class) (code;text field) (code;text unboxed) valueA objectA)))) _ (&;fail (format "Wrong syntax for '" proc "'."))) @@ -1089,8 +1093,9 @@ (def: (decorate-inputs typesT inputsA) (-> (List Text) (List la;Analysis) (List la;Analysis)) (|> inputsA - (list;zip2 (list/map (|>. #la;Text) typesT)) - (list/map (|>. #la;Product)))) + (list;zip2 (list/map code;text typesT)) + (list/map (function [[type value]] + (la;product (list type value)))))) (def: (sub-type-analyser analyse) (-> &;Analyser &;Analyser) @@ -1113,8 +1118,8 @@ [methodT exceptionsT] (methods class method #Static argsT) [outputT argsA] (&inference;apply-function (sub-type-analyser analyse) methodT (list/map product;right argsTC)) [unboxed castT] (infer-out outputT)] - (wrap (#la;Procedure proc (list& (#la;Text class) (#la;Text method) - (#la;Text unboxed) (decorate-inputs argsT argsA))))) + (wrap (la;procedure proc (list& (code;text class) (code;text method) + (code;text unboxed) (decorate-inputs argsT argsA))))) _ (&;fail (format "Wrong syntax for '" proc "'."))))) @@ -1136,8 +1141,8 @@ _ (undefined))] [unboxed castT] (infer-out outputT)] - (wrap (#la;Procedure proc (list& (#la;Text class) (#la;Text method) - (#la;Text unboxed) objectA (decorate-inputs argsT argsA))))) + (wrap (la;procedure proc (list& (code;text class) (code;text method) + (code;text unboxed) objectA (decorate-inputs argsT argsA))))) _ (&;fail (format "Wrong syntax for '" proc "'."))))) @@ -1153,8 +1158,8 @@ [methodT exceptionsT] (methods class method #Special argsT) [outputT argsA] (&inference;apply-function (sub-type-analyser analyse) methodT (list& objectC (list/map product;right argsTC))) [unboxed castT] (infer-out outputT)] - (wrap (#la;Procedure proc (list& (#la;Text class) (#la;Text method) - (#la;Text unboxed) (decorate-inputs argsT argsA))))) + (wrap (la;procedure proc (list& (code;text class) (code;text method) + (code;text unboxed) (decorate-inputs argsT argsA))))) _ (&;fail (format "Wrong syntax for '" proc "'."))))) @@ -1175,8 +1180,9 @@ [methodT exceptionsT] (methods class-name method #Interface argsT) [outputT argsA] (&inference;apply-function (sub-type-analyser analyse) methodT (list& objectC (list/map product;right argsTC))) [unboxed castT] (infer-out outputT)] - (wrap (#la;Procedure proc (list& (#la;Text class-name) (#la;Text method) - (#la;Text unboxed) (decorate-inputs argsT argsA))))) + (wrap (la;procedure proc + (list& (code;text class-name) (code;text method) (code;text unboxed) + (decorate-inputs argsT argsA))))) _ (&;fail (format "Wrong syntax for '" proc "'."))))) @@ -1192,7 +1198,7 @@ [methodT exceptionsT] (constructor-methods class argsT) [outputT argsA] (&inference;apply-function (sub-type-analyser analyse) methodT (list/map product;right argsTC)) [unboxed castT] (infer-out outputT)] - (wrap (#la;Procedure proc (list& (#la;Text class) (decorate-inputs argsT argsA))))) + (wrap (la;procedure proc (list& (code;text class) (decorate-inputs argsT argsA))))) _ (&;fail (format "Wrong syntax for '" proc "'."))))) diff --git a/new-luxc/source/luxc/analyser/reference.lux b/new-luxc/source/luxc/analyser/reference.lux index 4a2f6dbc5..5bc1f96c9 100644 --- a/new-luxc/source/luxc/analyser/reference.lux +++ b/new-luxc/source/luxc/analyser/reference.lux @@ -2,9 +2,11 @@ lux (lux (control monad) [meta] - (meta (type ["tc" check]))) + (meta [code] + (type ["tc" check]))) (luxc ["&" base] - (lang ["la" analysis #+ Analysis]) + (lang ["la" analysis #+ Analysis] + [";L" variable #+ Variable]) ["&;" scope])) ## [Analysers] @@ -15,7 +17,7 @@ expectedT meta;expected-type _ (&;with-type-env (tc;check expectedT actualT))] - (wrap (#la;Definition def-name)))) + (wrap (code;symbol def-name)))) (def: (analyse-variable var-name) (-> Text (Meta (Maybe Analysis))) @@ -27,7 +29,7 @@ [expectedT meta;expected-type _ (&;with-type-env (tc;check expectedT actualT))] - (wrap (#;Some (#la;Variable ref)))) + (wrap (#;Some (` ((~ (code;int (variableL;from-ref ref)))))))) #;None (wrap #;None)))) diff --git a/new-luxc/source/luxc/analyser/structure.lux b/new-luxc/source/luxc/analyser/structure.lux index 7720202d8..d523065ea 100644 --- a/new-luxc/source/luxc/analyser/structure.lux +++ b/new-luxc/source/luxc/analyser/structure.lux @@ -120,7 +120,7 @@ [leftA (&;with-expected-type leftT (analyse leftC)) rightA (recur rightT rightC)] - (wrap (#la;Product leftA rightA))) + (wrap (` [(~ leftA) (~ rightA)]))) ## If the tuple runs out, whatever expression is the last gets ## matched to the remaining type. |