package archetype

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file parseTree.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
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
(* -------------------------------------------------------------------- *)
open Ident
open Location

(* -------------------------------------------------------------------- *)

let pp_lident fmt i = Format.fprintf fmt "%s" (unloc i)

type lident = ident loced
[@@deriving yojson, show {with_path = false}]

(* -------------------------------------------------------------------- *)
and container =
  | Aggregate
  | Partition
  | View

and type_r =
  | Tref                 of lident
  | Tcontainer           of type_t * container
  | Ttuple               of type_t list
  | Toption              of type_t
  | Tset                 of type_t
  | Tlist                of type_t
  | Tmap                 of type_t * type_t
  | Tbig_map             of type_t * type_t
  | Tor                  of type_t * type_t
  | Tlambda              of type_t * type_t
  | Tcontract            of type_t
  | Tkeyof               of type_t
  | Tticket              of type_t
  | Tsapling_state       of Core.big_int
  | Tsapling_transaction of Core.big_int

and type_t = type_r loced * lident option

(* -------------------------------------------------------------------- *)
and logical_operator =
  | And
  | Or
  | Xor
  | Imply
  | Equiv

and comparison_operator =
  | Equal
  | Nequal
  | Gt
  | Ge
  | Lt
  | Le

and arithmetic_operator =
  | Plus
  | Minus
  | Mult
  | DivRat
  | DivEuc
  | Modulo
  | DivMod
  | ThreeWayCmp
  | ShiftLeft
  | ShiftRight

and unary_operator =
  | Uminus
  | Not

and assignment_operator =
  | ValueAssign
  | PlusAssign
  | MinusAssign
  | MultAssign
  | DivAssign
  | AndAssign
  | OrAssign

and quantifier =
  | Forall
  | Exists

and operator =
  | Logical of logical_operator
  | Cmp     of comparison_operator
  | Arith   of arithmetic_operator
  | Unary   of unary_operator

type pattern_unloc =
  | Pwild
  | Pref of pname loced * lident list

and pname =
  | PIdent of ident
  | PCons
  | PNil
  | PSome
  | PNone
  | PLeft
  | PRight

and pattern = pattern_unloc loced

and var_label = VLBefore | VLIdent of lident

and var_vset  = VSAdded | VSUnmoved | VSRemoved

and for_ident_unloc = FIsimple of lident | FIdouble of lident * lident
and for_ident = for_ident_unloc loced

and transfer_t =
  | TTsimple    of expr * expr
  | TTcontract  of expr * expr * lident * type_t * expr
  | TTentry     of expr * lident * expr
  | TTself      of expr * lident * expr list
  | TToperation of expr

and expr_unloc =
  | Eterm          of (var_vset option * var_label option) * lident
  | Eliteral       of literal
  | Earray         of expr list
  | Erecord        of record_item list
  | Etuple         of expr list
  | Edot           of expr * lident
  | Esqapp         of expr * expr
  | Emulticomp     of expr * (comparison_operator loced * expr) list
  | Eapp           of function_ * expr list
  | Eappt          of function_ * type_t list * expr list
  | Emethod        of expr * lident * expr list
  | Etransfer      of transfer_t
  | Edorequire     of expr * expr
  | Edofailif      of expr * expr
  | Efail          of expr
  | Eassign        of assignment_operator * expr * expr
  | Eif            of expr * expr * expr option
  | Efor           of lident option * for_ident * expr * expr
  | Eiter          of lident option * lident * expr option * expr * expr
  | Ewhile         of lident option * expr * expr
  | Eseq           of expr * expr
  | Eletin         of lident * type_t option * expr * expr * expr option
  | Evar           of lident * type_t option * expr
  | Ematchwith     of expr * branch list
  | Efold          of expr * lident * expr
  | Emap           of expr * lident * expr
  | Erecupdate     of expr * (lident * expr) list
  | Equantifier    of quantifier * lident * quantifier_kind * expr
  | Eassert        of lident
  | Elabel         of lident
  | Ereturn        of expr
  | Eoption        of option_
  | Eor            of or_
  | Elambda        of type_t option * lident * type_t option * expr
  | Eentrypoint    of type_t * expr * expr * expr option
  | Ecallview      of type_t * expr * expr * expr
  | Eunpack        of type_t * expr
  | Eself          of lident
  | Eany
  | Enothing
  | Eunit
  | Einvalid

and branch = (pattern list * expr)

and scope =
  | Added
  | After
  | Before
  | Fixed
  | Removed
  | Stable

