From eceeb3c157c77b0edb60a33d8437430309b1a9e9 Mon Sep 17 00:00:00 2001 From: dsac Date: Thu, 15 Dec 2022 20:37:05 +0100 Subject: [PATCH] [fix] identation error --- src/passes.ml | 380 +++++++++++++++++++++++++------------------------- 1 file changed, 190 insertions(+), 190 deletions(-) diff --git a/src/passes.ml b/src/passes.ml index 9b6ccf0..9fdffda 100644 --- a/src/passes.ml +++ b/src/passes.ml @@ -24,207 +24,207 @@ let pre2vars verbose debug main_fn = then EMonOp (ty, mop, EMonOp (ty, mop, expr)) else pre_push (pre_push expr) | _ -> EMonOp (ty, mop, pre_push expr) - end - | EBinOp (ty, bop, expr, expr') -> - let expr = pre_push expr in let expr' = pre_push expr' in - EBinOp (ty, bop, expr, expr') - | ETriOp (ty, top, expr, expr', expr'') -> - let expr = pre_push expr in let expr' = pre_push expr' in - let expr'' = pre_push expr'' in - ETriOp (ty, top, expr, expr', expr'') - | EComp (ty, cop, expr, expr') -> - let expr = pre_push expr in let expr' = pre_push expr' in - EComp (ty, cop, expr, expr') - | EWhen (ty, expr, expr') -> - let expr = pre_push expr in let expr' = pre_push expr' in - EWhen (ty, expr, expr') - | EReset (ty, expr, expr') -> - let expr = pre_push expr in let expr' = pre_push expr' in - EReset (ty, expr, expr') - | ETuple (ty, elist) -> - let elist = - List.fold_right (fun expr acc -> (pre_push expr) :: acc) elist [] in - ETuple (ty, elist) - | EApp (ty, node, arg) -> - let arg = pre_push arg in - EApp (ty, node, arg) -in -let rec aux (expr: t_expression) = - match expr with - | EVar _ -> expr - | EMonOp (ty, mop, expr) -> - begin - match mop with - | MOp_pre -> pre_push expr - | _ -> let expr = aux expr in EMonOp (ty, mop, expr) - end - | EBinOp (ty, bop, expr, expr') -> - let expr = aux expr in let expr' = aux expr' in - EBinOp (ty, bop, expr, expr') - | ETriOp (ty, top, expr, expr', expr'') -> - let expr = aux expr in let expr' = aux expr' in - let expr'' = aux expr'' in - ETriOp (ty, top, expr, expr', expr'') - | EComp (ty, cop, expr, expr') -> - let expr = aux expr in let expr' = aux expr' in - EComp (ty, cop, expr, expr') - | EWhen (ty, expr, expr') -> - let expr = aux expr in let expr' = aux expr' in - EWhen (ty, expr, expr') - | EReset (ty, expr, expr') -> - let expr = aux expr in let expr' = aux expr' in - EReset (ty, expr, expr') - | EConst (ty, c) -> EConst (ty, c) - | ETuple (ty, elist) -> - let elist = - List.fold_right (fun expr acc -> (aux expr) :: acc) elist [] in - ETuple (ty, elist) - | EApp (ty, node, arg) -> - let arg = aux arg in - EApp (ty, node, arg) -in -expression_pass (somify aux) + end + | EBinOp (ty, bop, expr, expr') -> + let expr = pre_push expr in let expr' = pre_push expr' in + EBinOp (ty, bop, expr, expr') + | ETriOp (ty, top, expr, expr', expr'') -> + let expr = pre_push expr in let expr' = pre_push expr' in + let expr'' = pre_push expr'' in + ETriOp (ty, top, expr, expr', expr'') + | EComp (ty, cop, expr, expr') -> + let expr = pre_push expr in let expr' = pre_push expr' in + EComp (ty, cop, expr, expr') + | EWhen (ty, expr, expr') -> + let expr = pre_push expr in let expr' = pre_push expr' in + EWhen (ty, expr, expr') + | EReset (ty, expr, expr') -> + let expr = pre_push expr in let expr' = pre_push expr' in + EReset (ty, expr, expr') + | ETuple (ty, elist) -> + let elist = + List.fold_right (fun expr acc -> (pre_push expr) :: acc) elist [] in + ETuple (ty, elist) + | EApp (ty, node, arg) -> + let arg = pre_push arg in + EApp (ty, node, arg) + in + let rec aux (expr: t_expression) = + match expr with + | EVar _ -> expr + | EMonOp (ty, mop, expr) -> + begin + match mop with + | MOp_pre -> pre_push expr + | _ -> let expr = aux expr in EMonOp (ty, mop, expr) + end + | EBinOp (ty, bop, expr, expr') -> + let expr = aux expr in let expr' = aux expr' in + EBinOp (ty, bop, expr, expr') + | ETriOp (ty, top, expr, expr', expr'') -> + let expr = aux expr in let expr' = aux expr' in + let expr'' = aux expr'' in + ETriOp (ty, top, expr, expr', expr'') + | EComp (ty, cop, expr, expr') -> + let expr = aux expr in let expr' = aux expr' in + EComp (ty, cop, expr, expr') + | EWhen (ty, expr, expr') -> + let expr = aux expr in let expr' = aux expr' in + EWhen (ty, expr, expr') + | EReset (ty, expr, expr') -> + let expr = aux expr in let expr' = aux expr' in + EReset (ty, expr, expr') + | EConst (ty, c) -> EConst (ty, c) + | ETuple (ty, elist) -> + let elist = + List.fold_right (fun expr acc -> (aux expr) :: acc) elist [] in + ETuple (ty, elist) + | EApp (ty, node, arg) -> + let arg = aux arg in + EApp (ty, node, arg) + in + expression_pass (somify aux) let chkvar_init_unicity verbose debug main_fn : t_nodelist -> t_nodelist option = -let aux (node: t_node) : t_node option = - let incr_aux h n = - match Hashtbl.find_opt h n with - | None -> failwith "todo, should not happened." - | Some num -> Hashtbl.replace h n (num + 1) - in - let incr_eq h (((_, patt), _): t_equation) = - List.iter (fun v -> incr_aux h (name_of_var v)) patt - in - let rec incr_eqlist h = function - | [] -> () - | eq :: eqs -> (incr_eq h eq; incr_eqlist h eqs) - in - let incr_branch h (State (_, eqs, _, _): t_state) = incr_eqlist h eqs in - let incr_automata h ((_, states): t_automaton) = - let acc = Hashtbl.copy h in - List.iter - (fun st -> - let h_st = Hashtbl.copy h in - incr_branch h_st st; - Hashtbl.iter - (fun varname num' -> - match Hashtbl.find_opt acc varname with - | None -> failwith "no!" - | Some num -> Hashtbl.replace acc varname (Int.max num num') - ) h_st) states; - Hashtbl.iter (fun v n -> Hashtbl.replace h v n) acc + let aux (node: t_node) : t_node option = + let incr_aux h n = + match Hashtbl.find_opt h n with + | None -> failwith "todo, should not happened." + | Some num -> Hashtbl.replace h n (num + 1) in - let check_now h : bool= - Hashtbl.fold - (fun varname num old_res -> - if num > 1 - then (verbose (Format.asprintf "%s initialized twice!" varname); false) - else old_res) h true + let incr_eq h (((_, patt), _): t_equation) = + List.iter (fun v -> incr_aux h (name_of_var v)) patt + in + let rec incr_eqlist h = function + | [] -> () + | eq :: eqs -> (incr_eq h eq; incr_eqlist h eqs) + in + let incr_branch h (State (_, eqs, _, _): t_state) = incr_eqlist h eqs in + let incr_automata h ((_, states): t_automaton) = + let acc = Hashtbl.copy h in + List.iter + (fun st -> + let h_st = Hashtbl.copy h in + incr_branch h_st st; + Hashtbl.iter + (fun varname num' -> + match Hashtbl.find_opt acc varname with + | None -> failwith "no!" + | Some num -> Hashtbl.replace acc varname (Int.max num num') + ) h_st) states; + Hashtbl.iter (fun v n -> Hashtbl.replace h v n) acc + in + let check_now h : bool= + Hashtbl.fold + (fun varname num old_res -> + if num > 1 + then (verbose (Format.asprintf "%s initialized twice!" varname); false) + else old_res) h true + in + (*let purge_initialized h = + Hashtbl.iter + (fun varname num -> + if num > 0 + then (verbose (Format.asprintf "Purging %s" varname); Hashtbl.remove h varname) + else ()) h + in*) + let h = Hashtbl.create Config.maxvar in + let add_var n v = + match v with + | IVar s -> Hashtbl.add h s n + | BVar s -> Hashtbl.add h s n + | RVar s -> Hashtbl.add h s n in - (*let purge_initialized h = - Hashtbl.iter - (fun varname num -> - if num > 0 - then (verbose (Format.asprintf "Purging %s" varname); Hashtbl.remove h varname) - else ()) h - in*) - let h = Hashtbl.create Config.maxvar in - let add_var n v = - match v with - | IVar s -> Hashtbl.add h s n - | BVar s -> Hashtbl.add h s n - | RVar s -> Hashtbl.add h s n + let add_var_in = add_var 1 in + let add_var_loc = add_var 0 in + List.iter add_var_in (snd node.n_inputs); + List.iter add_var_loc (snd node.n_outputs); + List.iter add_var_loc (snd node.n_local_vars); + (** Usual Equations *) + incr_eqlist h node.n_equations; + if check_now h = false + then None + else + begin + List.iter (* 0. *) (incr_automata h) node.n_automata; + if check_now h + then Some node + else None + end + (** never purge -> failwith never executed! purge_initialized h; *) in - let add_var_in = add_var 1 in - let add_var_loc = add_var 0 in - List.iter add_var_in (snd node.n_inputs); - List.iter add_var_loc (snd node.n_outputs); - List.iter add_var_loc (snd node.n_local_vars); - (** Usual Equations *) - incr_eqlist h node.n_equations; - if check_now h = false - then None - else - begin - List.iter (* 0. *) (incr_automata h) node.n_automata; - if check_now h - then Some node - else None - end - (** never purge -> failwith never executed! purge_initialized h; *) -in -node_pass aux + node_pass aux let pass_linearization verbose debug main_fn = -let node_lin (node: t_node): t_node option = - let rec tpl ((pat, exp): t_equation) = - match exp with - | ETuple (_, hexps :: texps) -> - debug "An ETuple has been recognized, inlining..."; - let p1, p2 = - list_select - (List.length (type_exp hexps)) - (snd pat) in - let t1 = List.flatten (List.map type_var p1) in - let t2 = List.flatten (List.map type_var p2) in - ((t1, p1), hexps) - :: (tpl ((t2, p2), - ETuple (List.flatten (List.map type_exp texps), texps))) - | ETuple (_, []) -> [] - | _ -> [(pat, exp)] + let node_lin (node: t_node): t_node option = + let rec tpl ((pat, exp): t_equation) = + match exp with + | ETuple (_, hexps :: texps) -> + debug "An ETuple has been recognized, inlining..."; + let p1, p2 = + list_select + (List.length (type_exp hexps)) + (snd pat) in + let t1 = List.flatten (List.map type_var p1) in + let t2 = List.flatten (List.map type_var p2) in + ((t1, p1), hexps) + :: (tpl ((t2, p2), + ETuple (List.flatten (List.map type_exp texps), texps))) + | ETuple (_, []) -> [] + | _ -> [(pat, exp)] + in + let new_locvars = node.n_local_vars in + let new_equations = List.flatten + begin + List.map + tpl + node.n_equations + end in + Some + { + n_name = node.n_name; + n_inputs = node.n_inputs; + n_outputs = node.n_outputs; + n_local_vars = new_locvars; + n_equations = new_equations; + n_automata = node.n_automata; + } in - let new_locvars = node.n_local_vars in - let new_equations = List.flatten - begin - List.map - tpl - node.n_equations - end in - Some - { - n_name = node.n_name; - n_inputs = node.n_inputs; - n_outputs = node.n_outputs; - n_local_vars = new_locvars; - n_equations = new_equations; - n_automata = node.n_automata; - } -in -node_pass node_lin + node_pass node_lin let pass_eq_reordering verbose debug main_fn ast = -let rec pick_equations init_vars eqs remaining_equations = - match remaining_equations with - | [] -> Some eqs - | _ -> - begin - match List.filter - (fun (patt, expr) -> - List.for_all - (fun v -> List.mem v init_vars) - (vars_of_expr expr)) - remaining_equations with - | [] -> raise (PassExn "[equation ordering] The equations cannot be ordered.") - | h :: t -> - let init_vars = - List.fold_left - (fun acc vs -> - acc @ (vars_of_patt (fst vs))) init_vars (h :: t) in - pick_equations init_vars (eqs@(h :: t)) - (List.filter (fun eq -> List.for_all (fun e -> eq <> e) (h :: t)) remaining_equations) - end + let rec pick_equations init_vars eqs remaining_equations = + match remaining_equations with + | [] -> Some eqs + | _ -> + begin + match List.filter + (fun (patt, expr) -> + List.for_all + (fun v -> List.mem v init_vars) + (vars_of_expr expr)) + remaining_equations with + | [] -> raise (PassExn "[equation ordering] The equations cannot be ordered.") + | h :: t -> + let init_vars = + List.fold_left + (fun acc vs -> + acc @ (vars_of_patt (fst vs))) init_vars (h :: t) in + pick_equations init_vars (eqs@(h :: t)) + (List.filter (fun eq -> List.for_all (fun e -> eq <> e) (h :: t)) remaining_equations) + end + in + let node_eq_reorganising (node: t_node): t_node option = + let init_vars = List.map name_of_var (snd node.n_inputs) in + try + begin + match pick_equations init_vars [] node.n_equations with + | None -> None + | Some eqs -> Some { node with n_equations = eqs } + end + with PassExn err -> (verbose err; None) in -let node_eq_reorganising (node: t_node): t_node option = - let init_vars = List.map name_of_var (snd node.n_inputs) in - try - begin - match pick_equations init_vars [] node.n_equations with - | None -> None - | Some eqs -> Some { node with n_equations = eqs } - end - with PassExn err -> (verbose err; None) -in -node_pass node_eq_reorganising ast + node_pass node_eq_reorganising ast let pass_typing verbose debug main_fn ast = let htbl = Hashtbl.create (List.length ast) in