Project

General

Profile

Download (4.94 KB) Statistics
| Branch: | Tag: | Revision:
1
open Vhdl_ast
2

    
3
let rec get_ports: vhdl_port_t list -> vhdl_port_mode_t -> vhdl_port_t list= 
4
  fun l -> fun m -> match l with 
5
    | [] -> [] 
6
    | hd::tl -> if hd.port_mode = m then hd::(get_ports tl m) else get_ports tl m
7

    
8
let rec get_ports_pos: vhdl_port_t list -> vhdl_port_mode_t -> int -> int list= 
9
  fun l -> fun m -> fun index -> match l with 
10
    | [] -> []
11
    | hd::tl -> if hd.port_mode = m then index::(get_ports_pos tl m (index+1)) else get_ports_pos tl m (index+1)
12

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

    
15
let equals n1 n2=
16
  match (n1,n2) with
17
  | (Simple a, Identifier b) -> a = b
18
  | (Identifier a, Simple b) -> a = b
19
  | (Simple a, Selected ((Simple b)::[])) -> a = b
20
  | (Simple a, Selected ((Identifier b)::[])) -> a = b
21
  | (Identifier a, Selected ((Simple b)::[])) -> a = b
22
  | (Identifier a, Selected ((Identifier b)::[])) -> a = b
23
  | (Selected ((Simple b)::[]), Simple a) -> a = b
24
  | (Selected ((Identifier b)::[]), Simple a) -> a = b
25
  | (Selected ((Simple b)::[]), Identifier a) -> a = b
26
  | (Selected ((Identifier b)::[]), Identifier a) -> a = b
27
  | (a,b) -> a = b
28

    
29
let find_vhdl_name_t l x =
30
  let rec find_vhdl_name_t_aux x l index =
31
    match l with
32
    | [] -> -1
33
    | hd::tl -> if (equals x hd) then index else find_vhdl_name_t_aux x tl (index+1) in
34
  find_vhdl_name_t_aux x l 0
35

    
36
let rec vhdl_name_t_mem x l =
37
  match l with
38
  | [] -> false
39
  | hd::tl -> equals x hd || vhdl_name_t_mem x tl
40

    
41
let rec diff l1 l2 =
42
  match l1 with
43
  | [] -> []
44
  | hd::tl -> 
45
      if vhdl_name_t_mem hd l2 then diff tl l2 else hd::(diff tl l2)
46

    
47
let n_intersection ll =
48
  let rec n_intersection_aux e_inter l = 
49
    match e_inter with 
50
    | [] -> l 
51
    | hd::tl -> if (vhdl_name_t_mem hd l) then hd::(n_intersection_aux tl l) else n_intersection_aux tl l
52
  in
53
  List.fold_left n_intersection_aux [] ll
54

    
55
(*************************
56
 * Begin vhdl_name_t helpers
57
 *)
58
let rec lower_vhdl_name_t : vhdl_name_t -> vhdl_name_t=
59
  fun x  ->
60
    let lower a = String.lowercase_ascii a in
61
    match x with
62
    | Simple a -> Simple (lower a)
63
    | Identifier a -> Identifier (lower a)
64
    | Selected a -> Selected (List.map lower_vhdl_name_t a)
65
    | Index { id; exprs } ->
66
        let id = lower_vhdl_name_t id  in
67
        Index { id; exprs }
68
    | Slice { id; range } ->
69
        let id = lower_vhdl_name_t id  in
70
        Slice { id; range }
71
    | Attribute { id; designator; expr } ->
72
        let id = lower_vhdl_name_t id  in
73
        let designator = lower_vhdl_name_t designator  in
74
        Attribute { id; designator; expr }
75
    | Function { id; assoc_list } ->
76
        let id = lower_vhdl_name_t id  in
77
        Function { id; assoc_list }
78
    | NoName  -> NoName
79
    | Open -> Open
80
 
81
let rec simplify_name_t : vhdl_name_t -> vhdl_name_t=
82
  fun n ->
83
    let lower a = String.lowercase_ascii a in
84
    let n = lower_vhdl_name_t n in
85
    match n with
86
    | Selected (a::[]) -> simplify_name_t a
87
    | Selected (NoName::tl) -> simplify_name_t (Selected tl)
88
    | Selected ((Simple (s))::tl) ->  if (lower s = "work")
89
                                      then simplify_name_t (Selected tl)
90
                                      else n
91
    | Selected ((Identifier (s))::tl) -> if (lower s = "work")
92
                                         then simplify_name_t (Selected tl)
93
                                         else n
94
    | _ -> n
95

    
96
let rec to_string_vhdl_name_t : vhdl_name_t -> string=
97
  fun x  ->
98
    match x with
99
    | Simple a -> a
100
    | Identifier a -> a
101
    | Selected a -> String.concat "." (List.map to_string_vhdl_name_t a)
102
    | Index { id; exprs } -> to_string_vhdl_name_t id
103
    | Slice { id; range } -> to_string_vhdl_name_t id
104
    | Attribute { id; designator; expr } -> to_string_vhdl_name_t id
105
    | Function { id; assoc_list } -> to_string_vhdl_name_t id
106
    | NoName  -> "NoName"
107
    | Open -> "Open"
108

    
109
let rec flatten_vhdl_name_t : vhdl_name_t -> vhdl_name_t=
110
  fun x  ->
111
    match x with
112
    | Simple a -> Simple (a)
113
    | Identifier a -> Simple (a)
114
    | Selected (hd::tl) -> Simple (String.concat "__" ((to_string_vhdl_name_t (flatten_vhdl_name_t hd))::[to_string_vhdl_name_t (flatten_vhdl_name_t (Selected (tl)))]))
115
    | _ -> failwith ("Impossible to flatten name value [" ^ to_string_vhdl_name_t x ^ "]")
116

    
117
let postfix_flatten_vhdl_name_t : vhdl_name_t -> string -> vhdl_name_t=
118
  fun x  ->
119
    fun postfix ->
120
      let flattened = flatten_vhdl_name_t x in
121
      match flattened with
122
      | Simple a -> Simple (a ^ postfix)
123
      | Identifier a -> Identifier (a ^ postfix)
124
      | _ -> failwith ("Impossible to postfix name value [" ^ to_string_vhdl_name_t x ^ "]")
125

    
126
let prefix_flatten_vhdl_name_t: string -> vhdl_name_t -> vhdl_name_t=
127
  fun prefix -> fun postfix ->
128
  let flattened_post = flatten_vhdl_name_t postfix in
129
  match flattened_post with
130
  | Simple a -> Simple (prefix^"__"^a)
131
  | Identifier a -> Identifier (prefix^"__"^a)
132
  | _ ->  failwith ("Impossible to prefix name value [" ^ to_string_vhdl_name_t postfix ^ "]")
133
  
134
(*************************
135
 * End vhdl_name_t helpers
136
 *)
(11-11/12)