diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/procedure/common.lux | 24 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux | 144 | 
2 files changed, 84 insertions, 84 deletions
| diff --git a/new-luxc/source/luxc/lang/analysis/procedure/common.lux b/new-luxc/source/luxc/lang/analysis/procedure/common.lux index a394c554c..747e9f61d 100644 --- a/new-luxc/source/luxc/lang/analysis/procedure/common.lux +++ b/new-luxc/source/luxc/lang/analysis/procedure/common.lux @@ -8,8 +8,8 @@               (coll [list "list/" Functor<List>]                     [array]                     [dict #+ Dict])) -       [meta] -       (meta [code]) +       [macro] +       (macro [code])         (lang (type ["tc" check]))         [io])    (luxc ["&" lang] @@ -52,7 +52,7 @@      (function [analyse eval args]        (let [num-actual (list;size args)]          (if (n.= num-expected num-actual) -          (do meta;Monad<Meta> +          (do macro;Monad<Meta>              [_ (&;infer outputT)               argsA (monad;map @                                (function [[argT argC]] @@ -83,7 +83,7 @@  (def: (lux-is proc)    (-> Text Proc)    (function [analyse eval args] -    (do meta;Monad<Meta> +    (do macro;Monad<Meta>        [[var-id varT] (&;with-type-env tc;var)]        ((binary varT varT Bool proc)         analyse eval args)))) @@ -95,7 +95,7 @@    (function [analyse eval args]      (case args        (^ (list opC)) -      (do meta;Monad<Meta> +      (do macro;Monad<Meta>          [[var-id varT] (&;with-type-env tc;var)           _ (&;infer (type (Either Text varT)))           opA (&;with-type (type (io;IO varT)) @@ -146,7 +146,7 @@    (function [analyse eval args]      (case args        (^ (list valueC)) -      (do meta;Monad<Meta> +      (do macro;Monad<Meta>          [_ (&;infer (type Type))           valueA (&;with-type Type                    (analyse valueC))] @@ -278,7 +278,7 @@  (def: (array-get proc)    (-> Text Proc)    (function [analyse eval args] -    (do meta;Monad<Meta> +    (do macro;Monad<Meta>        [[var-id varT] (&;with-type-env tc;var)]        ((binary Nat (type (Array varT)) varT proc)         analyse eval args)))) @@ -286,7 +286,7 @@  (def: (array-put proc)    (-> Text Proc)    (function [analyse eval args] -    (do meta;Monad<Meta> +    (do macro;Monad<Meta>        [[var-id varT] (&;with-type-env tc;var)]        ((trinary Nat varT (type (Array varT)) (type (Array varT)) proc)         analyse eval args)))) @@ -294,7 +294,7 @@  (def: (array-remove proc)    (-> Text Proc)    (function [analyse eval args] -    (do meta;Monad<Meta> +    (do macro;Monad<Meta>        [[var-id varT] (&;with-type-env tc;var)]        ((binary Nat (type (Array varT)) (type (Array varT)) proc)         analyse eval args)))) @@ -339,7 +339,7 @@    (function [analyse eval args]      (case args        (^ (list initC)) -      (do meta;Monad<Meta> +      (do macro;Monad<Meta>          [[var-id varT] (&;with-type-env tc;var)           _ (&;infer (type (Atom varT)))           initA (&;with-type varT @@ -352,7 +352,7 @@  (def: (atom-read proc)    (-> Text Proc)    (function [analyse eval args] -    (do meta;Monad<Meta> +    (do macro;Monad<Meta>        [[var-id varT] (&;with-type-env tc;var)]        ((unary (type (Atom varT)) varT proc)         analyse eval args)))) @@ -360,7 +360,7 @@  (def: (atom-compare-and-swap proc)    (-> Text Proc)    (function [analyse eval args] -    (do meta;Monad<Meta> +    (do macro;Monad<Meta>        [[var-id varT] (&;with-type-env tc;var)]        ((trinary varT varT (type (Atom varT)) Bool proc)         analyse eval args)))) diff --git a/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux index 827f3213d..fad31eca0 100644 --- a/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux @@ -14,9 +14,9 @@               (coll [list "list/" Fold<List> Functor<List> Monoid<List>]                     [array]                     [dict #+ Dict])) -       [meta "meta/" Monad<Meta>] -       (meta [code] -             ["s" syntax]) +       [macro "macro/" Monad<Meta>] +       (macro [code] +              ["s" syntax])         (lang [type]               (type ["tc" check]))         [host]) @@ -194,7 +194,7 @@    (function [analyse eval args]      (case args        (^ (list arrayC)) -      (do meta;Monad<Meta> +      (do macro;Monad<Meta>          [_ (&;infer Nat)           [var-id varT] (&;with-type-env tc;var)           arrayA (&;with-type (type (Array varT)) @@ -209,10 +209,10 @@    (function [analyse eval args]      (case args        (^ (list lengthC)) -      (do meta;Monad<Meta> +      (do macro;Monad<Meta>          [lengthA (&;with-type Nat                     (analyse lengthC)) -         expectedT meta;expected-type +         expectedT macro;expected-type           [level elem-class] (: (Meta [Nat Text])                                 (loop [analysisT expectedT                                        level +0] @@ -245,13 +245,13 @@    (-> Type (Meta Text))    (case objectT      (#;Primitive name _) -    (meta/wrap name) +    (macro/wrap name)      (#;Named name unnamed)      (check-jvm unnamed)      (#;Var id) -    (meta/wrap "java.lang.Object") +    (macro/wrap "java.lang.Object")      (^template [<tag>]        (<tag> env unquantified) @@ -272,11 +272,11 @@  (def: (check-object objectT)    (-> Type (Meta Text)) -  (do meta;Monad<Meta> +  (do macro;Monad<Meta>      [name (check-jvm objectT)]      (if (dict;contains? name boxes)        (&;throw Primitives-Are-Not-Objects name) -      (meta/wrap name)))) +      (macro/wrap name))))  (def: (box-array-element-type elemT)    (-> Type (Meta [Type Text])) @@ -284,13 +284,13 @@      (#;Primitive name #;Nil)      (let [boxed-name (|> (dict;get name boxes)                           (maybe;default name))] -      (meta/wrap [(#;Primitive boxed-name #;Nil) -                  boxed-name])) +      (macro/wrap [(#;Primitive boxed-name #;Nil) +                   boxed-name]))      (#;Primitive name _)      (if (dict;contains? name boxes)        (&;throw Primitives-Cannot-Have-Type-Parameters name) -      (meta/wrap [elemT name])) +      (macro/wrap [elemT name]))      _      (&;throw Invalid-Type-For-Array-Element (%type elemT)))) @@ -300,7 +300,7 @@    (function [analyse eval args]      (case args        (^ (list arrayC idxC)) -      (do meta;Monad<Meta> +      (do macro;Monad<Meta>          [[var-id varT] (&;with-type-env tc;var)           _ (&;infer varT)           arrayA (&;with-type (type (Array varT)) @@ -320,7 +320,7 @@    (function [analyse eval args]      (case args        (^ (list arrayC idxC valueC)) -      (do meta;Monad<Meta> +      (do macro;Monad<Meta>          [[var-id varT] (&;with-type-env tc;var)           _ (&;infer (type (Array varT)))           arrayA (&;with-type (type (Array varT)) @@ -352,8 +352,8 @@    (function [analyse eval args]      (case args        (^ (list)) -      (do meta;Monad<Meta> -        [expectedT meta;expected-type +      (do macro;Monad<Meta> +        [expectedT macro;expected-type           _ (check-object expectedT)]          (wrap (la;procedure proc (list)))) @@ -365,7 +365,7 @@    (function [analyse eval args]      (case args        (^ (list objectC)) -      (do meta;Monad<Meta> +      (do macro;Monad<Meta>          [_ (&;infer Bool)           [objectT objectA] (&common;with-unknown-type                               (analyse objectC)) @@ -380,7 +380,7 @@    (function [analyse eval args]      (case args        (^ (list monitorC exprC)) -      (do meta;Monad<Meta> +      (do macro;Monad<Meta>          [[monitorT monitorA] (&common;with-unknown-type                                 (analyse monitorC))           _ (check-object monitorT) @@ -454,7 +454,7 @@  (def: (load-class name)    (-> Text (Meta (Class Object))) -  (do meta;Monad<Meta> +  (do macro;Monad<Meta>      [class-loader &host;class-loader]      (case (Class.forName [name false class-loader])        (#e;Success [class]) @@ -465,7 +465,7 @@  (def: (sub-class? super sub)    (-> Text Text (Meta Bool)) -  (do meta;Monad<Meta> +  (do macro;Monad<Meta>      [super (load-class super)       sub (load-class sub)]      (wrap (Class.isAssignableFrom [sub] super)))) @@ -475,7 +475,7 @@    (function [analyse eval args]      (case args        (^ (list exceptionC)) -      (do meta;Monad<Meta> +      (do macro;Monad<Meta>          [_ (&;infer Bottom)           [exceptionT exceptionA] (&common;with-unknown-type                                     (analyse exceptionC)) @@ -497,7 +497,7 @@        (^ (list classC))        (case classC          [_ (#;Text class)] -        (do meta;Monad<Meta> +        (do macro;Monad<Meta>            [_ (&;infer (#;Primitive "java.lang.Class" (list (#;Primitive class (list)))))             _ (load-class class)]            (wrap (la;procedure proc (list (code;text class))))) @@ -515,7 +515,7 @@        (^ (list classC objectC))        (case classC          [_ (#;Text class)] -        (do meta;Monad<Meta> +        (do macro;Monad<Meta>            [_ (&;infer Bool)             [objectT objectA] (&common;with-unknown-type                                 (analyse objectC)) @@ -550,7 +550,7 @@  (def: (java-type-to-class type)    (-> java.lang.reflect.Type (Meta Text))    (cond (host;instance? Class type) -        (meta/wrap (Class.getName [] (:! Class type))) +        (macro/wrap (Class.getName [] (:! Class type)))          (host;instance? ParameterizedType type)          (java-type-to-class (ParameterizedType.getRawType [] (:! ParameterizedType type))) @@ -569,7 +569,7 @@          (let [var-name (TypeVariable.getName [] (:! TypeVariable java-type))]            (case (dict;get var-name mappings)              (#;Some var-type) -            (meta/wrap var-type) +            (macro/wrap var-type)              #;None              (&;throw Unknown-Type-Var var-name))) @@ -582,37 +582,37 @@              (java-type-to-lux-type mappings bound)              _ -            (meta/wrap Top))) +            (macro/wrap Top)))          (host;instance? Class java-type)          (let [java-type (:! (Class Object) java-type)                class-name (Class.getName [] java-type)] -          (meta/wrap (case (array;size (Class.getTypeParameters [] java-type)) -                       +0 -                       (#;Primitive class-name (list)) -                        -                       arity -                       (|> (list;n.range +0 (n.dec arity)) -                           list;reverse -                           (list/map (|>. (n.* +2) n.inc #;Bound)) -                           (#;Primitive class-name) -                           (type;univ-q arity))))) +          (macro/wrap (case (array;size (Class.getTypeParameters [] java-type)) +                        +0 +                        (#;Primitive class-name (list)) +                         +                        arity +                        (|> (list;n.range +0 (n.dec arity)) +                            list;reverse +                            (list/map (|>. (n.* +2) n.inc #;Bound)) +                            (#;Primitive class-name) +                            (type;univ-q arity)))))          (host;instance? ParameterizedType java-type)          (let [java-type (:! ParameterizedType java-type)                raw (ParameterizedType.getRawType [] java-type)]            (if (host;instance? Class raw) -            (do meta;Monad<Meta> +            (do macro;Monad<Meta>                [paramsT (|> java-type                             (ParameterizedType.getActualTypeArguments [])                             array;to-list                             (monad;map @ (java-type-to-lux-type mappings)))] -              (meta/wrap (#;Primitive (Class.getName [] (:! (Class Object) raw)) -                                      paramsT))) +              (macro/wrap (#;Primitive (Class.getName [] (:! (Class Object) raw)) +                                       paramsT)))              (&;throw JVM-Type-Is-Not-Class (type-descriptor raw))))          (host;instance? GenericArrayType java-type) -        (do meta;Monad<Meta> +        (do macro;Monad<Meta>            [innerT (|> (:! GenericArrayType java-type)                        (GenericArrayType.getGenericComponentType [])                        (java-type-to-lux-type mappings))] @@ -652,9 +652,9 @@                               "    Type: " (%type type)))              ## else -            (meta/wrap (|> params -                           (list;zip2 (list/map (TypeVariable.getName []) class-params)) -                           (dict;from-list text;Hash<Text>))) +            (macro/wrap (|> params +                            (list;zip2 (list/map (TypeVariable.getName []) class-params)) +                            (dict;from-list text;Hash<Text>)))              ))      _ @@ -662,7 +662,7 @@  (def: (cast direction to from)    (-> Direction Type Type (Meta [Text Type])) -  (do meta;Monad<Meta> +  (do macro;Monad<Meta>      [to-name (check-jvm to)       from-name (check-jvm from)]      (cond (dict;contains? to-name boxes) @@ -712,8 +712,8 @@  (def: (infer-out outputT)    (-> Type (Meta [Text Type])) -  (do meta;Monad<Meta> -    [expectedT meta;expected-type +  (do macro;Monad<Meta> +    [expectedT macro;expected-type       [unboxed castT] (cast #Out expectedT outputT)       _ (&;with-type-env           (tc;check expectedT castT))] @@ -721,7 +721,7 @@  (def: (find-field class-name field-name)    (-> Text Text (Meta [(Class Object) Field])) -  (do meta;Monad<Meta> +  (do macro;Monad<Meta>      [class (load-class class-name)]      (case (Class.getDeclaredField [field-name] class)        (#e;Success field) @@ -738,7 +738,7 @@  (def: (static-field class-name field-name)    (-> Text Text (Meta [Type Bool])) -  (do meta;Monad<Meta> +  (do macro;Monad<Meta>      [[class fieldJ] (find-field class-name field-name)       #let [modifiers (Field.getModifiers [] fieldJ)]]      (if (Modifier.isStatic [modifiers]) @@ -750,7 +750,7 @@  (def: (virtual-field class-name field-name objectT)    (-> Text Text Type (Meta [Type Bool])) -  (do meta;Monad<Meta> +  (do macro;Monad<Meta>      [[class fieldJ] (find-field class-name field-name)       #let [modifiers (Field.getModifiers [] fieldJ)]]      (if (not (Modifier.isStatic [modifiers])) @@ -783,7 +783,7 @@  (def: (analyse-object class analyse sourceC)    (-> Text &;Analyser Code (Meta [Type la;Analysis])) -  (do meta;Monad<Meta> +  (do macro;Monad<Meta>      [target-class (load-class class)       targetT (java-type-to-lux-type fresh-mappings                                      (:! java.lang.reflect.Type @@ -797,7 +797,7 @@  (def: (analyse-input analyse targetT sourceC)    (-> &;Analyser Type Code (Meta [Type Text la;Analysis])) -  (do meta;Monad<Meta> +  (do macro;Monad<Meta>      [[sourceT sourceA] (&common;with-unknown-type                           (analyse sourceC))       [unboxed castT] (cast #In targetT sourceT)] @@ -810,7 +810,7 @@        (^ (list classC fieldC))        (case [classC fieldC]          [[_ (#;Text class)] [_ (#;Text field)]] -        (do meta;Monad<Meta> +        (do macro;Monad<Meta>            [[fieldT final?] (static-field class field)             [unboxed castT] (infer-out fieldT)]            (wrap (la;procedure proc (list (code;text class) (code;text field) @@ -829,7 +829,7 @@        (^ (list classC fieldC valueC))        (case [classC fieldC]          [[_ (#;Text class)] [_ (#;Text field)]] -        (do meta;Monad<Meta> +        (do macro;Monad<Meta>            [_ (&;infer Unit)             [fieldT final?] (static-field class field)             _ (&;assert Cannot-Set-Final-Field (format class "#" field) @@ -853,7 +853,7 @@        (^ (list classC fieldC objectC))        (case [classC fieldC]          [[_ (#;Text class)] [_ (#;Text field)]] -        (do meta;Monad<Meta> +        (do macro;Monad<Meta>            [[objectT objectA] (analyse-object class analyse objectC)             [fieldT final?] (virtual-field class field objectT)             [unboxed castT] (infer-out fieldT)] @@ -873,7 +873,7 @@        (^ (list classC fieldC valueC objectC))        (case [classC fieldC]          [[_ (#;Text class)] [_ (#;Text field)]] -        (do meta;Monad<Meta> +        (do macro;Monad<Meta>            [[objectT objectA] (analyse-object class analyse objectC)             _ (&;infer objectT)             [fieldT final?] (virtual-field class field objectT) @@ -891,17 +891,17 @@  (def: (java-type-to-parameter type)    (-> java.lang.reflect.Type (Meta Text))    (cond (host;instance? Class type) -        (meta/wrap (Class.getName [] (:! Class type))) +        (macro/wrap (Class.getName [] (:! Class type)))          (host;instance? ParameterizedType type)          (java-type-to-parameter (ParameterizedType.getRawType [] (:! ParameterizedType type)))          (or (host;instance? TypeVariable type)              (host;instance? WildcardType type)) -        (meta/wrap "java.lang.Object") +        (macro/wrap "java.lang.Object")          (host;instance? GenericArrayType type) -        (do meta;Monad<Meta> +        (do macro;Monad<Meta>            [componentP (java-type-to-parameter (GenericArrayType.getGenericComponentType [] (:! GenericArrayType type)))]            (wrap (format componentP "[]"))) @@ -917,7 +917,7 @@  (def: (check-method class method-name method-type arg-classes method)    (-> (Class Object) Text Method-Type (List Text) Method (Meta Bool)) -  (do meta;Monad<Meta> +  (do macro;Monad<Meta>      [parameters (|> (Method.getGenericParameterTypes [] method)                      array;to-list                      (monad;map @ java-type-to-parameter)) @@ -946,7 +946,7 @@  (def: (check-constructor class arg-classes constructor)    (-> (Class Object) (List Text) (Constructor Object) (Meta Bool)) -  (do meta;Monad<Meta> +  (do macro;Monad<Meta>      [parameters (|> (Constructor.getGenericParameterTypes [] constructor)                      array;to-list                      (monad;map @ java-type-to-parameter))] @@ -997,7 +997,7 @@                            list;reverse                            (list;zip2 all-tvars)                            (dict;from-list text;Hash<Text>))))] -    (do meta;Monad<Meta> +    (do macro;Monad<Meta>        [inputsT (|> (Method.getGenericParameterTypes [] method)                     array;to-list                     (monad;map @ (java-type-to-lux-type mappings))) @@ -1018,7 +1018,7 @@  (def: (methods class-name method-name method-type arg-classes)    (-> Text Text Method-Type (List Text) (Meta [Type (List Type)])) -  (do meta;Monad<Meta> +  (do macro;Monad<Meta>      [class (load-class class-name)       candidates (|> class                      (Class.getDeclaredMethods []) @@ -1059,7 +1059,7 @@                            list;reverse                            (list;zip2 all-tvars)                            (dict;from-list text;Hash<Text>))))] -    (do meta;Monad<Meta> +    (do macro;Monad<Meta>        [inputsT (|> (Constructor.getGenericParameterTypes [] constructor)                     array;to-list                     (monad;map @ (java-type-to-lux-type mappings))) @@ -1074,7 +1074,7 @@  (def: (constructor-methods class-name arg-classes)    (-> Text (List Text) (Meta [Type (List Type)])) -  (do meta;Monad<Meta> +  (do macro;Monad<Meta>      [class (load-class class-name)       candidates (|> class                      (Class.getConstructors []) @@ -1103,10 +1103,10 @@  (def: (sub-type-analyser analyse)    (-> &;Analyser &;Analyser)    (function [argC] -    (do meta;Monad<Meta> +    (do macro;Monad<Meta>        [[argT argA] (&common;with-unknown-type                       (analyse argC)) -       expectedT meta;expected-type +       expectedT macro;expected-type         [unboxed castT] (cast #In expectedT argT)]        (wrap argA)))) @@ -1116,7 +1116,7 @@      (case (: (e;Error [Text Text (List [Text Code])])               (s;run args ($_ p;seq s;text s;text (p;some (s;tuple (p;seq s;text s;any))))))        (#e;Success [class method argsTC]) -      (do meta;Monad<Meta> +      (do macro;Monad<Meta>          [#let [argsT (list/map product;left argsTC)]           [methodT exceptionsT] (methods class method #Static argsT)           [outputT argsA] (inferenceA;general (sub-type-analyser analyse) methodT (list/map product;right argsTC)) @@ -1133,7 +1133,7 @@      (case (: (e;Error [Text Text Code (List [Text Code])])               (s;run args ($_ p;seq s;text s;text s;any (p;some (s;tuple (p;seq s;text s;any))))))        (#e;Success [class method objectC argsTC]) -      (do meta;Monad<Meta> +      (do macro;Monad<Meta>          [#let [argsT (list/map product;left argsTC)]           [methodT exceptionsT] (methods class method #Virtual argsT)           [outputT allA] (inferenceA;general (sub-type-analyser analyse) methodT (list& objectC (list/map product;right argsTC))) @@ -1156,7 +1156,7 @@      (case (: (e;Error [(List Code) [Text Text Code (List [Text Code]) Unit]])               (p;run args ($_ p;seq s;text s;text s;any (p;some (s;tuple (p;seq s;text s;any))) s;end!)))        (#e;Success [_ [class method objectC argsTC _]]) -      (do meta;Monad<Meta> +      (do macro;Monad<Meta>          [#let [argsT (list/map product;left argsTC)]           [methodT exceptionsT] (methods class method #Special argsT)           [outputT argsA] (inferenceA;general (sub-type-analyser analyse) methodT (list& objectC (list/map product;right argsTC))) @@ -1173,7 +1173,7 @@      (case (: (e;Error [Text Text Code (List [Text Code])])               (s;run args ($_ p;seq s;text s;text s;any (p;some (s;tuple (p;seq s;text s;any))))))        (#e;Success [class-name method objectC argsTC]) -      (do meta;Monad<Meta> +      (do macro;Monad<Meta>          [#let [argsT (list/map product;left argsTC)]           class (load-class class-name)           _ (&;assert Non-Interface class-name @@ -1194,7 +1194,7 @@      (case (: (e;Error [Text (List [Text Code])])               (s;run args ($_ p;seq s;text (p;some (s;tuple (p;seq s;text s;any))))))        (#e;Success [class argsTC]) -      (do meta;Monad<Meta> +      (do macro;Monad<Meta>          [#let [argsT (list/map product;left argsTC)]           [methodT exceptionsT] (constructor-methods class argsT)           [outputT argsA] (inferenceA;general (sub-type-analyser analyse) methodT (list/map product;right argsTC)) | 
