From 74a835634fc9ee5457f3cc7109af069dad9f2d2f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 11 Oct 2017 18:57:44 -0400 Subject: - Migrated new-luxc to latest version of stdlib. - Some refactoring. --- .../source/luxc/analyser/procedure/host.jvm.lux | 57 +++++++++++----------- 1 file changed, 29 insertions(+), 28 deletions(-) (limited to 'new-luxc/source/luxc/analyser/procedure/host.jvm.lux') diff --git a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux index a8af2748a..1dba7a5f8 100644 --- a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux @@ -5,6 +5,7 @@ ["ex" exception #+ exception:]) (concurrency ["A" atom]) (data ["R" result] + [maybe] [product] [text "text/" Eq] (text format @@ -18,7 +19,7 @@ [host]) (luxc ["&" base] ["&;" host] - (lang ["la" analysis #+ Analysis]) + (lang ["la" analysis]) (analyser ["&;" common])) ["@" ../common] ) @@ -245,7 +246,7 @@ (case elemT (#;Host name #;Nil) (let [boxed-name (|> (dict;get name boxes) - (default name))] + (maybe;default name))] (wrap [(#;Host boxed-name #;Nil) boxed-name])) @@ -267,8 +268,8 @@ (do macro;Monad [arrayA (&;with-expected-type (type (Array varT)) (analyse arrayC)) - elemT (&;within-type-env - (tc;read-var var-id)) + elemT (&;with-type-env + (tc;read var-id)) [elemT elem-class] (box-array-element-type elemT) idxA (&;with-expected-type Nat (analyse idxC)) @@ -288,8 +289,8 @@ (do macro;Monad [arrayA (&;with-expected-type (type (Array varT)) (analyse arrayC)) - elemT (&;within-type-env - (tc;read-var var-id)) + elemT (&;with-type-env + (tc;read var-id)) [valueT elem-class] (box-array-element-type elemT) idxA (&;with-expected-type Nat (analyse idxC)) @@ -334,8 +335,8 @@ (do macro;Monad [objectA (&;with-expected-type varT (analyse objectC)) - objectT (&;within-type-env - (tc;read-var var-id)) + objectT (&;with-type-env + (tc;read var-id)) _ (check-object objectT) _ (&;infer Bool)] (wrap (#la;Procedure proc (list objectA)))) @@ -353,8 +354,8 @@ (do macro;Monad [monitorA (&;with-expected-type varT (analyse monitorC)) - monitorT (&;within-type-env - (tc;read-var var-id)) + monitorT (&;with-type-env + (tc;read var-id)) _ (check-object monitorT) exprA (analyse exprC)] (wrap (#la;Procedure proc (list monitorA exprA)))) @@ -432,8 +433,8 @@ (do macro;Monad [exceptionA (&;with-expected-type varT (analyse exceptionC)) - exceptionT (&;within-type-env - (tc;read-var var-id)) + exceptionT (&;with-type-env + (tc;read var-id)) exception-class (check-object exceptionT) ? (sub-class? "java.lang.Throwable" exception-class) _ (: (Lux Unit) @@ -478,8 +479,8 @@ (do macro;Monad [objectA (&;with-expected-type varT (analyse objectC)) - objectT (&;within-type-env - (tc;read-var var-id)) + objectT (&;with-type-env + (tc;read var-id)) object-class (check-object objectT) ? (sub-class? class object-class)] (if ? @@ -599,13 +600,13 @@ [to-name (check-jvm to) from-name (check-jvm from)] (cond (dict;contains? to-name boxes) - (let [box (assume (dict;get to-name boxes))] + (let [box (maybe;assume (dict;get to-name boxes))] (if (text/= box from-name) (wrap [box (#;Host to-name (list))]) (&;throw Cannot-Cast-To-Primitive (format from-name " => " to-name)))) (dict;contains? from-name boxes) - (let [box (assume (dict;get from-name boxes))] + (let [box (maybe;assume (dict;get from-name boxes))] (do @ [[_ castT] (cast to (#;Host box (list)))] (wrap [from-name castT]))) @@ -709,8 +710,8 @@ target-class)) sourceA (&;with-expected-type varT (analyse sourceC)) - sourceT (&;within-type-env - (tc;read-var var-id)) + sourceT (&;with-type-env + (tc;read var-id)) [unboxed castT] (cast targetT sourceT) _ (&;assert (format "Object cannot be a primitive: " unboxed) (text;empty? unboxed))] @@ -722,8 +723,8 @@ (do macro;Monad [sourceA (&;with-expected-type varT (analyse sourceC)) - sourceT (&;within-type-env - (tc;read-var var-id)) + sourceT (&;with-type-env + (tc;read var-id)) [unboxed castT] (cast targetT sourceT)] (wrap [castT unboxed sourceA])))) @@ -738,8 +739,8 @@ [[fieldT final?] (static-field class field) expectedT macro;expected-type [unboxed castT] (cast expectedT fieldT) - _ (&;within-type-env - (tc;check expectedT castT))] + _ (&;with-type-env + (tc;check expectedT castT))] (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed))))) _ @@ -760,8 +761,8 @@ _ (&;assert (Final-Field (format class "#" field)) (not final?)) [valueT unboxed valueA] (analyse-input analyse fieldT valueC) - _ (&;within-type-env - (tc;check fieldT valueT)) + _ (&;with-type-env + (tc;check fieldT valueT)) _ (&;infer Unit)] (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed) valueA)))) @@ -783,8 +784,8 @@ [fieldT final?] (virtual-field class field objectT) expectedT macro;expected-type [unboxed castT] (cast expectedT fieldT) - _ (&;within-type-env - (tc;check expectedT castT))] + _ (&;with-type-env + (tc;check expectedT castT))] (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed) objectA)))) _ @@ -806,8 +807,8 @@ _ (&;assert (Final-Field (format class "#" field)) (not final?)) [valueT unboxed valueA] (analyse-input analyse fieldT valueC) - _ (&;within-type-env - (tc;check fieldT valueT)) + _ (&;with-type-env + (tc;check fieldT valueT)) _ (&;infer Unit)] (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed) valueA objectA)))) -- cgit v1.2.3