Source file wave.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
open Base
open Hardcaml

type t =
  | Empty of string
  | Clock of string
  | Binary of string * Data.t
  | Data of string * Data.t * Wave_format.t * Text_alignment.t
[@@deriving sexp_of, equal]

module Bits_conv = struct
  open Bits

  let to_hstr b =
    let to_char i =
      Char.of_int_exn (if i < 10 then Char.to_int '0' + i else Char.to_int 'A' + i - 10)
    in
    let blen = width b in
    let slen = (blen + 3) / 4 in
    String.init slen ~f:(fun i ->
      let i = slen - i - 1 in
      let l = i * 4 in
      let h = min blen (l + 4) - 1 in
      to_char (to_int (select b h l)))
  ;;

  (* convert to integer using arbitrary precision. *)
  let to_ustr b =
    let max = 29 in
    (* safe max positive int bits *)
    if width b <= max
    then Int.to_string (to_int b)
    else (
      (* convert with big ints *)
      let rec f b acc =
        let ( +: ) = Big_int.add_big_int in
        let ( <<: ) = Big_int.shift_left_big_int in
        let to_big b = Big_int.big_int_of_int (to_int b) in
        if width b <= max
        then (* result *)
          (acc <<: width b) +: to_big b
        else (
          let t, b = sel_top b max, drop_top b max in
          f b ((acc <<: max) +: to_big t))
      in
      Big_int.(string_of_big_int (f b zero_big_int)))
  ;;

  (* signed conversion uses unsigned conversion with detection of sign *)
  let to_sstr b =
    let max = 29 in
    (* safe max positive int bits *)
    if width b <= max
    then Int.to_string (to_sint b)
    else if to_int (msb b) = 0
    then to_ustr b
    else "-" ^ to_ustr (~:b +:. 1)
  ;;
end

let set_name t n =
  match t with
  | Empty _ -> Empty n
  | Clock _ -> Clock n
  | Binary (_, a) -> Binary (n, a)
  | Data (_, a, b, c) -> Data (n, a, b, c)
;;

let get_name = function
  | Empty n -> n
  | Clock n -> n
  | Binary (n, _) -> n
  | Data (n, _, _, _) -> n
;;

let get_data = function
  | Empty _ -> failwith "no empty data"
  | Clock _ -> failwith "no clock data"
  | Binary (_, d) -> d
  | Data (_, d, _, _) -> d
;;

let get_to_str = function
  | Empty _ -> failwith "no empty to_str"
  | Clock _ -> failwith "no clock to_str"
  | Binary (_, _) -> failwith "no binary to_str"
  | Data (_, _, f, _) ->
    let rec to_f : Wave_format.t -> _ = function
      | Binary -> Bits.to_bstr
      | Bit -> Bits.to_bstr
      | Bit_or t -> to_f t
      | Hex -> Bits_conv.to_hstr
      | Unsigned_int -> Bits_conv.to_ustr
      | Int -> Bits_conv.to_sstr
      | Custom f -> f
      | Index s ->
        fun elt ->
          (try List.nth_exn s (Bits.to_int elt) with
           | _ -> "-")
    in
    to_f f
;;

let get_alignment = function
  | Empty _ -> failwith "no empty get_alignment"
  | Clock _ -> failwith "no clock get_alignment"
  | Binary _ -> failwith "no binary get_alignment"
  | Data (_, _, _, alignment) -> alignment
;;

let get_format : t -> Wave_format.t = function
  | Empty _ -> Binary
  | Clock _ -> Binary
  | Binary _ -> Binary
  | Data (_, _, f, _) -> f
;;