From 521eb00da8d31342129844bd19ae59e99f90e519 Mon Sep 17 00:00:00 2001 From: reduction-choi Date: Wed, 4 Sep 2024 21:05:23 +0900 Subject: [PATCH] old walker removed --- spectec/src/al/walk.ml | 188 +++----------------- spectec/src/al/walk.mli | 21 +-- spectec/src/backend-interpreter/ds.ml | 22 ++- spectec/src/backend-prose/gen.ml | 11 +- spectec/src/il2al/translate.ml | 58 ++++--- spectec/src/il2al/transpile.ml | 238 ++++++++++++++++---------- 6 files changed, 233 insertions(+), 305 deletions(-) diff --git a/spectec/src/al/walk.ml b/spectec/src/al/walk.ml index 19cfb4cb25..1512f33f7c 100644 --- a/spectec/src/al/walk.ml +++ b/spectec/src/al/walk.ml @@ -93,26 +93,26 @@ let base_unit_walker = { super=None; walk_algo; walk_instr; walk_expr; walk_path type walker = { super: walker option; walk_algo: walker -> algorithm -> algorithm; - walk_instr: walker -> instr -> instr; + walk_instr: walker -> instr -> instr list; walk_expr: walker -> expr -> expr; walk_path: walker -> path -> path; walk_iter: walker -> iter -> iter; walk_arg: walker -> arg -> arg; } -let walk_arg (walker: walker) (arg: arg) : arg = +let walk_arg' (walker: walker) (arg: arg) : arg = let walk_expr = walker.walk_expr walker in match arg.it with | ExpA e -> { arg with it = ExpA (walk_expr e) } | TypA _ -> arg -let walk_iter (walker: walker) (iter: iter) : iter = +let walk_iter' (walker: walker) (iter: iter) : iter = let walk_expr = walker.walk_expr walker in match iter with | Opt | List | List1 -> iter | ListN (e, id_opt) -> ListN (walk_expr e, id_opt) -let walk_path (walker: walker) (path: path) : path = +let walk_path' (walker: walker) (path: path) : path = let walk_expr = walker.walk_expr walker in let it = match path.it with @@ -122,9 +122,9 @@ let walk_path (walker: walker) (path: path) : path = in { path with it } -let walk_expr (walker: walker) (expr: expr) : expr = +let walk_expr' (walker: walker) (expr: expr) : expr = let walk_arg = walker.walk_arg walker in - let walk_iter = walker.walk_iter walker in + (* let walk_iter = walker.walk_iter walker in *) let walk_path = walker.walk_path walker in let walk_expr = walker.walk_expr walker in let it = @@ -153,7 +153,7 @@ let walk_expr (walker: walker) (expr: expr) : expr = | LabelE (e1, e2) -> LabelE (walk_expr e1, walk_expr e2) | ContE e' -> ContE (walk_expr e') | ChooseE e' -> ChooseE (walk_expr e') - | IterE (e, ids, iter) -> IterE (walk_expr e, ids, walk_iter iter) + | IterE (e, ids, iter) -> IterE (walk_expr e, ids, (* walk_iter *) iter) | IsCaseOfE (e, a) -> IsCaseOfE (walk_expr e, a) | IsDefinedE e -> IsDefinedE (walk_expr e) | HasTypeE (e, t) -> HasTypeE(walk_expr e, t) @@ -164,7 +164,7 @@ let walk_expr (walker: walker) (expr: expr) : expr = in { expr with it } -let walk_instr (walker: walker) (instr: instr) : instr = +let walk_instr' (walker: walker) (instr: instr) : instr list = let walk_arg = walker.walk_arg walker in let walk_path = walker.walk_path walker in let walk_expr = walker.walk_expr walker in @@ -172,12 +172,12 @@ let walk_instr (walker: walker) (instr: instr) : instr = let it = match instr.it with | IfI (e, il1, il2) -> - IfI (walk_expr e, List.map walk_instr il1, List.map walk_instr il2) - | OtherwiseI il -> OtherwiseI (List.map walk_instr il) + IfI (walk_expr e, List.concat_map walk_instr il1, List.concat_map walk_instr il2) + | OtherwiseI il -> OtherwiseI (List.concat_map walk_instr il) | EitherI (il1, il2) -> - EitherI (List.map walk_instr il1, List.map walk_instr il2) + EitherI (List.concat_map walk_instr il1, List.concat_map walk_instr il2) | EnterI (e1, e2, il) -> - EnterI (walk_expr e1, walk_expr e2, List.map walk_instr il) + EnterI (walk_expr e1, walk_expr e2, List.concat_map walk_instr il) | AssertI e -> AssertI (walk_expr e) | PushI e -> PushI (walk_expr e) | PopI e -> PopI (walk_expr e) @@ -196,167 +196,25 @@ let walk_instr (walker: walker) (instr: instr) : instr = | FieldWiseAppendI (e1, e2) -> FieldWiseAppendI (walk_expr e1, walk_expr e2) | YetI _ -> instr.it in - { instr with it } + [{ instr with it }] -let walk_algo (walker: walker) (algo: algorithm) : algorithm = +let walk_algo' (walker: walker) (algo: algorithm) : algorithm = let walk_arg = walker.walk_arg walker in let walk_instr = walker.walk_instr walker in let it = match algo.it with | RuleA (name, anchor, args, instrs) -> - RuleA (name, anchor, List.map walk_arg args, List.map walk_instr instrs) + RuleA (name, anchor, List.map walk_arg args, List.concat_map walk_instr instrs) | FuncA (name, args, instrs) -> - FuncA (name, List.map walk_arg args, List.map walk_instr instrs) + FuncA (name, List.map walk_arg args, List.concat_map walk_instr instrs) in { algo with it } -let base_walker = { super=None; walk_algo; walk_instr; walk_expr; walk_path; walk_iter; walk_arg } - - -(* TODO: remove walker below *) - -type config = { - pre_instr: instr -> instr list; - post_instr: instr -> instr list; - stop_cond_instr: instr -> bool; - - pre_expr: expr -> expr; - post_expr: expr -> expr; - stop_cond_expr: expr -> bool; +let base_walker = { super=None; + walk_algo = walk_algo'; + walk_instr = walk_instr'; + walk_expr = walk_expr'; + walk_path = walk_path'; + walk_iter = walk_iter'; + walk_arg = walk_arg' } - -let id x = x -let ids x = [ x ] -let fls _ = false -let default_config = { - pre_instr = ids; - post_instr = ids; - stop_cond_instr = fls; - - pre_expr = id; - post_expr = id; - stop_cond_expr = fls; -} - -let rec walk_expr f e = - let { pre_expr = pre; post_expr = post; stop_cond_expr = stop_cond; _ } = f in - let new_ = walk_expr f in - - let super_walk e = - let e' = - match e.it with - | NumE _ - | BoolE _ - | GetCurStateE - | GetCurFrameE - | GetCurLabelE - | GetCurContextE -> e.it - | UnE (op, e') -> UnE (op, new_ e') - | BinE (op, e1, e2) -> BinE (op, new_ e1, new_ e2) - | CallE (id, al) -> CallE (id, List.map (walk_arg f) al) - | InvCallE (id, nl, el) -> InvCallE (id, nl, List.map (walk_arg f) el) - (* TODO: Implement walker for iter *) - | ListE el -> ListE (List.map new_ el) - | CompE (e1, e2) -> CompE (new_ e1, new_ e2) - | CatE (e1, e2) -> CatE (new_ e1, new_ e2) - | MemE (e1, e2) -> MemE (new_ e1, new_ e2) - | LenE e' -> LenE (new_ e') - | StrE r -> StrE (Record.map id new_ r) - | AccE (e, p) -> AccE (new_ e, walk_path f p) - | ExtE (e1, ps, e2, dir) -> ExtE (new_ e1, List.map (walk_path f) ps, new_ e2, dir) - | UpdE (e1, ps, e2) -> UpdE (new_ e1, List.map (walk_path f) ps, new_ e2) - | CaseE (a, el) -> CaseE (a, List.map new_ el) - | OptE e -> OptE (Option.map new_ e) - | TupE el -> TupE (List.map new_ el) - | ArityE e' -> ArityE (new_ e') - | FrameE (e1_opt, e2) -> FrameE (Option.map new_ e1_opt, new_ e2) - | LabelE (e1, e2) -> LabelE (new_ e1, new_ e2) - | ContE e' -> ContE (new_ e') - | ChooseE e' -> ChooseE (new_ e') - | VarE id -> VarE id - | SubE (id, t) -> SubE (id, t) - | IterE (e, ids, iter) -> IterE (new_ e, ids, iter) - | ContextKindE _ -> e.it - | IsCaseOfE (e, a) -> IsCaseOfE (new_ e, a) - | IsDefinedE e -> IsDefinedE (new_ e) - | HasTypeE (e, t) -> HasTypeE(new_ e, t) - | IsValidE e -> IsValidE (new_ e) - | TopLabelE -> e.it - | TopFrameE -> e.it - | TopValueE (Some e) -> TopValueE (Some (new_ e)) - | TopValueE _ -> e.it - | TopValuesE e -> TopValuesE (new_ e) - | MatchE (e1, e2) -> MatchE (new_ e1, new_ e2) - | YetE _ -> e.it - in - { e with it = e' } - in - - let e1 = pre e in - let e2 = if stop_cond e1 then e1 else super_walk e1 in - let e3 = post e2 in - e3 - -and walk_path f p = - let pre = id in - let post = id in - - let p' = - ( match (pre p).it with - | IdxP e -> IdxP (walk_expr f e) - | SliceP (e1, e2) -> SliceP (walk_expr f e1, walk_expr f e2) - | DotP a -> DotP a ) - in - let p = { p with it = p' } in - - post p - -and walk_arg f a = - match a.it with - | ExpA e -> { a with it = ExpA (walk_expr f e) } - | TypA _ -> a - -let rec walk_instr f (instr:instr) : instr list = - let { pre_instr = pre; post_instr = post; stop_cond_instr = stop_cond; _ } = f in - let new_ = List.concat_map (walk_instr f) in - let new_e = walk_expr f in - let new_a = walk_arg f in - - let super_walk i = - let i' = - match i.it with - | IfI (e, il1, il2) -> IfI (new_e e, new_ il1, new_ il2) - | OtherwiseI il -> OtherwiseI (new_ il) - | EitherI (il1, il2) -> EitherI (new_ il1, new_ il2) - | AssertI e -> AssertI (new_e e) - | PushI e -> PushI (new_e e) - | PopI e -> PopI (new_e e) - | PopAllI e -> PopAllI (new_e e) - | LetI (e1, e2) -> LetI (new_e e1, new_e e2) - | TrapI -> TrapI - | ThrowI e -> ThrowI (new_e e) - | NopI -> NopI - | ReturnI e_opt -> ReturnI (Option.map new_e e_opt) - | EnterI (e1, e2, il) -> EnterI (new_e e1, new_e e2, new_ il) - | ExecuteI e -> ExecuteI (new_e e) - | ExecuteSeqI e -> ExecuteSeqI (new_e e) - | PerformI (id, al) -> PerformI (id, List.map new_a al) - | ExitI _ -> i.it - | ReplaceI (e1, p, e2) -> ReplaceI (new_e e1, walk_path f p, new_e e2) - | AppendI (e1, e2) -> AppendI (new_e e1, new_e e2) - | FieldWiseAppendI (e1, e2) -> FieldWiseAppendI (new_e e1, new_e e2) - | YetI _ -> i.it in - { i with it = i' } - in - - let il1 = pre instr in - let il2 = List.map (fun i -> if stop_cond i then i else super_walk i) il1 in - let il3 = List.concat_map post il2 in - il3 - -and walk_instrs f = walk_instr f |> List.concat_map - -let walk' f algo' = match algo' with - | RuleA (a, anchor, params, body) -> RuleA (a, anchor, params, walk_instrs f body) - | FuncA (id, params, body) -> FuncA (id, params, walk_instrs f body) -let walk f algo = Source.map (walk' f) algo diff --git a/spectec/src/al/walk.mli b/spectec/src/al/walk.mli index 6872cc9794..22e0aef835 100644 --- a/spectec/src/al/walk.mli +++ b/spectec/src/al/walk.mli @@ -12,7 +12,7 @@ type unit_walker = { type walker = { super: walker option; walk_algo: walker -> algorithm -> algorithm; - walk_instr: walker -> instr -> instr; + walk_instr: walker -> instr -> instr list; walk_expr: walker -> expr -> expr; walk_path: walker -> path -> path; walk_iter: walker -> iter -> iter; @@ -20,22 +20,3 @@ type walker = { } val base_unit_walker : unit_walker val base_walker : walker - -(* TODO: remove walker below *) - -type config = { - pre_instr: instr -> instr list; - post_instr: instr -> instr list; - stop_cond_instr: instr -> bool; - - pre_expr: expr -> expr; - post_expr: expr -> expr; - stop_cond_expr: expr -> bool; -} -val default_config : config -val walk : config -> algorithm -> algorithm -val walk_instr : config -> instr -> instr list -val walk_instrs : config -> instr list -> instr list -val walk_expr : config -> expr -> expr -val walk_path : config -> path -> path -val walk_arg : config -> arg -> arg diff --git a/spectec/src/backend-interpreter/ds.ml b/spectec/src/backend-interpreter/ds.ml index f0a73188de..7629ffc2d5 100644 --- a/spectec/src/backend-interpreter/ds.ml +++ b/spectec/src/backend-interpreter/ds.ml @@ -341,14 +341,20 @@ let init algos = (* Initialize info_map *) let init_info algo = let algo_name = name_of_algo algo in - let config = { - Walk.default_config with pre_instr = - (fun i -> - let info = Info.make_info algo_name i in - Info.add i.note info; - [i]) - } in - Walk.walk config algo + let pre_instr = (fun i -> + let info = Info.make_info algo_name i in + Info.add i.note info; + [i]) + in + let walk_instr walker instr = + let instr1 = pre_instr instr in + List.concat_map (Al.Walk.base_walker.walk_instr walker) instr1 + in + let walker = { Walk.base_walker with + walk_instr = walk_instr; + } + in + walker.walk_algo walker algo in List.map init_info algos |> ignore; diff --git a/spectec/src/backend-prose/gen.ml b/spectec/src/backend-prose/gen.ml index d3b2b47f9a..c3f763ccde 100644 --- a/spectec/src/backend-prose/gen.ml +++ b/spectec/src/backend-prose/gen.ml @@ -135,9 +135,16 @@ let get_rel_kind def = | _ -> OtherRel let transpile_expr = - Al.Walk.walk_expr { Al.Walk.default_config with - post_expr = fun expr -> expr |> Il2al.Transpile.simplify_record_concat |> Il2al.Transpile.reduce_comp + let post_expr = fun expr -> expr |> Il2al.Transpile.simplify_record_concat |> Il2al.Transpile.reduce_comp in + let walk_expr walker expr = + let expr1 = Al.Walk.base_walker.walk_expr walker expr in + post_expr expr1 + in + let walker = { Al.Walk.base_walker with + walk_expr = walk_expr; } + in + walker.walk_expr walker let exp_to_expr e = translate_exp e |> transpile_expr let exp_to_argexpr es = translate_argexp es |> List.map transpile_expr diff --git a/spectec/src/il2al/translate.ml b/spectec/src/il2al/translate.ml index 82e3d5a632..ea3e9e9655 100644 --- a/spectec/src/il2al/translate.ml +++ b/spectec/src/il2al/translate.ml @@ -459,7 +459,7 @@ let rec translate_rhs exp = let walker = { Walk.base_walker with walk_expr } in let instrs = translate_rhs inner_exp in - List.map (walker.walk_instr walker) instrs + List.concat_map (walker.walk_instr walker) instrs (* Value *) | _ when is_wasm_value exp -> [ pushI {(translate_exp exp) with note = valT} ] (* Instr *) @@ -603,11 +603,13 @@ let handle_partial_bindings lhs rhs ids = new_e ) ) in - let walker = Al.Walk.walk_expr { Al.Walk.default_config with - pre_expr; - stop_cond_expr = contains_diff target_ns; - } in - let new_lhs = walker lhs in + let walk_expr walker expr = + let stop_cond_expr = contains_diff target_ns in + let expr1 = pre_expr expr in + if stop_cond_expr expr1 then expr1 else Al.Walk.base_walker.walk_expr walker expr1 + in + let walker = {Al.Walk.base_walker with walk_expr = walk_expr} in + let new_lhs = walker.walk_expr walker lhs in new_lhs, rhs, List.fold_left (fun il c -> [ ifI (c, il, []) ]) [] !conds let rec translate_bindings ids bindings = @@ -779,7 +781,7 @@ and handle_iter_lhs lhs rhs free_ids = (* Iter injection *) let walker = { Walk.base_walker with super = Some Walk.base_walker; walk_expr } in - let instrs' = List.map (walker.walk_instr walker) instrs in + let instrs' = List.concat_map (walker.walk_instr walker) instrs in (* Add ListN condition *) match iter with @@ -975,15 +977,19 @@ let rec translate_iterpr pr (iter, ids) = let post_instr i = let at = i.at in match i.it with - | LetI (lhs, rhs) -> [ letI (distribute_iter lhs rhs) ~at:at ] + | LetI (lhs, rhs) -> [letI (distribute_iter lhs rhs) ~at:at] | IfI (cond, il1, il2) -> let cond_ids = IdSet.elements (IdSet.inter (free_expr cond) ids') in let ty = handle_iter_ty cond.note in - [ ifI (iterE (cond, cond_ids, iter') ~at:cond.at ~note:ty, il1, il2) ~at:at ] - | _ -> [ i ] + [ifI (iterE (cond, cond_ids, iter') ~at:cond.at ~note:ty, il1, il2) ~at:at] + | _ -> [i] + in + let walk_instr walker instr = + let instr1 = Al.Walk.base_walker.walk_instr walker instr in + List.concat_map post_instr instr1 in - let walk_config = { Al.Walk.default_config with post_instr } in - Al.Walk.walk_instrs walk_config instrs + let walker = {Al.Walk.base_walker with walk_instr = walk_instr} in + List.concat_map (walker.walk_instr walker) instrs and translate_prem prem = let at = prem.at in @@ -1039,18 +1045,25 @@ let translate_helper helper = let id, clauses, partial = helper.it in let name = id.it in let args = List.hd clauses |> args_of_clause in + let walk_expr walker expr = + let expr1 = Transpile.remove_sub expr in + Al.Walk.base_walker.walk_expr walker expr1 + in + let walker = { Walk.base_walker with + walk_expr = walk_expr; + } + in let params = args |> translate_args - |> List.map - Walk.(walk_arg { default_config with pre_expr = Transpile.remove_sub }) + |> List.map (walker.walk_arg walker) in let blocks = List.map (translate_helper_body name) clauses in let body = Transpile.merge_blocks blocks (* |> Transpile.insert_frame_binding *) |> Transpile.handle_frame params - |> Walk.(walk_instrs { default_config with pre_expr = Transpile.remove_sub }) + |> List.concat_map (walker.walk_instr walker) |> Transpile.enhance_readability |> (if partial = Partial then Fun.id else Transpile.ensure_return) |> Transpile.flatten_if in @@ -1249,16 +1262,21 @@ and translate_rgroup (rule: rule_def) = |> List.map (fun e -> ExpA e $ e.at) in (* TODO: refactor transpiles *) - let al_params' = - List.map - Walk.(walk_arg { default_config with pre_expr = Transpile.remove_sub }) - al_params + let walk_expr walker expr = + let expr1 = Transpile.remove_sub expr in + Al.Walk.base_walker.walk_expr walker expr1 + in + let walker = { Walk.base_walker with + walk_expr = walk_expr; + } + in + let al_params' = List.map (walker.walk_arg walker) al_params in let body = instrs |> Transpile.insert_frame_binding |> Transpile.insert_nop - |> Walk.(walk_instrs { default_config with pre_expr = Transpile.remove_sub }) + |> List.concat_map (walker.walk_instr walker) |> Transpile.enhance_readability |> Transpile.infer_assert |> Transpile.flatten_if diff --git a/spectec/src/il2al/transpile.ml b/spectec/src/il2al/transpile.ml index d3c145ea3d..18c41d0b08 100644 --- a/spectec/src/il2al/transpile.ml +++ b/spectec/src/il2al/transpile.ml @@ -302,17 +302,19 @@ let remove_unnecessary_branch = remove_unnecessary_branch' [] let push_either = - let push_either' i = + let push_either' walker i = let either_at = i.at in + let walk_instr = walker.walk_instr walker in match i.it with | EitherI (il1, il2) -> (match Lib.List.split_last il1 with | hds, { it = IfI (c, then_body, []); at = if_at; _ } -> - eitherI (hds @ [ ifI (c, then_body, il2) ~at:if_at ], il2) ~at:either_at - | _ -> i) - | _ -> i in - - Walk.walk_instr { Walk.default_config with pre_instr = lift push_either' } + walk_instr (eitherI (hds @ [ ifI (c, then_body, il2) ~at:if_at ], il2) ~at:either_at) + | _ -> walk_instr i) + | _ -> walk_instr i + in + let walker = {Walk.base_walker with walk_instr = push_either'} in + walker.walk_instr walker let merge_three_branches i = let at1 = i.at in @@ -450,12 +452,18 @@ let infer_case_assert instrs = | BinE ((AndOp | OrOp), c1, c2) -> handle_cond c1 mt_then mt_else; handle_cond c2 mt_then mt_else | _ -> () in - let handle_if i = + let handle_if walker i = + let walk_expr = walker.walk_expr walker in + let walk_instr = walker.walk_instr walker in match i.it with - | IfI (c, il1, il2) -> handle_cond c (il1 = []) (il2 = []) - | _ -> () + | IfI (c, il1, il2) -> + handle_cond c (il1 = []) (il2 = []); + let it = IfI (walk_expr c, List.concat_map walk_instr il1, List.concat_map walk_instr il2) in + [{i with it}] + | _ -> base_walker.walk_instr walker i in - let count_cases = walk_instrs { default_config with pre_instr = (fun i -> handle_if i; [ i ]) } in + let walker = {base_walker with walk_instr = handle_if} in + let count_cases = List.concat_map (walker.walk_instr walker) in count_cases instrs |> ignore; let is_single_case_check c = @@ -514,13 +522,20 @@ let reduce_comp expr = let loop_max = 100 let loop_cnt = ref loop_max let rec enhance_readability instrs = - let walk_config = - { - Walk.default_config with - pre_expr = simplify_record_concat |> composite if_not_defined |> composite reduce_comp; - post_instr = - unify_if_head @@ unify_if_tail @@ (lift swap_if) @@ early_return @@ (lift merge_three_branches); - } in + let pre_expr = simplify_record_concat |> composite if_not_defined |> composite reduce_comp in + let walk_expr walker expr = + let expr1 = pre_expr expr in + Al.Walk.base_walker.walk_expr walker expr1 + in + let post_instr = unify_if_head @@ unify_if_tail @@ (lift swap_if) @@ early_return @@ (lift merge_three_branches) in + let walk_instr walker instr = + let instr1 = Al.Walk.base_walker.walk_instr walker instr in + List.concat_map post_instr instr1 + in + let walker = {Walk.base_walker with + walk_expr = walk_expr; + walk_instr = walk_instr; + } in let instrs' = instrs @@ -531,7 +546,7 @@ let rec enhance_readability instrs = |> List.concat_map remove_unnecessary_branch |> remove_nop [] |> infer_case_assert - |> Walk.walk_instrs walk_config + |> List.concat_map (walker.walk_instr walker) in if !loop_cnt = 0 || Eq.eq_instrs instrs instrs' then ( @@ -552,13 +567,12 @@ let flatten_if instrs = ifI (binE (AndOp, e1, e2) ~at:at ~note:boolT, il1, il2) ~at:at1 | _ -> instr in - let walk_config = - { - Walk.default_config with - post_instr = lift flatten_if'; - } in - - Walk.walk_instrs walk_config instrs + let walk_instr walker instr = + let instr1 = Al.Walk.base_walker.walk_instr walker instr in + List.map flatten_if' instr1 + in + let walker = { base_walker with walk_instr = walk_instr } in + List.concat_map (walker.walk_instr walker) instrs let rec mk_access ps base = match ps with @@ -659,15 +673,20 @@ let hide_state instr = | _ -> [ instr ] let remove_state algo = - let walk_config = - { - Walk.default_config with - pre_instr = hide_state; - pre_expr = hide_state_expr; - } + let walk_expr walker expr = + let expr1 = hide_state_expr expr in + Al.Walk.base_walker.walk_expr walker expr1 in - - let algo' = Walk.walk walk_config algo in + let walk_instr walker instr = + let instr1 = hide_state instr in + List.concat_map (Al.Walk.base_walker.walk_instr walker) instr1 + in + let walker = { Walk.base_walker with + walk_expr = walk_expr; + walk_instr = walk_instr; + } + in + let algo' = walker.walk_algo walker algo in { algo' with it = match algo'.it with | FuncA (name, args, body) -> @@ -726,16 +745,20 @@ let recover_state algo = | _ -> [instr] in - let walk_config = - { - Walk.default_config with - (* pre_instr = ; *) - pre_expr = recover_state_expr; - pre_instr = recover_state_instr - } + let walk_expr walker expr = + let expr1 = recover_state_expr expr in + Al.Walk.base_walker.walk_expr walker expr1 in - - let algo' = Walk.walk walk_config algo in + let walk_instr walker instr = + let instr1 = recover_state_instr instr in + List.concat_map (Al.Walk.base_walker.walk_instr walker) instr1 + in + let walker = { Walk.base_walker with + walk_expr = walk_expr; + walk_instr = walk_instr; + } + in + let algo' = walker.walk_algo walker algo in algo' let insert_state_binding algo = @@ -748,14 +771,12 @@ let insert_state_binding algo = e in - let walk_config = - { - Walk.default_config with - pre_expr = count_state; - } + let walk_expr walker expr = + let expr1 = count_state expr in + Al.Walk.base_walker.walk_expr walker expr1 in - - let algo' = Walk.walk walk_config algo in + let walker = { Walk.base_walker with walk_expr = walk_expr; } in + let algo' = walker.walk_algo walker algo in if !state_count > 0 then ( match algo.it with | RuleA _ -> @@ -816,17 +837,22 @@ let insert_frame_binding instrs = [ i ] in - let walk_config = - { - Walk.default_config with - pre_expr = count_frame; - pre_instr = update_bindings; - stop_cond_instr = found_frame; - post_instr = check_free_frame; - } + let walk_expr walker expr = + let expr1 = count_frame expr in + Al.Walk.base_walker.walk_expr walker expr1 + in + let walk_instr walker instr = + let instr1 = update_bindings instr in + let instr2 = List.concat_map (fun i -> if found_frame i then [i] else Al.Walk.base_walker.walk_instr walker i) instr1 in + List.concat_map check_free_frame instr2 + in + let walker = { Walk.base_walker with + walk_expr = walk_expr; + walk_instr = walk_instr; + } in - match Walk.walk_instrs walk_config instrs with + match List.concat_map (walker.walk_instr walker) instrs with | il when !found -> (letI (varE "f" ~note:frameT, getCurFrameE () ~note:frameT)) :: il | _ -> instrs @@ -878,12 +904,21 @@ let handle_framed_algo a instrs = (* End of helpers *) let instr_hd = letI (e_zf, { e_zf with it = GetCurFrameE }) ~at:e_zf.at in - let instr_tl = walk_instrs { default_config with - post_instr; - pre_expr = frame_finder; - post_expr = expr_to_mutI - } instrs in - + let walk_expr walker expr = + let expr1 = frame_finder expr in + let expr2 = Al.Walk.base_walker.walk_expr walker expr1 in + expr_to_mutI expr2 + in + let walk_instr walker instr = + let instr1 = Al.Walk.base_walker.walk_instr walker instr in + List.concat_map post_instr instr1 + in + let walker = { Walk.base_walker with + walk_expr = walk_expr; + walk_instr = walk_instr; + } + in + let instr_tl = List.concat_map (walker.walk_instr walker) instrs in if !frame_appeared then instr_hd :: instr_tl else instr_tl (* Case 2 *) @@ -927,10 +962,20 @@ let handle_unframed_algo instrs = in (* End of helpers *) - walk_instrs { default_config with - post_instr; - pre_expr = extract_frame_arg; - } instrs + let walk_expr walker expr = + let expr1 = extract_frame_arg expr in + Al.Walk.base_walker.walk_expr walker expr1 + in + let walk_instr walker instr = + let instr1 = Al.Walk.base_walker.walk_instr walker instr in + List.concat_map post_instr instr1 + in + let walker = { Walk.base_walker with + walk_expr = walk_expr; + walk_instr = walk_instr; + } + in + List.concat_map (walker.walk_instr walker) instrs let handle_frame params instrs = match List.find_opt (fun a -> is_frame_arg a || is_state_arg a) params with @@ -982,8 +1027,15 @@ and enforce_return il = il |> List.rev |> enforce_return' |> List.rev let contains_return il = let ret = ref false in let pre_instr = fun i -> (match i.it with ReturnI _ | TrapI -> ret := true | _ -> ()); [ i ] in - let config = { Walk.default_config with pre_instr } in - List.map (Walk.walk_instr config) il |> ignore; + let walk_instr walker instr = + let instr1 = pre_instr instr in + List.concat_map (Al.Walk.base_walker.walk_instr walker) instr1 + in + let walker = { Walk.base_walker with + walk_instr = walk_instr; + } + in + List.concat_map (walker.walk_instr walker) il |> ignore; !ret (* If intrs contain a return statement, make sure that every path has return statement in the end *) @@ -1000,15 +1052,15 @@ let remove_exit algo = popI (getCurLabelE () ~note:labelT) ~at:instr.at | _ -> instr in - - let walk_config = - { - Walk.default_config with - pre_instr = lift exit_to_pop; - } + let walk_instr walker instr = + let instr1 = (lift exit_to_pop) instr in + List.concat_map (Al.Walk.base_walker.walk_instr walker) instr1 in - - Walk.walk walk_config algo + let walker = { Walk.base_walker with + walk_instr = walk_instr; + } + in + walker.walk_algo walker algo (* EnterI to PushI *) let remove_enter algo = @@ -1078,22 +1130,28 @@ let remove_enter algo = let remove_enter' = Source.map (function | FuncA (name, params, body) -> - let walk_config = - { - Walk.default_config with - pre_instr = enter_frame_to_push_then_pop @@ (lift enter_label_to_push); - } + let pre_instr = enter_frame_to_push_then_pop @@ (lift enter_label_to_push) in + let walk_instr walker instr = + let instr1 = pre_instr instr in + List.concat_map (Al.Walk.base_walker.walk_instr walker) instr1 in - let body = Walk.walk_instrs walk_config body in + let walker = { Walk.base_walker with + walk_instr = walk_instr; + } + in + let body = List.concat_map (walker.walk_instr walker) body in FuncA (name, params, body) | RuleA (name, anchor, params, body) -> - let walk_config = - { - Walk.default_config with - pre_instr = enter_frame_to_push @@ (lift enter_label_to_push) @@ enter_handler_to_push; - } + let pre_instr = enter_frame_to_push @@ (lift enter_label_to_push) @@ enter_handler_to_push in + let walk_instr walker instr = + let instr1 = pre_instr instr in + List.concat_map (Al.Walk.base_walker.walk_instr walker) instr1 + in + let walker = { Walk.base_walker with + walk_instr = walk_instr; + } in - let body = Walk.walk_instrs walk_config body in + let body = List.concat_map (walker.walk_instr walker) body in RuleA (name, anchor, params, body) ) in