package hardcaml_xilinx_components

  1. Overview
  2. Docs
Hardcaml Xilinx component definitions

Install

Dune Dependency

Authors

Maintainers

Sources

hardcaml_xilinx_components-v0.15.0.tar.gz
sha256=1cf266f90fec2ec7d6053289f4aa9b753d233b29ddc0c9be1e7d19b97b75f3f8

doc/src/hardcaml_xilinx_components.xilinx_vhdl/vhdl_to_hardcaml.ml.html

Source file vhdl_to_hardcaml.ml

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
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
open! Import

(* OCaml keywords that should be avoided *)
let keywords = [ "do"; "done" ]

(* Construct a legal OCaml name from the VHDL name *)
let ocaml_name name =
  let name = String.lowercase name in
  if List.mem keywords name ~equal:String.equal
  then name ^ "_"
  else name

let ocaml_name_ref name = "P." ^ ocaml_name name

let rec expr ?(id = Fn.id) : Vhdl.Expression.t -> string = function
  | Int i        -> Int.to_string i
  | Float i      -> Float.to_string i
  | String s     -> "\"" ^ s ^ "\""
  | Hex s        -> "X\"" ^ s ^ "\""
  | Char s       -> "'" ^ s ^ "'"
  | Id i         -> id i
  | Op (op, a, b) ->
    String.concat
      ["("
      ; (String.concat ~sep:" " [ expr ~id a; op; expr ~id b ])
      ; ")"]
  | Neg a        -> "-" ^ expr a
  | Others c     -> "(others => '" ^ c ^ "')"
  | X01 s        -> "TO_X01(" ^ s ^ ")"

(* signal, port or generic value with relevant OCaml types inferred from
   the VHDL type and/or default value *)
module Inferred_port = struct
  type t =
    { port          : Vhdl.Port.t
    ; ocaml_name    : string
    ; default_type  : string
    ; default_value : string
    ; bits          : string
    ; constr        : string }
  [@@deriving sexp_of]

  (* A generated declaration which will cause a build failure *)
  let not_implemented port =
    { port
    ; ocaml_name    = ocaml_name port.name
    ; default_type  = "not_implemented"
    ; default_value = "not_implemented"
    ; bits          = "0"
    ; constr        = "not_implemented" }

  (* infer ocaml type for std_logic and std_ulogic *)
  let std_logic port =
    let create b =
      { port
      ; ocaml_name    = ocaml_name port.name
      ; default_type  = "Hardcaml.Parameter.Std_logic.t"
      ; default_value = String.concat [ "Hardcaml.Parameter.Std_logic."
                                      ; b |> Parameter.Std_logic.Variants.to_name ]
      ; bits          = "1"
      ; constr        = Hardcaml.Parameter.Value.Variants.std_logic.name }
    in
    let fail () = raise_s [%message "invalid port_std_logic value" (port : Vhdl.Port.t)] in
    match port.default with
    | None -> create U
    | Some e ->
      match e with
      | X01 _ -> create L0
      | Char c when String.length c = 1 ->
        (match Parameter.Std_logic.of_char_exn c.[0] with
         | c -> create c
         | exception _ -> fail ())
      | Char _
      | Float _
      | Hex _
      | Id _
      | Int _
      | Neg _
      | Op _
      | Others _
      | String _
        -> fail ()

  (* infer ocaml type for boolean *)
  let boolean port =
    let create b =
      { port
      ; ocaml_name    = ocaml_name port.name
      ; default_type  = "bool"
      ; default_value = b
      ; bits          = "1"
      ; constr        = Hardcaml.Parameter.Value.Variants.bool.name }
    in
    match port.default with
    | Some (Id s) -> (
        match String.lowercase s with
        | "true"  -> create "true"
        | "false" -> create "false"
        | _ -> failwith "port_boolean: invalid default value")
    | None   -> create "false"
    | Some x -> failwith ("port_boolean: invalid default type " ^ expr x)

  (* infer ocaml type for real *)
  let real port =
    let create default_value =
      { port
      ; ocaml_name    = ocaml_name port.name
      ; default_type  = "float"
      ; default_value
      ; bits          = "0"
      ; constr        = Hardcaml.Parameter.Value.Variants.real.name }
    in
    match port.default with
    | Some (Float f) -> create (Float.to_string f)
    | None           -> create "0."
    | _              -> failwith "port_real"

  (* infer ocaml type for integer *)
  let integer port =
    let create default_value =
      { port
      ; ocaml_name    = ocaml_name port.name
      ; default_type  = "int"
      ; default_value
      ; bits          = "0"
      ; constr        = Hardcaml.Parameter.Value.Variants.int.name }
    in
    match port.default with
    | Some (Int i) -> create (Int.to_string i)
    | None         -> create "0"
    | _            -> failwith "port_integer"

  (* infer ocaml type for string *)
  let string port =
    let create default_value =
      { port
      ; ocaml_name    = ocaml_name port.name
      ; default_type  = "string"
      ; default_value
      ; bits          = "0"
      ; constr        = Hardcaml.Parameter.Value.Variants.string.name }
    in
    match port.default with
    | Some (String s) -> create ("\"" ^ s ^ "\"")
    | _ -> failwith "port_string"

  (* infer ocaml type for std_logic_vector, bit_vector port *)
  let vector port (range : Vhdl.Range.t option) =
    let create bits = { (not_implemented port) with bits } in
    match range with
    | None -> failwith "port_vector: width cant be found"
    | Some (a, d, b) ->
      let hi, lo =
        match d with
        | Down -> a, b
        | Up   -> b, a in
      create (sprintf "((%s) - (%s) + 1)"
                (expr hi ~id:ocaml_name_ref)
                (expr lo ~id:ocaml_name_ref))

  (* infer ocaml type for std_logic_vector, bit_vector generic.  This is a bit more
     complex as the width may need to be inferred from the default value. *)
  let generic_vector port (range : Vhdl.Range.t option) ~is_bitvector =
    let create_std_logic_vector bits value =
      { port
      ; ocaml_name    = ocaml_name port.name
      ; default_type  = "Hardcaml.Parameter.Std_logic_vector.t"
      ; default_value = "Hardcaml.Parameter.Std_logic_vector.of_string" ^ value
      ; bits
      ; constr        = Hardcaml.Parameter.Value.Variants.std_logic_vector.name }
    in
    let create_bit_vector bits value =
      { port
      ; ocaml_name    = ocaml_name port.name
      ; default_type  = "Hardcaml.Parameter.Bit_vector.t"
      ; default_value = "Hardcaml.Parameter.Bit_vector.of_string " ^ value
      ; bits
      ; constr        = Hardcaml.Parameter.Value.Variants.bit_vector.name }
    in
    let create =
      if is_bitvector
      then create_bit_vector
      else create_std_logic_vector
    in
    let get_default = function
      | None -> Some ("default_vector", 0)
      | Some expr ->
        let rec f : Vhdl.Expression.t -> string option = function
          | String s -> Some s
          | Hex s ->
            let width = String.length s * 4 in
            Some (Hardcaml.Constant.of_hex_string ~signedness:Signed ~width s
                  |> Hardcaml.Constant.to_binary_string)
          | Op ("&", a, b) -> Option.map2 (f a) (f b) ~f:(^)
          | _ -> None
        in
        Option.map (f expr) ~f:(fun s ->
          "\"" ^ s ^ "\"", String.length s)
    in
    let default_value, default_bits =
      Option.value (get_default port.default) ~default:("unknown_vector", 0)
    in
    match range with
    | None -> create (Int.to_string default_bits) default_value
    | Some (a, d, b) ->
      let hi, lo =
        match d with
        | Down -> a, b
        | Up   -> b, a in
      create
        (sprintf "((%s) - (%s) + 1)"
           (expr hi ~id:ocaml_name_ref)
           (expr lo ~id:ocaml_name_ref))
        default_value

  (* Perform VHDL to OCaml (adhoc) type inference *)
  let create (port : Vhdl.Port.t) ~is_generic =
    match port.type_ with
    | Std_logic | Bit         -> std_logic port
    | Boolean                 -> boolean   port
    | Real    when is_generic -> real      port
    | Integer when is_generic -> integer   port
    | String  when is_generic -> string    port
    | Std_logic_vector range  ->
      if is_generic
      then generic_vector port range ~is_bitvector:false
      else vector         port range
    | Bit_vector range ->
      if is_generic
      then generic_vector port range ~is_bitvector:true
      else vector         port range
    | _                          -> not_implemented port
