From 36303d6cb2ce3ab9e36d045b9516c997bd461862 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 24 Aug 2021 05:23:45 -0400 Subject: Outsourced the syntax for labelled type definitions to macros. --- lux-jvm/source/luxc/lang/directive/jvm.lux | 140 ++++++++++++++--------------- 1 file changed, 70 insertions(+), 70 deletions(-) (limited to 'lux-jvm/source/luxc/lang/directive/jvm.lux') diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux index 2c6577ae1..5511b5913 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -530,7 +530,7 @@ (|>> [..fresh] ..relabel_bytecode product.right - (row\map ..instruction) + (row\each ..instruction) row.list _.fuse)) @@ -553,7 +553,7 @@ (def: (true_handler extender pseudo) (-> jvm.Extender Any jvm.Handler) (function (_ extension_name phase archive inputs) - (\ phase.monad map + (\ phase.monad each (|>> (:as (/.Bytecode Inst /.Label)) ..bytecode) ((extender pseudo) extension_name phase archive inputs)))) @@ -904,7 +904,7 @@ (def.abstract_method (..visibility privacy) jvm.noneM name - (/type.method [variables (list\map product.right arguments) return exceptions])))) + (/type.method [variables (list\each product.right arguments) return exceptions])))) (def: (method_header super_class method) (-> (Type Class) (Method Code) jvm.Def) @@ -914,10 +914,10 @@ body]) (let [[super_name super_vars] (parser.read_class super_class) init_constructor_arguments (|> constructor_arguments - (list\map (|>> product.left ..header_value)) + (list\each (|>> product.left ..header_value)) _.fuse) super_constructorT (/type.method [(list) - (list\map product.left constructor_arguments) + (list\each product.left constructor_arguments) /type.void (list)])] (def.method (..visibility privacy) @@ -925,7 +925,7 @@ jvm.strictM jvm.noneM) ..constructor_name - (/type.method [variables (list\map product.right arguments) /type.void exceptions]) + (/type.method [variables (list\each product.right arguments) /type.void exceptions]) (|>> (_.ALOAD 0) init_constructor_arguments (_.INVOKESPECIAL super_class ..constructor_name super_constructorT) @@ -939,7 +939,7 @@ jvm.strictM jvm.noneM) name - (/type.method [variables (list\map product.right arguments) return exceptions]) + (/type.method [variables (list\each product.right arguments) return exceptions]) (..header_return return)) (#Virtual [name privacy final? strict_floating_point? annotations variables @@ -954,7 +954,7 @@ jvm.finalM jvm.noneM))) name - (/type.method [variables (list\map product.right arguments) return exceptions]) + (/type.method [variables (list\each product.right arguments) return exceptions]) (..header_return return)) (#Static [name privacy strict_floating_point? annotations variables @@ -966,7 +966,7 @@ jvm.strictM jvm.noneM))) name - (/type.method [variables (list\map product.right arguments) return exceptions]) + (/type.method [variables (list\each product.right arguments) return exceptions]) (..header_return return)) (#Abstract method) @@ -986,11 +986,11 @@ (List Field) (List (Method Code)) [External Binary]) - (let [constraints (list\map ..constraint type_variables) - field_definitions (list\map ..field_header fields) - method_definitions (list\map (..method_header super_class) methods) - definitions (def.fuse (list\compose field_definitions - method_definitions))] + (let [constraints (list\each ..constraint type_variables) + field_definitions (list\each ..field_header fields) + method_definitions (list\each (..method_header super_class) methods) + definitions (def.fuse (list\composite field_definitions + method_definitions))] [class_name (case inheritance #ffi.DefaultI @@ -1016,19 +1016,19 @@ (do ! [mapping (//A.with_fresh_type_vars class_tvars luxT.fresh) mapping (//A.with_fresh_type_vars method_tvars mapping) - constructor_argumentsA (monad.map ! (function (_ [typeJ termC]) - (do ! - [typeL (//A.reflection_type mapping typeJ) - termA (typeA.with_type typeL - (analyse archive termC))] - (in [typeJ termA]))) - constructor_argumentsC) + constructor_argumentsA (monad.each ! (function (_ [typeJ termC]) + (do ! + [typeL (//A.reflection_type mapping typeJ) + termA (typeA.with_type typeL + (analyse archive termC))] + (in [typeJ termA]))) + constructor_argumentsC) selfT (//A.reflection_type mapping (/type.class class_name class_tvars)) - arguments' (monad.map ! - (function (_ [name type]) - (\ ! map (|>> [name]) - (//A.boxed_reflection_type mapping type))) - arguments) + arguments' (monad.each ! + (function (_ [name type]) + (\ ! each (|>> [name]) + (//A.boxed_reflection_type mapping type))) + arguments) returnT (//A.boxed_reflection_return mapping /type.void) [_scope bodyA] (|> arguments' (#.Item [self selfT]) @@ -1054,11 +1054,11 @@ mapping (//A.with_override_mapping supers parent_type mapping) mapping (//A.with_fresh_type_vars method_tvars mapping) selfT (//A.reflection_type mapping (/type.class class_name class_tvars)) - arguments' (monad.map ! - (function (_ [name type]) - (\ ! map (|>> [name]) - (//A.boxed_reflection_type mapping type))) - arguments) + arguments' (monad.each ! + (function (_ [name type]) + (\ ! each (|>> [name]) + (//A.boxed_reflection_type mapping type))) + arguments) returnT (//A.boxed_reflection_return mapping returnJ) [_scope bodyA] (|> arguments' (#.Item [self selfT]) @@ -1082,11 +1082,11 @@ [mapping (//A.with_fresh_type_vars class_tvars luxT.fresh) mapping (//A.with_fresh_type_vars method_tvars mapping) selfT (//A.reflection_type mapping (/type.class class_name class_tvars)) - arguments' (monad.map ! - (function (_ [name type]) - (\ ! map (|>> [name]) - (//A.boxed_reflection_type mapping type))) - arguments) + arguments' (monad.each ! + (function (_ [name type]) + (\ ! each (|>> [name]) + (//A.boxed_reflection_type mapping type))) + arguments) returnT (//A.boxed_reflection_return mapping returnJ) [_scope bodyA] (|> arguments' (#.Item [self selfT]) @@ -1108,11 +1108,11 @@ (directive.lifted_analysis (do ! [mapping (//A.with_fresh_type_vars method_tvars luxT.fresh) - arguments' (monad.map ! - (function (_ [name type]) - (\ ! map (|>> [name]) - (//A.boxed_reflection_type mapping type))) - arguments) + arguments' (monad.each ! + (function (_ [name type]) + (\ ! each (|>> [name]) + (//A.boxed_reflection_type mapping type))) + arguments) returnT (//A.boxed_reflection_return mapping returnJ) [_scope bodyA] (|> arguments' list.reversed @@ -1127,19 +1127,19 @@ (-> Archive Declaration (List (Type Class)) (Method Code) (Operation (Method Analysis))) (case method (#Constructor method) - (\ phase.monad map (|>> #Constructor) + (\ phase.monad each (|>> #Constructor) (constructor_method_analysis archive declaration method)) (#Override method) - (\ phase.monad map (|>> #Override) + (\ phase.monad each (|>> #Override) (override_method_analysis archive declaration supers method)) (#Virtual method) - (\ phase.monad map (|>> #Virtual) + (\ phase.monad each (|>> #Virtual) (virtual_method_analysis archive declaration method)) (#Static method) - (\ phase.monad map (|>> #Static) + (\ phase.monad each (|>> #Static) (static_method_analysis archive method)) (#Abstract method) @@ -1162,10 +1162,10 @@ synthesise directive.synthesis] (directive.lifted_synthesis (do ! - [constructor_argumentsS (monad.map ! (function (_ [typeJ termA]) - (\ ! map (|>> [typeJ]) - (synthesise archive termA))) - constructor_argumentsA) + [constructor_argumentsS (monad.each ! (function (_ [typeJ termA]) + (\ ! each (|>> [typeJ]) + (synthesise archive termA))) + constructor_argumentsA) bodyS (synthesise archive (#analysis.Function (list) (//A.hide_method_body (list.size arguments) bodyA)))] (in [privacy strict_floating_point? annotations method_tvars exceptions self arguments constructor_argumentsS @@ -1237,19 +1237,19 @@ (-> Archive (Method Analysis) (Operation (Method Synthesis))) (case method (#Constructor method) - (\ phase.monad map (|>> #Constructor) + (\ phase.monad each (|>> #Constructor) (constructor_method_synthesis archive method)) (#Override method) - (\ phase.monad map (|>> #Override) + (\ phase.monad each (|>> #Override) (override_method_synthesis archive method)) (#Virtual method) - (\ phase.monad map (|>> #Virtual) + (\ phase.monad each (|>> #Virtual) (virtual_method_synthesis archive method)) (#Static method) - (\ phase.monad map (|>> #Static) + (\ phase.monad each (|>> #Static) (static_method_synthesis archive method)) (#Abstract method) @@ -1265,16 +1265,16 @@ generate directive.generation] (directive.lifted_generation (do ! - [constructor_argumentsG (monad.map ! (|>> product.right (generate archive)) - constructor_argumentsS) + [constructor_argumentsG (monad.each ! (|>> product.right (generate archive)) + constructor_argumentsS) bodyG (generate archive (//G.hidden_method_body (list.size arguments) bodyS)) .let [[super_name super_vars] (parser.read_class super_class) super_constructor_argument_values (_.fuse constructor_argumentsG) super_constructorT (/type.method [(list) - (list\map product.left constructor_argumentsS) + (list\each product.left constructor_argumentsS) /type.void (list)]) - argumentsT (list\map product.right arguments) + argumentsT (list\each product.right arguments) initialize_object! (: Inst (|>> (_.ALOAD 0) super_constructor_argument_values @@ -1300,7 +1300,7 @@ (directive.lifted_generation (do ! [bodyG (generate archive (//G.hidden_method_body (list.size arguments) bodyS)) - .let [argumentsT (list\map product.right arguments)]] + .let [argumentsT (list\each product.right arguments)]] (in (def.method #jvm.Public (if strict_floating_point? jvm.strictM @@ -1321,7 +1321,7 @@ (directive.lifted_generation (do ! [bodyG (generate archive (//G.hidden_method_body (list.size arguments) bodyS)) - .let [argumentsT (list\map product.right arguments)]] + .let [argumentsT (list\each product.right arguments)]] (in (def.method (..visibility privacy) (|> jvm.noneM (jvm.++M (if strict_floating_point? @@ -1346,7 +1346,7 @@ (directive.lifted_generation (do ! [bodyG (generate archive (//G.hidden_method_body (list.size arguments) bodyS)) - .let [argumentsT (list\map product.right arguments)]] + .let [argumentsT (list\each product.right arguments)]] (in (def.method (..visibility privacy) (|> jvm.staticM (jvm.++M (if strict_floating_point? @@ -1429,16 +1429,16 @@ (list.all ..convert_overriden_method) (//A.require_complete_method_concretion class_loader supers) directive.lifted_analysis) - methodsA (monad.map ! (method_analysis archive declaration supers) methodsC) - methodsS (monad.map ! (method_synthesis archive) methodsA) - methodsG (monad.map ! (method_generation archive super_class) methodsS) + methodsA (monad.each ! (method_analysis archive declaration supers) methodsC) + methodsS (monad.each ! (method_synthesis archive) methodsA) + methodsG (monad.each ! (method_generation archive super_class) methodsS) .let [directive [class_name (def.class #jvm.V1_6 #jvm.Public jvm.noneC class_name - (list\map ..constraint type_variables) + (list\each ..constraint type_variables) super_class super_interfaces - (def.fuse (list\compose (list\map ..field_header fields) - methodsG)))]]] + (def.fuse (list\composite (list\each ..field_header fields) + methodsG)))]]] (directive.lifted_generation (do ! [artifact_id (generation.learn_custom class_name) @@ -1459,12 +1459,12 @@ (do {! phase.monad} [.let [directive [class_name (def.interface #jvm.V1_6 #jvm.Public jvm.noneC class_name - (list\map ..constraint type_variables) + (list\each ..constraint type_variables) supers (|> method_declarations - (list\map (function (_ (^slots [#name #annotations #type_variables #exceptions #arguments #return])) - (def.abstract_method #jvm.Public jvm.noneM name - (/type.method [type_variables arguments return exceptions])))) + (list\each (function (_ (^slots [#name #annotations #type_variables #exceptions #arguments #return])) + (def.abstract_method #jvm.Public jvm.noneM name + (/type.method [type_variables arguments return exceptions])))) def.fuse))]]] (directive.lifted_generation (do ! -- cgit v1.2.3