and quantifier_kind =
  | Qcollection of expr
  | Qtype of type_t

and option_ =
  | OSome of expr
  | ONone of type_t option

and or_ =
  | Oleft  of type_t option * type_t * expr
  | Oright of type_t * type_t option * expr

and function_ =
  | Fident of lident
  | Foperator of operator loced

and literal =
  | Lint      of Core.big_int
  | Lnat      of Core.big_int
  | Ldecimal  of string
  | Ltz       of string
  | Lmtz      of string
  | Lutz      of string
  | Laddress  of string
  | Lstring   of string
  | Lbool     of bool
  | Lduration of string
  | Ldate     of string
  | Lbytes    of string
  | Lpercent  of string

and record_item = (assignment_operator * lident) option * expr

and expr = expr_unloc loced

and lident_typ = lident * type_t * extension list option

and label_expr = (lident * expr) loced

and label_exprs = label_expr list

(* -------------------------------------------------------------------- *)
and extension_unloc =
  | Eextension of lident * expr list (** extension *)

and extension = extension_unloc loced

and exts = extension list option

(* -------------------------------------------------------------------- *)
and field_unloc =
  | Ffield of lident * type_t * expr option * exts   (** field *)

and field = field_unloc loced

and args = lident_typ list

and invariants = (lident * expr list) list

and specification_item_unloc =
  | Vpredicate     of lident * args * expr
  | Vdefinition    of lident * type_t * lident * expr
  | Vvariable      of lident * type_t * expr option
  | Veffect        of expr
  | Vassert        of (lident * expr * invariants * lident list)
  | Vfails         of (lident * lident option * lident * type_t * expr) list
  | Vpostcondition of (lident * expr * invariants * lident list * postkind option)

and postkind = PKPost | PKInv

and specification_item = specification_item_unloc loced

and specification_unloc = specification_item list * exts

and specification = specification_unloc loced

and security_arg_unloc =
  | Sident of lident
  | Sdot   of lident * lident
  | Slist  of security_arg list
  | Sapp   of lident * security_arg list
  | Sbut   of lident * security_arg
  | Sto    of lident * security_arg

and security_arg = security_arg_unloc loced

and security_item_unloc = lident * lident * security_arg list

and security_item = security_item_unloc loced

and security_unloc = security_item list * exts

and security = security_unloc loced

and s_function = {
  name  : lident;
  args  : args;
  ret_t : type_t option;
  spec  : specification option;
  body  : expr;
  getter: bool;
  view  : bool;
}

and entry_properties = {
  accept_transfer : bool;
  sourcedby       : (expr * exts) option;
  calledby        : (expr * exts) option;
  state_is        : lident option;
  require         : ((lident * expr * expr option) list * exts) option;
  failif          : ((lident * expr * expr option) list * exts) option;
  spec_fun        : specification option;
  functions       : (s_function loced) list;
}

and transition = (lident * (expr * exts) option * (expr * exts) option) list

and parameter = (lident * type_t * expr option * bool) loced

and parameters = parameter list loced option

and metadata =
| Muri  of string loced
| Mjson of string loced

(* -------------------------------------------------------------------- *)
and variable_kind =
  | VKvariable
  | VKconstant

and enum_kind =
  | EKenum of lident
  | EKstate

(* -------------------------------------------------------------------- *)
and declaration_unloc =
  | Darchetype     of lident * parameters * metadata option * exts
  | Dvariable      of variable_decl
  | Denum          of enum_kind * enum_decl
  | Dasset         of asset_decl
  | Drecord        of record_decl
  | Dentry         of entry_decl
  | Dtransition    of transition_decl
  | Dextension     of extension_decl
  | Dnamespace     of namespace_decl
  | Dfunction      of s_function
  | Dspecification of specification
  | Dspecasset     of (lident * label_exprs)
  | Dspecfun       of specfun
  | Dspecvariable  of (lident * label_exprs)
  | Dsecurity      of security
  | Dtype          of lident * type_t
  | Dinvalid

and specfun_kind =
  | SKentry
  | SKfunction
  | SKgetter
  | SKview

and specfun = specfun_kind * lident * args * specification

and variable_decl =
  lident
  * type_t
  * expr option
  * variable_kind
  * label_exprs
  * exts

and enum_decl =
  (lident * type_t list * enum_option list) list * exts

and asset_decl =
  lident
  * field list
  * field list (* shadow fields *)
  * asset_option list
  * asset_post_option list
  * asset_operation option
  * exts

and record_decl =
  lident
  * field list
  * expr option
  * exts

