1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
open Base
let validate_circuit_against_interface
(type i)
(module I : Interface.S_Of_signal with type Of_signal.t = i)
circuit
=
let circuit_inputs =
Circuit.inputs circuit
|> List.map ~f:(fun s -> Signal.names s |> List.hd_exn)
|> Set.of_list (module String)
in
let interface_inputs = Set.of_list (module String) I.Names_and_widths.port_names in
let input_ports_in_circuit_but_not_interface =
Set.diff circuit_inputs interface_inputs
in
let circuit_name = Circuit.name circuit in
if not (Set.is_empty input_ports_in_circuit_but_not_interface)
then
raise_s
[%message
"Error while instantiating module hierarchy"
(circuit_name : string)
(input_ports_in_circuit_but_not_interface : Set.M(String).t)]
;;
let hierarchy
(type i o)
(module I : Interface.S_Of_signal with type Of_signal.t = i)
(module O : Interface.S_Of_signal with type Of_signal.t = o)
?attributes
?config
?instance
db
~name
create_fn
inputs
=
let create_inst = Instantiation.create_with_interface (module I) (module O) in
let create_circuit_exn = Circuit.create_with_interface (module I) (module O) in
let circuit = create_circuit_exn ?config ~name create_fn in
validate_circuit_against_interface (module I) circuit;
let name = Circuit_database.insert db circuit in
create_inst ?instance ?attributes ~name inputs
;;
let create ~scope ~name create_fn inputs =
let scope = Scope.sub_scope scope name in
create_fn scope inputs
;;
let hierarchical
(type i o)
(module I : Interface.S_Of_signal with type Of_signal.t = i)
(module O : Interface.S_Of_signal with type Of_signal.t = o)
?config
?instance
?attributes
~(scope : Scope.t)
~name
create_fn
inputs
=
let hierarchy = hierarchy ?attributes (module I) (module O) in
let instance =
match instance with
| None -> name
| Some name -> name
in
if Scope.flatten_design scope
then create ~scope ~name:instance create_fn inputs
else (
let scope = Scope.sub_scope scope instance in
let instance = Scope.instance scope in
hierarchy
?config
?instance
(Scope.circuit_database scope)
~name
(create_fn scope)
inputs)
;;
let fold circuit database ~init ~f =
let rec fold arg (circuit : Circuit.t) inst =
let arg = f arg (Some circuit) inst in
List.fold (Circuit.instantiations circuit) ~init:arg ~f:(fun arg inst ->
match Circuit_database.find database ~mangled_name:inst.inst_name with
| Some circuit -> fold arg circuit (Some inst)
| None -> f arg None (Some inst))
in
fold init circuit None
;;
let print circuit database =
let rec f level circuit instance_name =
Stdio.printf "%s%s(%s)\n" level (Circuit.name circuit) instance_name;
List.iter (Circuit.instantiations circuit) ~f:(fun inst ->
let next_level = " " ^ level in
match Circuit_database.find database ~mangled_name:inst.inst_name with
| Some circuit -> f next_level circuit inst.inst_instance
| None ->
Stdio.printf
"%s%s(%s) [no implementation]\n"
next_level
inst.inst_name
inst.inst_instance)
in
f "" circuit "top"
;;
module With_interface (I : Interface.S) (O : Interface.S) = struct
let create = hierarchy (module I) (module O)
end
module In_scope (I : Interface.S) (O : Interface.S) = struct
type create = Scope.t -> Interface.Create_fn(I)(O).t
let names s =
try Signal.names s with
| _ -> []
;;
let auto_labelling ~instance ~inputs ~outputs =
Signal_graph.iter
(Signal_graph.create ~upto:(I.to_list inputs) (O.to_list outputs))
~f:(fun s ->
Signal.set_names s (List.map (names s) ~f:(fun n -> instance ^ "$" ^ n)));
outputs
;;
let auto_naming scope = Scope.Naming_scheme.equal (Scope.naming_scheme scope) Auto
let create ~scope ~name create_fn inputs =
let scope = Scope.sub_scope scope name in
let label_ports = Scope.auto_label_hierarchical_ports scope in
let ( -- ) = if auto_naming scope then Signal.( -- ) else Scope.naming scope in
let ( -- ) p s n = Signal.wireof s -- (p ^ Scope.Path.default_path_seperator ^ n) in
let inputs =
if label_ports then I.map2 inputs I.port_names ~f:(( -- ) "i") else inputs
in
let outputs = create_fn scope inputs in
if label_ports then O.map2 outputs O.port_names ~f:(( -- ) "o") else outputs
;;
let hierarchical ?config ?instance ?attributes ~(scope : Scope.t) ~name create_fn inputs
=
let hierarchy = hierarchy ?attributes (module I) (module O) in
let instance =
match instance with
| None -> name
| Some name -> name
in
if Scope.flatten_design scope
then
if auto_naming scope
then
auto_labelling
~instance
~inputs
~outputs:(create ~scope ~name:instance create_fn inputs)
else create ~scope ~name:instance create_fn inputs
else (
let scope = Scope.sub_scope scope instance in
let instance = Scope.instance scope in
hierarchy
?config
?instance
(Scope.circuit_database scope)
~name
(create_fn scope)
inputs)
;;
end