From 642c947ee44989504e3d54d4bf11c1f25b2f0a1f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Suzanne=20Dup=C3=A9ron?= Date: Tue, 31 Mar 2020 21:58:48 +0200 Subject: [PATCH] [WIP, does not build] adt_generator move polymorphism into the fields, start getting rid of the large let rec --- src/stages/adt_generator/generator.raku | 165 +++++++++++++++--------- 1 file changed, 102 insertions(+), 63 deletions(-) diff --git a/src/stages/adt_generator/generator.raku b/src/stages/adt_generator/generator.raku index 193cf291d..7a0dcbd9b 100644 --- a/src/stages/adt_generator/generator.raku +++ b/src/stages/adt_generator/generator.raku @@ -173,34 +173,34 @@ for $adts.kv -> $index, $t { say ""; for $adts.list -> $t { - say "type 'state continue_fold_map__$t = \{"; - say " node__$t : $t -> 'state -> ($t * 'state) ;"; + say "type continue_fold_map__$t = \{"; + say " node__$t : 'state . $t -> 'state -> ($t * 'state) ;"; for $t.list -> $c - { say " $t__$c : {$c || 'unit'} -> 'state -> ({$c || 'unit'} * 'state) ;" } + { say " $t__$c : 'state . {$c || 'unit'} -> 'state -> ({$c || 'unit'} * 'state) ;" } say ' }'; } -say "type 'state continue_fold_map = \{"; +say "type continue_fold_map = \{"; for $adts.list -> $t { - say " $t : 'state continue_fold_map__$t ;"; + say " $t : continue_fold_map__$t ;"; } say ' }'; say ""; for $adts.list -> $t -{ say "type 'state fold_map_config__$t = \{"; - say " node__$t : $t -> (*Adt_info.node_instance_info ->*) 'state -> ('state continue_fold_map) -> ($t * 'state) ;"; - say " node__$t__pre_state : $t -> (*Adt_info.node_instance_info ->*) 'state -> 'state ;"; - say " node__$t__post_state : $t -> $t -> (*Adt_info.node_instance_info ->*) 'state -> 'state ;"; +{ say "type fold_map_config__$t = \{"; + say " node__$t : 'state . $t -> 'state -> continue_fold_map -> ($t * 'state) ;"; # (*Adt_info.node_instance_info ->*) + say " node__$t__pre_state : 'state . $t -> 'state -> 'state ;"; # (*Adt_info.node_instance_info ->*) + say " node__$t__post_state : 'state . $t -> $t -> 'state -> 'state ;"; # (*Adt_info.node_instance_info ->*) for $t.list -> $c - { say " $t__$c : {$c || 'unit'} -> (*Adt_info.ctor_or_field_instance_info ->*) 'state -> ('state continue_fold_map) -> ({$c || 'unit'} * 'state) ;"; + { say " $t__$c : 'state . {$c || 'unit'} -> 'state -> continue_fold_map -> ({$c || 'unit'} * 'state) ;"; # (*Adt_info.ctor_or_field_instance_info ->*) } say '}' } -say "type 'state fold_map_config ="; +say "type fold_map_config ="; say ' {'; for $adts.list -> $t -{ say " $t : 'state fold_map_config__$t;" } +{ say " $t : fold_map_config__$t;" } say ' }'; say ""; @@ -222,30 +222,33 @@ for $adts.map({ $_ })[*;*].grep({$_ && $_ ne ''} for $adts.grep({$_ ne $record && $_ ne $variant}).map({$_}).unique -> $builtin { say " $builtin : 'a . 'state fold_config -> 'a $builtin -> ('state -> 'a -> 'state) -> 'state -> 'state;"; } say ' }'; -say "(* info for adt $moduleName *)"; -print "let rec whole_adt_info : unit -> Adt_info.adt = fun () -> [ "; + +say ""; +say 'type blahblah = {'; for $adts.list -> $t -{ print "info__$t ; "; } -say "]"; +{ say " fold__$t : 'state . blahblah -> 'state fold_config -> $t -> 'state -> 'state;"; + for $t.list -> $c + { say " fold__$t__$c : 'state . blahblah -> 'state fold_config -> { $c || 'unit' } -> 'state -> 'state;"; } } +say '}'; # generic programming info about the nodes and fields say ""; for $adts.list -> $t { for $t.list -> $c { say "(* info for field or ctor $t.$c *)"; - say "and info__$t__$c : Adt_info.ctor_or_field = \{"; + say "let info__$t__$c : Adt_info.ctor_or_field = \{"; say " name = \"$c\";"; say " is_builtin = {$c ?? 'true' !! 'false'};"; say " type_ = \"$c\";"; say '}'; say ""; - say "and continue_info__$t__$c : type qstate . qstate fold_config -> {$c || 'unit'} -> qstate Adt_info.ctor_or_field_instance = fun visitor x -> \{"; + say "let continue_info__$t__$c : type qstate . blahblah -> qstate fold_config -> {$c || 'unit'} -> qstate Adt_info.ctor_or_field_instance = fun blahblah visitor x -> \{"; say " cf = info__$t__$c;"; - say " cf_continue = fun state -> fold__$t__$c visitor x state;"; + say " cf_continue = fun state -> blahblah.fold__$t__$c blahblah visitor x state;"; say '}'; say ""; } say "(* info for node $t *)"; - say "and info__$t : Adt_info.node = \{"; + say "let info__$t : Adt_info.node = \{"; my $kind = do given $t { when $record { "Record" } when $variant { "Variant" } @@ -259,21 +262,21 @@ for $adts.list -> $t say '}'; say ""; # TODO: factor out some of the common bits here. - say "and continue_info__$t : type qstate . qstate fold_config -> $t -> qstate Adt_info.instance = fun visitor x ->"; + say "let continue_info__$t : type qstate . blahblah -> qstate fold_config -> $t -> qstate Adt_info.instance = fun blahblah visitor x ->"; say '{'; say " instance_declaration_name = \"$t\";"; do given $t { when $record { say ' instance_kind = RecordInstance {'; print " fields = [ "; - for $t.list -> $c { print "continue_info__$t__$c visitor x.$c ; "; } + for $t.list -> $c { print "continue_info__$t__$c blahblah visitor x.$c ; "; } say " ];"; say '};'; } when $variant { say ' instance_kind = VariantInstance {'; say " constructor = (match x with"; - for $t.list -> $c { say " | $c { $c ?? 'v ' !! '' }-> continue_info__$t__$c visitor { $c ?? 'v' !! '()' }"; } + for $t.list -> $c { say " | $c { $c ?? 'v ' !! '' }-> continue_info__$t__$c blahblah visitor { $c ?? 'v' !! '()' }"; } say " );"; print " variant = [ "; for $t.list -> $c { print "info__$t__$c ; "; } @@ -290,7 +293,7 @@ for $adts.list -> $t say "];"; print " poly_continue = (fun state -> visitor.$_ visitor x ("; print $t - .map(-> $c { "(fun state x -> (continue_info__$t__$c visitor x).cf_continue state)" }) + .map(-> $c { "(fun state x -> (continue_info__$t__$c blahblah visitor x).cf_continue state)" }) .join(", "); say ") state);"; say '};'; @@ -299,68 +302,104 @@ for $adts.list -> $t say '}'; say ""; } -# make the "continue" object say ""; -say '(* Curries the "visitor" argument to the folds (non-customizable traversal functions). *)'; -say "and mk_continue_fold_map : type qstate . qstate fold_map_config -> qstate continue_fold_map = fun visitor ->"; -say ' {'; +say "(* info for adt $moduleName *)"; +print "let whole_adt_info : unit -> Adt_info.adt = fun () -> [ "; for $adts.list -> $t -{ say " $t = \{"; - say " node__$t = fold_map__$t visitor ;"; - for $t.list -> $c - { say " $t__$c = fold_map__$t__$c visitor ;"; } - say ' };' } -say ' }'; -say ""; - -# fold_map functions -say ""; -for $adts.list -> $t -{ say "and fold_map__$t : type qstate . qstate fold_map_config -> $t -> qstate -> ($t * qstate) = fun visitor x state ->"; - say " let continue_fold_map : qstate continue_fold_map = mk_continue_fold_map visitor in"; - say " let state = visitor.$t.node__$t__pre_state x (*(fun () -> whole_adt_info, info__$t)*) state in"; - say " let (new_x, state) = visitor.$t.node__$t x (*(fun () -> whole_adt_info, info__$t)*) state continue_fold_map in"; - say " let state = visitor.$t.node__$t__post_state x new_x (*(fun () -> whole_adt_info, info__$t)*) state in"; - say " (new_x, state)"; - say ""; - for $t.list -> $c - { say "and fold_map__$t__$c : type qstate . qstate fold_map_config -> { $c || 'unit' } -> qstate -> ({ $c || 'unit' } * qstate) = fun visitor x state ->"; - say " let continue_fold_map : qstate continue_fold_map = mk_continue_fold_map visitor in"; - say " visitor.$t.$t__$c x (*(fun () -> whole_adt_info, info__$t, info__$t__$c)*) state continue_fold_map"; - say ""; } } - +{ print "info__$t ; "; } +say "]"; # fold functions say ""; for $adts.list -> $t -{ say "and fold__$t : type qstate . qstate fold_config -> $t -> qstate -> qstate = fun visitor x state ->"; +{ say "let fold__$t : type qstate . blahblah -> qstate fold_config -> $t -> qstate -> qstate = fun blahblah visitor x state ->"; # TODO: add a non-generic continue_fold. say ' let node_instance_info : qstate Adt_info.node_instance_info = {'; say " adt = whole_adt_info () ;"; - say " node_instance = continue_info__$t visitor x"; + say " node_instance = continue_info__$t blahblah visitor x"; say ' } in'; # say " let (new_x, state) = visitor.$t.node__$t x (fun () -> whole_adt_info, info__$t) state continue_fold in"; say " visitor.generic node_instance_info state"; say ""; for $t.list -> $c - { say "and fold__$t__$c : type qstate . qstate fold_config -> { $c || 'unit' } -> qstate -> qstate = fun { $c ?? 'visitor x' !! '_visitor ()' } state ->"; + { say "let fold__$t__$c : type qstate . blahblah -> qstate fold_config -> { $c || 'unit' } -> qstate -> qstate = fun blahblah { $c ?? 'visitor x' !! '_visitor ()' } state ->"; # say " let ctor_or_field_instance_info : qstate Adt_info.ctor_or_field_instance_info = whole_adt_info (), info__$t, continue_info__$t__$c visitor x in"; if ($c eq '') { # nothing to do, this constructor has no arguments. + say " state"; } elsif ($c) { - say " let state = (*visitor.generic_ctor_or_field ctor_or_field_instance_info*) visitor.$c visitor x state in"; + say " ignore blahblah; visitor.$c visitor x state"; # (*visitor.generic_ctor_or_field ctor_or_field_instance_info*) } else { - say " let state = (*visitor.generic_ctor_or_field ctor_or_field_instance_info*) fold__$c visitor x state in"; + say " blahblah.fold__$c blahblah visitor x state"; # (*visitor.generic_ctor_or_field ctor_or_field_instance_info*) } - say " state"; # say " visitor.$t.$t__$c x (fun () -> whole_adt_info, info__$t, info__$t__$c) state continue_fold"; say ""; } } -say "let no_op : 'a fold_map_config = \{"; +say ""; +say 'let blahblah : blahblah = {'; +for $adts.list -> $t +{ say " fold__$t;"; + for $t.list -> $c + { say " fold__$t__$c;" } } +say '}'; + +say ""; +for $adts.list -> $t +{ say "let fold__$t : type qstate . qstate fold_config -> $t -> qstate -> qstate = fun visitor x state -> fold__$t blahblah visitor x state"; + for $t.list -> $c + { say "let fold__$t__$c : type qstate . qstate fold_config -> { $c || 'unit' } -> qstate -> qstate = fun visitor x state -> fold__$t__$c blahblah visitor x state" } } + + +say ""; +say 'type mk_continue_fold_map = {'; +say " fn : mk_continue_fold_map -> fold_map_config -> continue_fold_map"; +say '}'; + + +# fold_map functions +say ""; +for $adts.list -> $t +{ say "let _fold_map__$t : type qstate . mk_continue_fold_map -> fold_map_config -> $t -> qstate -> ($t * qstate) = fun mk_continue_fold_map visitor x state ->"; + say " let continue_fold_map : continue_fold_map = mk_continue_fold_map.fn mk_continue_fold_map visitor in"; + say " let state = visitor.$t.node__$t__pre_state x state in"; # (*(fun () -> whole_adt_info, info__$t)*) + say " let (new_x, state) = visitor.$t.node__$t x state continue_fold_map in"; # (*(fun () -> whole_adt_info, info__$t)*) + say " let state = visitor.$t.node__$t__post_state x new_x state in"; # (*(fun () -> whole_adt_info, info__$t)*) + say " (new_x, state)"; + say ""; + for $t.list -> $c + { say "let _fold_map__$t__$c : type qstate . mk_continue_fold_map -> fold_map_config -> { $c || 'unit' } -> qstate -> ({ $c || 'unit' } * qstate) = fun mk_continue_fold_map visitor x state ->"; + say " let continue_fold_map : continue_fold_map = mk_continue_fold_map.fn mk_continue_fold_map visitor in"; + say " visitor.$t.$t__$c x state continue_fold_map"; # (*(fun () -> whole_adt_info, info__$t, info__$t__$c)*) + say ""; } } + +# make the "continue" object +say ""; +say '(* Curries the "visitor" argument to the folds (non-customizable traversal functions). *)'; +say "let mk_continue_fold_map : mk_continue_fold_map = \{ fn = fun self visitor ->"; +say ' {'; +for $adts.list -> $t +{ say " $t = \{"; + say " node__$t = (fun x state -> _fold_map__$t self visitor x state) ;"; + for $t.list -> $c + { say " $t__$c = (fun x state -> _fold_map__$t__$c self visitor x state) ;"; } + say ' };' } +say ' }'; +say '}'; +say ""; + +# fold_map functions : tying the knot +say ""; +for $adts.list -> $t +{ say "let fold_map__$t : type qstate . fold_map_config -> $t -> qstate -> ($t * qstate) = fun visitor x state -> _fold_map__$t mk_continue_fold_map visitor x state"; + for $t.list -> $c + { say "let fold_map__$t__$c : type qstate . fold_map_config -> { $c || 'unit' } -> qstate -> ({ $c || 'unit' } * qstate) = fun visitor x state -> _fold_map__$t__$c mk_continue_fold_map visitor x state"; } } + + +say "let no_op : fold_map_config = \{"; for $adts.list -> $t { say " $t = \{"; - say " node__$t = (fun v (*_info*) state continue ->"; + say " node__$t = (fun v state continue ->"; # (*_info*) say " match v with"; if ($t eq $variant) { for $t.list -> $c @@ -384,10 +423,10 @@ for $adts.list -> $t say " )"; } say " );"; - say " node__$t__pre_state = (fun v (*_info*) state -> ignore v; state) ;"; - say " node__$t__post_state = (fun v new_v (*_info*) state -> ignore (v, new_v); state) ;"; + say " node__$t__pre_state = (fun v state -> ignore v; state) ;"; # (*_info*) + say " node__$t__post_state = (fun v new_v state -> ignore (v, new_v); state) ;"; # (*_info*) for $t.list -> $c - { print " $t__$c = (fun v (*_info*) state continue -> "; + { print " $t__$c = (fun v state continue -> "; # (*_info*) if ($c) { print "ignore continue; (v, state)"; } else {