and entry_decl =
  lident
  * args
  * entry_properties
  * (expr * exts) option
  * exts

and transition_decl =
  lident
  * args
  * (lident * type_t) option
  * expr
  * entry_properties
  * transition
  * exts

and extension_decl =
  lident * expr list

and namespace_decl =
  lident * declaration list

and asset_option =
  | AOidentifiedby of lident list
  | AOsortedby of lident
  | AOtoBigMap

and asset_post_option =
  | APOstates of lident
  | APOconstraints of label_exprs
  | APOinit of expr list

and enum_option =
  | EOinitial
  | EOspecification of label_exprs

and declaration = declaration_unloc loced

and asset_operation_enum =
  | AOadd
  | AOremove
  | AOupdate

and asset_operation =
  | AssetOperation of asset_operation_enum list * expr option

(* -------------------------------------------------------------------- *)
and archetype_unloc =
  | Marchetype of declaration list
  | Mextension of lident * declaration list * declaration list

and archetype = archetype_unloc loced
[@@deriving yojson, show {with_path = false},
            visitors { variety = "map"; ancestors = ["location_map"; "ident_map"] },
            visitors { variety = "iter"; ancestors = ["location_iter"; "ident_iter"] },
            visitors { variety = "reduce"; ancestors = ["location_reduce"; "ident_reduce"] },
            visitors { variety = "reduce2"; ancestors = ["location_reduce2"; "ident_reduce2"] }
    ]

(* -------------------------------------------------------------------- *)

(* types *)

let tref ?(loc=dummy) ?a vt : type_t = (mkloc loc (Tref (mkloc loc vt))), a

let tunit      = tref "unit"
let tstring    = tref "string"
let tnat       = tref "nat"
let tint       = tref "int"
let trational  = tref "rational"
let tbool      = tref "bool"
let trole      = tref "role"
let taddress   = tref "address"
let tdate      = tref "date"
let ttez       = tref "tez"
let tduration  = tref "duration"
let tsignature = tref "signature"
let tkey       = tref "key"
let tkey_hash  = tref "key_hash"
let tbytes     = tref "bytes"
let tchain_id  = tref "chain_id"
let toperation = tref "operation"
let toperation = tref "operation"
let tbls12_381_fr = tref "bls12_381_fr"
let tbls12_381_g1 = tref "bls12_381_g1"
let tbls12_381_g2 = tref "bls12_381_g2"
let tnever        = tref "never"
let tchest        = tref "chest"
let tchest_key    = tref "chest_key"

let mk_tcontainer ?(loc=dummy) ?a t c : type_t =
  mkloc loc (Tcontainer (t, c)), a

let mk_ttuple ?(loc=dummy) ?a l : type_t =
  mkloc loc (Ttuple l), a

let mk_toption ?(loc=dummy) ?a t : type_t =
  mkloc loc (Toption t), a

let mk_tset ?(loc=dummy) ?a t : type_t =
  mkloc loc (Tset t), a

let mk_tlist ?(loc=dummy) ?a t : type_t =
  mkloc loc (Tlist t), a

let mk_tmap ?(loc=dummy) ?a k v : type_t =
  mkloc loc (Tmap (k, v)), a

let mk_tor ?(loc=dummy) ?a k v : type_t =
  mkloc loc (Tor (k, v)), a

let mk_tcontract ?(loc=dummy) ?a t : type_t =
  mkloc loc (Tcontract t), a

let mk_tkeyof ?(loc=dummy) ?a t : type_t =
  mkloc loc (Tkeyof t), a

let mk_tticket ?(loc=dummy) ?a t : type_t =
  mkloc loc (Tticket t), a

let mk_sapling_state ?(loc=dummy) ?a n : type_t =
  mkloc loc (Tsapling_state n), a

let mk_sapling_transaction ?(loc=dummy) ?a n : type_t =
  mkloc loc (Tsapling_transaction n), a


(* expressions *)

let mk_eliteral ?(loc=dummy) l =
  mkloc loc (Eliteral l)

let ebint n = mk_eliteral (Lint n)
let eint  n = ebint (Big_int.big_int_of_int n)

let ebnat n = mk_eliteral (Lnat n)
let enat  n = ebnat (Big_int.big_int_of_int n)

let ebtz n = mk_eliteral (Ltz n)

let emtz n = mk_eliteral (Lmtz n)

let eutz n = mk_eliteral (Lutz n)

let epercent n = mk_eliteral (Lpercent n)

let etrue = mk_eliteral (Lbool true)
let efalse = mk_eliteral (Lbool false)

