Source file expression.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
open Js_of_ocaml.Js
open Js_of_ocaml.Js.Unsafe

type t = int

let block wasm_mod name children =
  meth_call wasm_mod "block"
    [|
      inject (string name);
      inject (array (Array.of_list children));
      inject Type.auto;
    |]

let if_ wasm_mod cond if_true if_false =
  meth_call wasm_mod "if" [| inject cond; inject if_true; inject if_false |]

let loop wasm_mod name body =
  meth_call wasm_mod "loop" [| inject (string name); inject body |]

let break wasm_mod name cond res =
  meth_call wasm_mod "br" [| inject (string name); inject cond; inject res |]

let switch wasm_mod names default_name cond value =
  meth_call wasm_mod "switch"
    [|
      inject (array (Array.of_list (List.map string names)));
      inject (string default_name);
      inject cond;
      inject value;
    |]

let call wasm_mod name params return_typ =
  meth_call wasm_mod "call"
    [|
      inject (string name);
      inject (array (Array.of_list params));
      inject return_typ;
    |]

let call_indirect wasm_mod target params params_typ return_typ =
  meth_call wasm_mod "call_indirect"
    [|
      inject target;
      inject (array (Array.of_list params));
      inject params_typ;
      inject return_typ;
    |]

let return_call wasm_mod name params return_typ =
  meth_call wasm_mod "return_call"
    [|
      inject (string name);
      inject (array (Array.of_list params));
      inject return_typ;
    |]

let return_call_indirect wasm_mod target params params_typ return_typ =
  meth_call wasm_mod "return_call_indirect"
    [|
      inject target;
      inject (array (Array.of_list params));
      inject params_typ;
      inject return_typ;
    |]

let local_get wasm_mod slot typ =
  let scope = get wasm_mod "local" in
  meth_call scope "get" [| inject slot; inject typ |]

let local_set wasm_mod slot value =
  let scope = get wasm_mod "local" in
  meth_call scope "set" [| inject slot; inject value |]

let local_tee wasm_mod slot value typ =
  let scope = get wasm_mod "local" in
  meth_call scope "tee" [| inject slot; inject value; inject typ |]

let global_get wasm_mod name typ =
  let scope = get wasm_mod "global" in
  meth_call scope "get" [| inject (string name); inject typ |]

let global_set wasm_mod name value =
  let scope = get wasm_mod "global" in
  meth_call scope "set" [| inject (string name); inject value |]

let load wasm_mod byts offset align typ ptr =
  meth_call global##.binaryen "_BinaryenLoad"
    [|
      inject wasm_mod;
      inject byts;
      inject offset;
      inject align;
      inject typ;
      inject ptr;
    |]

let store wasm_mod byts offset align ptr value typ =
  meth_call global##.binaryen "_BinaryenStore"
    [|
      inject wasm_mod;
      inject byts;
      inject offset;
      inject align;
      inject ptr;
      inject value;
      inject typ;
    |]

let const wasm_mod lit =
  let lit_hack = Literal.to_jsoo lit in
  match lit_hack with
  | Int32 value ->
      let scope = get wasm_mod "i32" in
      meth_call scope "const" [| inject value |]
  | Int64 value ->
      let scope = get wasm_mod "i64" in
      meth_call scope "const" [| inject value |]
  | Float32Bits value ->
      let scope = get wasm_mod "f32" in
      meth_call scope "const_bits" [| inject value |]
  | Float64Bits value ->
      let scope = get wasm_mod "f64" in
      meth_call scope "const_bits" [| inject value |]
  | Float32 value ->
      let scope = get wasm_mod "f32" in
      (* TODO: Investigate if this needs the Int32 conversion stuff *)
      meth_call scope "const" [| inject value |]
  | Float64 value ->
      let scope = get wasm_mod "f64" in
      meth_call scope "const" [| inject value |]

let unary wasm_mod op p =
  meth_call global##.binaryen "_BinaryenUnary"
    [| inject wasm_mod; inject op; inject p |]

let binary wasm_mod op a b =
  meth_call global##.binaryen "_BinaryenBinary"
    [| inject wasm_mod; inject op; inject a; inject b |]

let select wasm_mod cond if_true if_false =
  meth_call wasm_mod "select"
    [| inject cond; inject if_true; inject if_false; inject Type.auto |]

let drop wasm_mod value = meth_call wasm_mod "drop" [| inject value |]

let return wasm_mod value = meth_call wasm_mod "return" [| inject value |]

let nop wasm_mod = meth_call wasm_mod "nop" [||]

let unreachable wasm_mod = meth_call wasm_mod "unreachable" [||]

let memory_copy wasm_mod dest source size =
  let scope = get wasm_mod "memory" in
  meth_call scope "copy" [| inject dest; inject source; inject size |]

let memory_fill wasm_mod dest value size =
  let scope = get wasm_mod "memory" in
  meth_call scope "fill" [| inject dest; inject value; inject size |]

let tuple_make wasm_mod operands =
  let scope = get wasm_mod "tuple" in
  meth_call scope "make" [| inject (array (Array.of_list operands)) |]

let tuple_extract wasm_mod tuple index =
  let scope = get wasm_mod "tuple" in
  meth_call scope "extract" [| inject tuple; inject index |]

let pop wasm_mod typ =
  meth_call global##.binaryen "_BinaryenPop" [| inject wasm_mod; inject typ |]

(* TODO: Figure this out *)
let null () = Obj.magic ()

let print expr =
  let text = meth_call global##.binaryen "emitText" [| inject expr |] in
  print_string (to_string text)