72 lines
2.3 KiB
OCaml
72 lines
2.3 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* Copyright (c) 2014 - 2016. *)
|
|
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
|
(* *)
|
|
(* All rights reserved. No warranty, explicit or implicit, provided. *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
|
|
type point = Micheline_parser.point =
|
|
{ point : int ;
|
|
byte : int ;
|
|
line : int ;
|
|
column : int }
|
|
|
|
let point_zero = Micheline_parser.point_zero
|
|
|
|
type location = Micheline_parser.location =
|
|
{ start : point ;
|
|
stop : point }
|
|
|
|
let location_encoding =
|
|
let open Data_encoding in
|
|
let point_encoding =
|
|
conv
|
|
(fun { line ; column ; point ; byte } -> (line, column, point, byte))
|
|
(fun (line, column, point, byte) -> { line ; column ; point ; byte })
|
|
(obj4
|
|
(req "line" uint16)
|
|
(req "column" uint16)
|
|
(req "point" uint16)
|
|
(req "byte" uint16)) in
|
|
conv
|
|
(fun { start ; stop } -> (start, stop))
|
|
(fun (start, stop) -> { start ; stop })
|
|
(obj2
|
|
(req "start" point_encoding)
|
|
(req "stop" point_encoding))
|
|
|
|
type node = (location, string) Micheline.node
|
|
|
|
open Micheline
|
|
|
|
let node_location = function
|
|
| Int (loc, _)
|
|
| String (loc, _)
|
|
| Prim (loc, _, _, _)
|
|
| Seq (loc, _, _) -> loc
|
|
|
|
let strip_locations root =
|
|
let id = let id = ref (-1) in fun () -> incr id ; !id in
|
|
let loc_table = ref [] in
|
|
let rec strip_locations l =
|
|
let id = id () in
|
|
match l with
|
|
| Int (loc, v) ->
|
|
loc_table := (id, loc) :: !loc_table ;
|
|
Int (id, v)
|
|
| String (loc, v) ->
|
|
loc_table := (id, loc) :: !loc_table ;
|
|
String (id, v)
|
|
| Seq (loc, seq, annot) ->
|
|
loc_table := (id, loc) :: !loc_table ;
|
|
Seq (id, List.map strip_locations seq, annot)
|
|
| Prim (loc, name, seq, annot) ->
|
|
loc_table := (id, loc) :: !loc_table ;
|
|
Prim (id, name, List.map strip_locations seq, annot) in
|
|
let stripped = strip_locations root in
|
|
stripped, List.rev !loc_table
|
|
|
|
exception Missing_program_field of string
|