end

let vhdl_component_to_ocaml_module (comp : Vhdl.Component.t) =
  let generics = List.map comp.generics ~f:(Inferred_port.create ~is_generic:true) in
  let lines = String.concat ~sep:"\n" in
  let default_types =
    lines (
      List.map generics ~f:(fun param ->
        sprintf "    val %s : %s"
          param.ocaml_name param.default_type))
  in
  let default_values =
    lines (
      List.map generics ~f:(fun param ->
        sprintf "    let %s = %s"
          param.ocaml_name param.default_value))
  in
  let ocaml_params =
    lines (
      List.map generics ~f:(fun param ->
        sprintf "      Hardcaml.Parameter.create ~name:\"%s\" ~value:(%s P.%s);"
          param.port.name param.constr param.ocaml_name))
  in
  let header =
    String.concat [ "\
module ";String.capitalize comp.name;" = struct
  module type P = sig
";default_types;"
  end
  module P : P = struct
";default_values;"
  end
  module Make (P : P) = struct
    let params = [
";ocaml_params;"
    ]
" ] in
  let interface mod_name dir =
    let ports =
      List.filter comp.ports ~f:(fun port -> Vhdl.Port_direction.equal port.dir dir) in
    let ports = List.map ports ~f:(Inferred_port.create ~is_generic:false) in
    match ports with
    | [] -> String.concat ["    module ";mod_name;" = Hardcaml.Interface.Empty\n"]
    | _  ->
      let ocaml_ports =
        lines (
          List.map ports ~f:(fun port ->
            sprintf "        %s : 'a[@bits %s][@rtlname \"%s\"];"
              port.ocaml_name port.bits port.port.name))
      in
      String.concat ["
    module ";mod_name;" = struct
      type 'a t = {
";ocaml_ports;"
      }[@@deriving sexp_of, hardcaml]
    end
"]
  in
  String.concat
    [ header
    ; interface "I" In
    ; interface "O" Out
    ; interface "T" Inout
    ; "\

    open struct include Hardcaml.Instantiation.With_interface(I)(O) end
    let create ?lib ?arch ?attributes ?instance ?(name=\"";comp.name;"\") inputs =
      create ?lib ?arch ?instance ?attributes ~parameters:params ~name inputs
  end
end

"]
OCaml

Innovation. Community. Security.