diff --git a/src/stages/adt_generator/generator.raku b/src/stages/adt_generator/generator.raku index 86099df53..ae71c0dc1 100644 --- a/src/stages/adt_generator/generator.raku +++ b/src/stages/adt_generator/generator.raku @@ -178,7 +178,7 @@ say ' }'; say ""; say " type adt = node list"; say " type node_info = unit -> adt * node"; -say " type ctor_or_field_info = unit -> adt * node"; +say " type ctor_or_field_info = unit -> adt * node * ctor_or_field"; say "end"; @@ -203,6 +203,36 @@ for $adts.list -> $t } } say ' }'; +for $adts.list -> $t +{ for $t.list -> $c + { say "(* info for field or ctor $t.$c *)"; + say "let info_$t_$c : Adt_info.ctor_or_field = \{"; + say " name = \"$c\";"; + say " isBuiltin = {$c ?? 'true' !! 'false'};"; + say " type_ = \"$c\";"; + say '}'; + say ""; } + say "(* info for node $t *)"; + say "let info_$t : Adt_info.node = \{"; + my $kind = do given $t { + when $record { "Record" } + when $variant { "Variant" } + default { "Poly \"$_\"" } + }; + say " kind = $kind;"; + say " name = \"$t\";"; + print " ctors_or_fields = [ "; + for $t.list -> $c { print "info_$t_$c ; "; } + say "];"; + say '}'; + say ""; } + +say "(* info for adt $moduleName *)"; +print "let whole_adt_info : Adt_info.adt = [ "; +for $adts.list -> $t +{ print "info_$t ; "; } +say "]"; + say ""; say '(* Curries the "visitor" argument to the folds (non-customizable traversal functions). *)'; say "let rec mk_continue_fold : type state . state fold_config -> state continue_fold = fun visitor ->"; @@ -211,21 +241,21 @@ for $adts.list -> $t { say " $t = fold_$t visitor ;"; for $t.list -> $c { say " $t_$c = fold_$t_$c visitor ;"; } } -say '}'; +say ' }'; say ""; for $adts.list -> $t { say "and fold_$t : type state . state fold_config -> $t -> state -> ($t * state) = fun visitor x state ->"; say " let continue_fold : state continue_fold = mk_continue_fold visitor in"; - say " let state = visitor.$t_pre_state x (fun () -> failwith \"todo\") state in"; - say " let (new_x, state) = visitor.$t x (fun () -> failwith \"todo\") state continue_fold in"; - say " let state = visitor.$t_post_state x new_x (fun () -> failwith \"todo\") state in"; + say " let state = visitor.$t_pre_state x (fun () -> whole_adt_info, info_$t) state in"; + say " let (new_x, state) = visitor.$t x (fun () -> whole_adt_info, info_$t) state continue_fold in"; + say " let state = visitor.$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_$t_$c : type state . state fold_config -> $c -> state -> ($c * state) = fun visitor x state ->"; say " let continue_fold : state continue_fold = mk_continue_fold visitor in"; - say " visitor.$t_$c x (fun () -> failwith \"todo\") state continue_fold"; + say " visitor.$t_$c x (fun () -> whole_adt_info, info_$t, info_$t_$c) state continue_fold"; say ""; } } say "let no_op : 'a fold_config = \{";