CristalCaveGem » LustreC

open Vhdl_ast

open Mini_vhdl_ast

let mini_vhdl_declaration_t_names decl=

  match decl with

  | MiniSigDecl { names; typ; init_val } -> names

  | _ -> []

let rec remove_opt l=

  match l with

  | [] -> []

  | (None)::tl -> remove_opt tl

  | (Some a)::tl -> a::(remove_opt tl)

let rec get_ports: vhdl_port_t list -> vhdl_port_mode_t -> vhdl_port_t list= 

  fun l -> fun m -> match l with 

    | [] -> [] 

    | hd::tl -> if hd.port_mode = m then hd::(get_ports tl m) else get_ports tl m

let rec get_ports_pos: vhdl_port_t list -> vhdl_port_mode_t -> int -> int list= 

  fun l -> fun m -> fun index -> match l with 

    | [] -> []

    | hd::tl -> if hd.port_mode = m then index::(get_ports_pos tl m (index+1)) else get_ports_pos tl m (index+1)

let get_names : vhdl_port_t -> vhdl_name_t list= fun x -> x.port_names

let rec duplicates l1=

  match l1 with

  | [] -> []

  | hd::tl -> if List.mem hd tl then hd::(duplicates (List.filter (fun x -> List.mem x tl) tl)) else duplicates tl

let equals n1 n2=

  match (n1,n2) with

  | (Simple a, Identifier b) -> a = b

  | (Identifier a, Simple b) -> a = b

  | (Simple a, Selected ((Simple b)::[])) -> a = b

  | (Simple a, Selected ((Identifier b)::[])) -> a = b

  | (Identifier a, Selected ((Simple b)::[])) -> a = b

  | (Identifier a, Selected ((Identifier b)::[])) -> a = b

  | (Selected ((Simple b)::[]), Simple a) -> a = b

  | (Selected ((Identifier b)::[]), Simple a) -> a = b

  | (Selected ((Simple b)::[]), Identifier a) -> a = b

  | (Selected ((Identifier b)::[]), Identifier a) -> a = b

  | (a,b) -> a = b

let find_vhdl_name_t l x =

  let rec find_vhdl_name_t_aux x l index =

    match l with

    | [] -> -1

    | hd::tl -> if (equals x hd) then index else find_vhdl_name_t_aux x tl (index+1) in

  find_vhdl_name_t_aux x l 0

let rec vhdl_name_t_mem x l =

  match l with

  | [] -> false

  | hd::tl -> equals x hd || vhdl_name_t_mem x tl

let rec diff l1 l2 =

  match l1 with

  | [] -> []

  | hd::tl -> 

      if vhdl_name_t_mem hd l2 then diff tl l2 else hd::(diff tl l2)

let n_intersection ll =

  let rec n_intersection_aux e_inter l = 

    match e_inter with 

    | [] -> l 

    | hd::tl -> if (vhdl_name_t_mem hd l) then hd::(n_intersection_aux tl l) else n_intersection_aux tl l

  in

  List.fold_left n_intersection_aux [] ll

let rec times : 'a list list -> 'a list list -> 'a list list=

  fun a ->

    fun b ->

      match a with

      | [] -> b

      | hda::tla -> match b with

                    | [] -> a

                    | hdb::tlb -> [hdb@hda]@(times tla tlb)

(* Signals lattice *)

let build_signals_lattice = object (self)

  inherit [_] mini_vhdl_iter as super

(*  method! visit_vhdl_expr_t env e = 

    match e with

    | Op ({id=""; args=hd::[]}) -> self#visit_vhdl_expr_t env hd

    | _ -> super#visit_vhdl_expr_t env e*)

end