[fix] identation error

This commit is contained in:
dsac 2022-12-15 20:37:05 +01:00
parent ca271eaf66
commit eceeb3c157

View File

@ -24,207 +24,207 @@ let pre2vars verbose debug main_fn =
then EMonOp (ty, mop, EMonOp (ty, mop, expr)) then EMonOp (ty, mop, EMonOp (ty, mop, expr))
else pre_push (pre_push expr) else pre_push (pre_push expr)
| _ -> EMonOp (ty, mop, pre_push expr) | _ -> EMonOp (ty, mop, pre_push expr)
end end
| EBinOp (ty, bop, expr, expr') -> | EBinOp (ty, bop, expr, expr') ->
let expr = pre_push expr in let expr' = pre_push expr' in let expr = pre_push expr in let expr' = pre_push expr' in
EBinOp (ty, bop, expr, expr') EBinOp (ty, bop, expr, expr')
| ETriOp (ty, top, expr, 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 let expr' = pre_push expr' in
let expr'' = pre_push expr'' in let expr'' = pre_push expr'' in
ETriOp (ty, top, expr, expr', expr'') ETriOp (ty, top, expr, expr', expr'')
| EComp (ty, cop, expr, expr') -> | EComp (ty, cop, expr, expr') ->
let expr = pre_push expr in let expr' = pre_push expr' in let expr = pre_push expr in let expr' = pre_push expr' in
EComp (ty, cop, expr, expr') EComp (ty, cop, expr, expr')
| EWhen (ty, expr, expr') -> | EWhen (ty, expr, expr') ->
let expr = pre_push expr in let expr' = pre_push expr' in let expr = pre_push expr in let expr' = pre_push expr' in
EWhen (ty, expr, expr') EWhen (ty, expr, expr')
| EReset (ty, expr, expr') -> | EReset (ty, expr, expr') ->
let expr = pre_push expr in let expr' = pre_push expr' in let expr = pre_push expr in let expr' = pre_push expr' in
EReset (ty, expr, expr') EReset (ty, expr, expr')
| ETuple (ty, elist) -> | ETuple (ty, elist) ->
let elist = let elist =
List.fold_right (fun expr acc -> (pre_push expr) :: acc) elist [] in List.fold_right (fun expr acc -> (pre_push expr) :: acc) elist [] in
ETuple (ty, elist) ETuple (ty, elist)
| EApp (ty, node, arg) -> | EApp (ty, node, arg) ->
let arg = pre_push arg in let arg = pre_push arg in
EApp (ty, node, arg) EApp (ty, node, arg)
in in
let rec aux (expr: t_expression) = let rec aux (expr: t_expression) =
match expr with match expr with
| EVar _ -> expr | EVar _ -> expr
| EMonOp (ty, mop, expr) -> | EMonOp (ty, mop, expr) ->
begin begin
match mop with match mop with
| MOp_pre -> pre_push expr | MOp_pre -> pre_push expr
| _ -> let expr = aux expr in EMonOp (ty, mop, expr) | _ -> let expr = aux expr in EMonOp (ty, mop, expr)
end end
| EBinOp (ty, bop, expr, expr') -> | EBinOp (ty, bop, expr, expr') ->
let expr = aux expr in let expr' = aux expr' in let expr = aux expr in let expr' = aux expr' in
EBinOp (ty, bop, expr, expr') EBinOp (ty, bop, expr, expr')
| ETriOp (ty, top, expr, expr', expr'') -> | ETriOp (ty, top, expr, expr', expr'') ->
let expr = aux expr in let expr' = aux expr' in let expr = aux expr in let expr' = aux expr' in
let expr'' = aux expr'' in let expr'' = aux expr'' in
ETriOp (ty, top, expr, expr', expr'') ETriOp (ty, top, expr, expr', expr'')
| EComp (ty, cop, expr, expr') -> | EComp (ty, cop, expr, expr') ->
let expr = aux expr in let expr' = aux expr' in let expr = aux expr in let expr' = aux expr' in
EComp (ty, cop, expr, expr') EComp (ty, cop, expr, expr')
| EWhen (ty, expr, expr') -> | EWhen (ty, expr, expr') ->
let expr = aux expr in let expr' = aux expr' in let expr = aux expr in let expr' = aux expr' in
EWhen (ty, expr, expr') EWhen (ty, expr, expr')
| EReset (ty, expr, expr') -> | EReset (ty, expr, expr') ->
let expr = aux expr in let expr' = aux expr' in let expr = aux expr in let expr' = aux expr' in
EReset (ty, expr, expr') EReset (ty, expr, expr')
| EConst (ty, c) -> EConst (ty, c) | EConst (ty, c) -> EConst (ty, c)
| ETuple (ty, elist) -> | ETuple (ty, elist) ->
let elist = let elist =
List.fold_right (fun expr acc -> (aux expr) :: acc) elist [] in List.fold_right (fun expr acc -> (aux expr) :: acc) elist [] in
ETuple (ty, elist) ETuple (ty, elist)
| EApp (ty, node, arg) -> | EApp (ty, node, arg) ->
let arg = aux arg in let arg = aux arg in
EApp (ty, node, arg) EApp (ty, node, arg)
in in
expression_pass (somify aux) expression_pass (somify aux)
let chkvar_init_unicity verbose debug main_fn : t_nodelist -> t_nodelist option = let chkvar_init_unicity verbose debug main_fn : t_nodelist -> t_nodelist option =
let aux (node: t_node) : t_node option = let aux (node: t_node) : t_node option =
let incr_aux h n = let incr_aux h n =
match Hashtbl.find_opt h n with match Hashtbl.find_opt h n with
| None -> failwith "todo, should not happened." | None -> failwith "todo, should not happened."
| Some num -> Hashtbl.replace h n (num + 1) | 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
in in
let check_now h : bool= let incr_eq h (((_, patt), _): t_equation) =
Hashtbl.fold List.iter (fun v -> incr_aux h (name_of_var v)) patt
(fun varname num old_res -> in
if num > 1 let rec incr_eqlist h = function
then (verbose (Format.asprintf "%s initialized twice!" varname); false) | [] -> ()
else old_res) h true | 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 in
(*let purge_initialized h = let add_var_in = add_var 1 in
Hashtbl.iter let add_var_loc = add_var 0 in
(fun varname num -> List.iter add_var_in (snd node.n_inputs);
if num > 0 List.iter add_var_loc (snd node.n_outputs);
then (verbose (Format.asprintf "Purging %s" varname); Hashtbl.remove h varname) List.iter add_var_loc (snd node.n_local_vars);
else ()) h (** Usual Equations *)
in*) incr_eqlist h node.n_equations;
let h = Hashtbl.create Config.maxvar in if check_now h = false
let add_var n v = then None
match v with else
| IVar s -> Hashtbl.add h s n begin
| BVar s -> Hashtbl.add h s n List.iter (* 0. *) (incr_automata h) node.n_automata;
| RVar s -> Hashtbl.add h s n if check_now h
then Some node
else None
end
(** never purge -> failwith never executed! purge_initialized h; *)
in in
let add_var_in = add_var 1 in node_pass aux
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
let pass_linearization verbose debug main_fn = let pass_linearization verbose debug main_fn =
let node_lin (node: t_node): t_node option = let node_lin (node: t_node): t_node option =
let rec tpl ((pat, exp): t_equation) = let rec tpl ((pat, exp): t_equation) =
match exp with match exp with
| ETuple (_, hexps :: texps) -> | ETuple (_, hexps :: texps) ->
debug "An ETuple has been recognized, inlining..."; debug "An ETuple has been recognized, inlining...";
let p1, p2 = let p1, p2 =
list_select list_select
(List.length (type_exp hexps)) (List.length (type_exp hexps))
(snd pat) in (snd pat) in
let t1 = List.flatten (List.map type_var p1) in let t1 = List.flatten (List.map type_var p1) in
let t2 = List.flatten (List.map type_var p2) in let t2 = List.flatten (List.map type_var p2) in
((t1, p1), hexps) ((t1, p1), hexps)
:: (tpl ((t2, p2), :: (tpl ((t2, p2),
ETuple (List.flatten (List.map type_exp texps), texps))) ETuple (List.flatten (List.map type_exp texps), texps)))
| ETuple (_, []) -> [] | ETuple (_, []) -> []
| _ -> [(pat, exp)] | _ -> [(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 in
let new_locvars = node.n_local_vars in node_pass node_lin
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
let pass_eq_reordering verbose debug main_fn ast = let pass_eq_reordering verbose debug main_fn ast =
let rec pick_equations init_vars eqs remaining_equations = let rec pick_equations init_vars eqs remaining_equations =
match remaining_equations with match remaining_equations with
| [] -> Some eqs | [] -> Some eqs
| _ -> | _ ->
begin begin
match List.filter match List.filter
(fun (patt, expr) -> (fun (patt, expr) ->
List.for_all List.for_all
(fun v -> List.mem v init_vars) (fun v -> List.mem v init_vars)
(vars_of_expr expr)) (vars_of_expr expr))
remaining_equations with remaining_equations with
| [] -> raise (PassExn "[equation ordering] The equations cannot be ordered.") | [] -> raise (PassExn "[equation ordering] The equations cannot be ordered.")
| h :: t -> | h :: t ->
let init_vars = let init_vars =
List.fold_left List.fold_left
(fun acc vs -> (fun acc vs ->
acc @ (vars_of_patt (fst vs))) init_vars (h :: t) in acc @ (vars_of_patt (fst vs))) init_vars (h :: t) in
pick_equations init_vars (eqs@(h :: t)) pick_equations init_vars (eqs@(h :: t))
(List.filter (fun eq -> List.for_all (fun e -> eq <> e) (h :: t)) remaining_equations) (List.filter (fun eq -> List.for_all (fun e -> eq <> e) (h :: t)) remaining_equations)
end 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 in
let node_eq_reorganising (node: t_node): t_node option = node_pass node_eq_reorganising ast
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
let pass_typing verbose debug main_fn ast = let pass_typing verbose debug main_fn ast =
let htbl = Hashtbl.create (List.length ast) in let htbl = Hashtbl.create (List.length ast) in