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
open Type
open Wasm.Sexpr
let ($$) head inner = Node (head, inner)
let control = function
| Returns -> "Returns"
| Promises -> "Promises"
| Replies -> "Replies"
let obj_sort = function
| Object -> Atom "Object"
| Actor -> Atom "Actor"
| Module -> Atom "Module"
| Memory -> Atom "Memory"
let func_sort = function
| Local -> "Local"
| Shared Write -> "Shared"
| Shared Query -> "Shared Query"
| Shared Composite -> "Shared Composite"
let prim = function
| Null -> Atom "Null"
| Bool -> Atom "Bool"
| Nat -> Atom "Nat"
| Nat8 -> Atom "Nat8"
| Nat16 -> Atom "Nat16"
| Nat32 -> Atom "Nat32"
| Nat64 -> Atom "Nat64"
| Int -> Atom "Int"
| Int8 -> Atom "Int8"
| Int16 -> Atom "Int16"
| Int32 -> Atom "Int32"
| Int64 -> Atom "Int64"
| Float -> Atom "Float"
| Char -> Atom "Char"
| Text -> Atom "Text"
| Blob -> Atom "Blob"
| Error -> Atom "Error"
| Principal -> Atom "Principal"
| Region -> Atom "Region"
let con c = Atom (Type.string_of_con c)
let rec typ = function
| Var (s, i) -> "Var" $$ [Atom s; Atom (string_of_int i)]
| Con (c, ts) -> "Con" $$ (con c::List.map typ ts)
| Prim p -> "Prim" $$ [prim p]
| Obj (s, tfs) -> "Obj" $$ [obj_sort s] @ List.map typ_field tfs
| Array t -> "Array" $$ [typ t]
| Opt t -> "Opt" $$ [typ t]
| Variant tfs -> "Variant" $$ List.map typ_field tfs
| Tup ts -> "Tup" $$ List.map typ ts
| Func (s, c, tbs, at, rt) ->
"Func" $$ [Atom (func_sort s); Atom (control c)] @
List.map typ_bind tbs @ [ "" $$ (List.map typ at); "" $$ (List.map typ rt)]
| Async (Fut, t1, t2) -> "Async" $$ [typ t1; typ t2]
| Async (Cmp, t1, t2) -> "Async*" $$ [typ t1; typ t2]
| Mut t -> "Mut" $$ [typ t]
| Any -> Atom "Any"
| Non -> Atom "Non"
| Pre -> Atom "Pre"
| Typ c -> "Typ" $$ [con c]
and typ_bind (tb : Type.bind) =
tb.var $$ [typ tb.bound]
and typ_field (tf : Type.field) =
tf.lab $$ [typ tf.typ]