diff options
Diffstat (limited to 'discocaml/draw_tree.ml')
| -rw-r--r-- | discocaml/draw_tree.ml | 36 |
1 files changed, 33 insertions, 3 deletions
diff --git a/discocaml/draw_tree.ml b/discocaml/draw_tree.ml index f0badd7..ecf1b71 100644 --- a/discocaml/draw_tree.ml +++ b/discocaml/draw_tree.ml @@ -1,6 +1,32 @@ open Ast module IntSet = Set.Make (Int) +let break_to_subscript (s : string) : (string * string) option = + let rec loop (i : int) : (string * string) option = + if i < 0 then None + else + let ch = String.get s i in + if '0' <= ch && ch <= '9' then loop (i - 1) + else + let name = String.sub s 0 (i + 1) + and sub = String.sub s (i + 1) (String.length s - i - 1) in + if sub = "" then None else Some (name, sub) + in + loop (String.length s - 1) + +let%test "break_to_subscript fail" = break_to_subscript "x1y" = None +let%test "break_to_subscript simple" = break_to_subscript "x1" = Some ("x", "1") +let%test "break_to_subscript empty" = break_to_subscript "" = None +let%test "break_to_subscript number" = break_to_subscript "123" = None +let%test "break_to_subscript multi" = break_to_subscript "x12" = Some ("x", "12") + +let fmt_with_possible_subscript (fmt : Format.formatter) (s : string) : unit = + match break_to_subscript s with + | Some (name, sub) -> + Format.fprintf fmt "<%s<FONT POINT-SIZE=\"12\"><SUB>%s</SUB></FONT>>" name + sub + | None -> Format.fprintf fmt "%S" s + let add_node (fmt : Format.formatter) (i : expr index) (expr : expr) : unit = match expr with | App _ -> @@ -36,7 +62,9 @@ let add_node (fmt : Format.formatter) (i : expr index) (expr : expr) : unit = | Prim (RelOp, (op, _, _)) -> Format.fprintf fmt " expr%d [label=\"%s\"];\n" i.index (string_of_relop op) - | Var x -> Format.fprintf fmt " expr%d [label=%S];\n" i.index x + | Var x -> + Format.fprintf fmt " expr%d [label=%a];\n" i.index + fmt_with_possible_subscript x let add_expr_edges (ast : 'a ast) (fmt : Format.formatter) (nodes : IntSet.t ref) : expr index -> unit = @@ -59,11 +87,13 @@ let add_expr_edges (ast : 'a ast) (fmt : Format.formatter) edge_to else_ | Lam (x, b) -> Format.fprintf fmt " expr%d -> expr%d_var;\n" i.index i.index; - Format.fprintf fmt " expr%d_var [label=%S];\n" i.index x; + Format.fprintf fmt " expr%d_var [label=%a];\n" i.index + fmt_with_possible_subscript x; edge_to b | Let (_, name, bound, body) -> Format.fprintf fmt " expr%d -> expr%d_var;\n" i.index i.index; - Format.fprintf fmt " expr%d_var [label=%S];\n" i.index name; + Format.fprintf fmt " expr%d_var [label=%a];\n" i.index + fmt_with_possible_subscript name; edge_to bound; edge_to body | Prim (Add, (l, r)) -> |