let edecimal  v = mk_eliteral (Ldecimal v)
let eaddress  v = mk_eliteral (Laddress v)
let estring   v = mk_eliteral (Lstring v)
let eduration v = mk_eliteral (Lduration v)
let edate     v = mk_eliteral (Ldate v)
let ebytes    v = mk_eliteral (Lbytes v)

let eterm         ?(loc=dummy) ?temp ?delta id    = mkloc loc (Eterm ((delta, temp), id))
let earray        ?(loc=dummy) l                  = mkloc loc (Earray l)
let erecord       ?(loc=dummy) rl                 = mkloc loc (Erecord rl)
let etuple        ?(loc=dummy) l                  = mkloc loc (Etuple l)
let edot          ?(loc=dummy) e id               = mkloc loc (Edot (e, id))
let esqapp        ?(loc=dummy) e i                = mkloc loc (Esqapp (e, i))
let emulticomp    ?(loc=dummy) e l                = mkloc loc (Emulticomp(e, l))
let eapp          ?(loc=dummy) f e                = mkloc loc (Eapp(f, e))
let emethod       ?(loc=dummy) e id args          = mkloc loc (Emethod(e, id, args))
let etransfer     ?(loc=dummy) t                  = mkloc loc (Etransfer t)
let edorequire    ?(loc=dummy) e f                = mkloc loc (Edorequire(e, f))
let edofailif     ?(loc=dummy) e f                = mkloc loc (Edofailif (e, f))
let efail         ?(loc=dummy) e                  = mkloc loc (Efail e)
let eassign       ?(loc=dummy) op e v             = mkloc loc (Eassign(op, e, v))
let eif           ?(loc=dummy) ?e c t             = mkloc loc (Eif(c, t, e))
let efor          ?(loc=dummy) ?lbl id c b        = mkloc loc (Efor(lbl, id, c, b))
let eiter         ?(loc=dummy) ?lbl ?min id max e = mkloc loc (Eiter(lbl, id, min, max, e))
let ewhile        ?(loc=dummy) ?lbl c b           = mkloc loc (Ewhile(lbl, c, b))
let eseq          ?(loc=dummy) e1 e2              = mkloc loc (Eseq(e1, e2))
let eletin        ?(loc=dummy) ?t ?o id v b       = mkloc loc (Eletin(id, t, v, b, o))
let evar          ?(loc=dummy) ?t id e            = mkloc loc (Evar(id, t, e))
let ematchwith    ?(loc=dummy) e l                = mkloc loc (Ematchwith(e, l))
let erecupdate    ?(loc=dummy) e l                = mkloc loc (Erecupdate(e, l))
let equantifier   ?(loc=dummy) q id qk e          = mkloc loc (Equantifier(q, id, qk, e))
let eassert       ?(loc=dummy) id                 = mkloc loc (Eassert id)
let elabel        ?(loc=dummy) id                 = mkloc loc (Elabel id)
let ereturn       ?(loc=dummy) e                  = mkloc loc (Ereturn e)
let eoption       ?(loc=dummy) e                  = mkloc loc (Eoption e)
let eleft         ?(loc=dummy) t e                = mkloc loc (Eor (Oleft (None, t, e)))
let eright        ?(loc=dummy) t e                = mkloc loc (Eor (Oright (t, None, e)))
let eentrypoint   ?(loc=dummy) t e v b            = mkloc loc (Eentrypoint (t, e, v, b))
let eunpack       ?(loc=dummy) t e                = mkloc loc (Eunpack (t, e))
let eself         ?(loc=dummy) id                 = mkloc loc (Eself id)
let eany          ?(loc=dummy) _                  = mkloc loc (Eany)
let enothing      ?(loc=dummy) _                  = mkloc loc (Enothing)
let einvalid      ?(loc=dummy) _                  = mkloc loc (Einvalid)

(* declarations utils *)

let mk_s_function name args ret_t spec body getter view : s_function =
  {name; args; ret_t; spec; body; getter; view}

let mk_entry_properties ?(accept_transfer = true) ?sourcedby ?calledby ?state_is ?require ?failif ?spec_fun ?(functions = []) _ : entry_properties =
  { accept_transfer; sourcedby; calledby; state_is; require; failif; spec_fun; functions }

let mk_transition_item id eexto eexts : lident * (expr * exts) option * (expr * exts) option = id, eexto, eexts

let mk_variable_decl ?dv ?(le=[]) ?exts id t vk : variable_decl = id, t, dv, vk, le, exts

let mk_enum_decl ?exts l : enum_decl = l, exts

