Something went wrong. Try again.
This repository has no description
Something went wrong. Try again.
2.6 kB · 83 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384open Algebra
module type S = sig type content type offset type token_info type node_info
type token = {info: token_info; content: content} type 'a node = {info: node_info; children: 'a list} type 'a layer = Token of token | Node of 'a node type tree = Tree of tree layer
type cursor = {offset: offset; layer: cursor layer}
val tree_fold : token:(token -> 'a) -> node:(node_info -> 'a list -> 'a) -> tree -> 'a
val tree_cursor : offset:offset -> tree -> cursor val tree_content : tree -> contentend
module type Input = sig module Content : MonoidHom (** A homomorphism from a monoid of source code to a monoid of offsets. *)
type token_info type node_infoend
module Make (I : Input) : S with type content = I.Content.S.t and type offset = I.Content.T.t and type token_info = I.token_info and type node_info = I.node_info = struct type content = I.Content.S.t type offset = I.Content.T.t type token_info = I.token_info type node_info = I.node_info
type token = {info: token_info; content: content} type 'a node = {info: node_info; children: 'a list} type 'a layer = Token of token | Node of 'a node type tree = Tree of tree layer
type cursor = {offset: offset; layer: cursor layer}
let rec localise_tree ~offset (Tree layer) : cursor * offset = let layer, new_offset = localise_layer ~offset layer in ({offset; layer}, new_offset)
and localise_children ~offset : tree list -> cursor list * offset = function | [] -> ([], offset) | child :: children -> let head_cursor, offset = localise_tree ~offset child in let tail_cursors, offset = localise_children ~offset children in (head_cursor :: tail_cursors, offset)
and localise_node ~offset (node : tree node) : cursor node * offset = let children, offset = localise_children ~offset node.children in ({node with children}, offset)
and localise_layer ~offset : tree layer -> cursor layer * offset = function | Token tok -> (Token tok, I.Content.T.append offset (I.Content.hom tok.content)) | Node node -> let node, offset = localise_node ~offset node in (Node node, offset)
let rec tree_fold ~token ~node (Tree layer) = match layer with | Token tok -> token tok | Node n -> node n.info (List.map (tree_fold ~token ~node) n.children)
let tree_cursor ~offset tree = fst (localise_tree ~offset tree)
let tree_content tree = tree_fold ~token:(fun tok -> tok.content) ~node:(fun _ -> List.fold_left I.Content.S.append I.Content.S.empty) treeend