ast.ml

module With_position = struct
  type 'a t =
    { value : 'a
    ; pos : Lexing.position
    }
end

type 'dict atom =
  [ `Symbol of string
  | `Vector of 't array
  ] constraint 'dict = < t : 't; atom : 'atom; tail : 'tail >

type 'dict t_ =
  [ 'dict atom
  | `List of 't list
  | `DottedList of 't list * 'tail
  ] constraint 'dict = < t : 't; atom : 'atom; tail : 'tail >

type dict =
  < t : dict t_
  ; atom : dict atom
  ; tail : dict atom
  >

type t = dict t_

type pdict =
  < t : pdict t_ With_position.t
  ; atom : pdict atom
  ; tail : pdict atom With_position.t
  >

type positioned = pdict t_ With_position.t
type patom = pdict atom

let rec strip (x : positioned) : t =
  match x with
  | { With_position.value = #patom; _ } as v ->
    (strip_atom v :> t)
  | { With_position.value = `List xs } ->
    `List (List.map strip xs)
  | { With_position.value = `DottedList (xs, tl) } ->
    `DottedList (List.map strip xs, strip_atom tl)
and strip_atom = function
  | { With_position.value = (`Symbol _ as v); _ } -> v
  | { With_position.value = (`Vector arr); _ } ->
    `Vector (Array.map strip arr)