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]