let mk_asset_decl ?(fs=[]) ?(sfs=[]) ?(aos=[]) ?(apos=[]) ?ao ?exts id : asset_decl = id, fs, sfs, aos, apos, ao, exts

let mk_record_decl ?(fs=[]) ?pos ?exts id : record_decl = id, fs, pos, exts

let mk_entry_decl ?(args=[]) ?body ?exts id ep : entry_decl = id, args, ep, body, exts

let mk_transition_decl ?(args=[]) ?te ?(trs=[]) ?exts id body ep : transition_decl = id, args, te, body, ep, trs, exts

let mk_extension_decl ?(es=[]) id : extension_decl = id, es

let mk_namespace_decl ?(ds=[]) id : namespace_decl = id, ds

let mk_asset_option_identifiedby ids = AOidentifiedby ids
let mk_asset_option_sortedby id      = AOsortedby id
let mk_asset_option_to_big_map       = AOtoBigMap

let mk_asset_post_option_states id      = APOstates id
let mk_asset_post_option_constraints ls = APOconstraints ls
let mk_asset_post_option_init l         = APOinit l

let mk_enum_option_initial _        = EOinitial
let mk_enum_option_specification ls = EOspecification ls

let mk_assetoperation aoes e : asset_operation = AssetOperation (aoes, e)



(* declarations *)

let mk_darchetype ?parameters ?metadata ?exts ?(loc=dummy) id =
  mkloc loc (Darchetype (id, parameters, metadata, exts))

let mk_variable ?(loc=dummy) vd =
  mkloc loc (Dvariable vd)

let mk_enum ?(loc=dummy) ek ed =
  mkloc loc (Denum (ek, ed))

let mk_asset ?(loc=dummy) ad =
  mkloc loc (Dasset ad)

let mk_record ?(loc=dummy) rd =
  mkloc loc (Drecord rd)

let mk_entry ?(loc=dummy) ed =
  mkloc loc (Dentry ed)

let mk_transition ?(loc=dummy) td =
  mkloc loc (Dtransition td)

let mk_extension ?(loc=dummy) ed =
  mkloc loc (Dextension ed)

let mk_namespace ?(loc=dummy) nd =
  mkloc loc (Dnamespace nd)

let mk_function ?(loc=dummy) sf =
  mkloc loc (Dfunction sf)

let mk_specification ?(loc=dummy) s =
  mkloc loc (Dspecification s)

let mk_specasset ?(loc=dummy) id ls =
  mkloc loc (Dspecasset (id, ls))

let mk_specfun ?(loc=dummy) sf id args s =
  mkloc loc (Dspecfun (sf, id, args, s))

let mk_specvariable ?(loc=dummy) id ls =
  mkloc loc (Dspecvariable (id, ls))

let mk_security ?(loc=dummy) s =
  mkloc loc (Dsecurity s)

let mk_dtype ?(loc=dummy) id t =
  mkloc loc (Dtype (id, t))

let mk_invalid ?(loc=dummy) () =
  mkloc loc Dinvalid

let mk_archetype ?(decls=[]) ?(loc=dummy) () =
  mkloc loc (Marchetype decls)

(* -------------------------------------------------------------------- *)

let cst_now         = "now"
let cst_transferred = "transferred"
let cst_caller      = "caller"
let cst_balance     = "balance"
let cst_source      = "source"
let cst_selfaddress = "selfaddress"
let cst_chainid     = "chainid"
let cst_metadata    = "metadata"
let cst_level       = "level"


(* utils *)

let get_name = function
  | Darchetype  _                      -> "archetype"
  | Dvariable (id, _, _, _, _, _)      -> unloc id
  | Denum (EKenum id, _)               -> unloc id
  | Denum (EKstate, _)                 -> "_state"
  | Dasset (id, _, _, _, _, _, _)      -> unloc id
  | Drecord (id, _, _, _)              -> unloc id
  | Dentry (id, _, _, _, _)            -> unloc id
  | Dtransition (id, _, _, _, _, _, _) -> unloc id
  | Dextension (id, _)                 -> unloc id
  | Dnamespace (id, _)                 -> unloc id
  | Dfunction fs                       -> unloc fs.name
  | Dspecification _                   -> ""
  | Dspecasset _                       -> ""
  | Dspecfun _                         -> ""
  | Dspecvariable _                    -> ""
  | Dsecurity _                        -> ""
  | Dtype  (id, _)                     -> unloc id
  | Dinvalid                           -> ""
OCaml

Innovation. Community. Security.