cosmetic details on trees

This commit is contained in:
Simon Cruanes 2014-06-16 21:15:05 +02:00
parent 373e4e8502
commit 0461758bf9
2 changed files with 9 additions and 11 deletions

View file

@ -84,13 +84,12 @@ let _choose_var ~vars = match vars with
List.nth vars i List.nth vars i
let rec _random_term fuel vars = let rec _random_term fuel vars =
match Random.int 3 with match Random.int 2 with
| _ when fuel = 1 -> _choose_var ~vars | _ when fuel = 1 -> _choose_var ~vars
| 0 -> _choose_var ~vars | 0 ->
| 1 ->
let f1,f2 = _split_fuel fuel in let f1,f2 = _split_fuel fuel in
App (_random_term f1 vars, _random_term f2 vars) App (_random_term f1 vars, _random_term f2 vars)
| 2 -> | 1 ->
let v = _random_var () in let v = _random_var () in
Lambda (v, _random_term (fuel-1) (Var v::vars)) Lambda (v, _random_term (fuel-1) (Var v::vars))
| _ -> assert false | _ -> assert false
@ -110,5 +109,5 @@ let print_reduction t =
let () = let () =
Random.self_init (); Random.self_init ();
let t = _random_term (15 + Random.int 30) [] in let t = _random_term (5 + Random.int 20) [] in
PrintBox.output ~indent:2 stdout (print_reduction t) PrintBox.output ~indent:2 stdout (print_reduction t)

View file

@ -258,8 +258,8 @@ module Box = struct
| Tree (indent, node, children) -> | Tree (indent, node, children) ->
let dim_children = _dim_vertical_array children in let dim_children = _dim_vertical_array children in
let s = size node in let s = size node in
{ x=max s.x (dim_children.x+2+indent) { x=max s.x (dim_children.x+3+indent)
; y=s.y + dim_children.y + (Array.length children-1) ; y=s.y + dim_children.y
} }
let _make shape = let _make shape =
@ -434,14 +434,13 @@ let rec _render ?(offset=origin) ?expected_size ~out b pos =
assert (Array.length a > 0); assert (Array.length a > 0);
let _ = Box._array_foldi let _ = Box._array_foldi
(fun pos' i b -> (fun pos' i b ->
Output.put_string out pos' "+ "; Output.put_string out pos' "+- ";
if i<Array.length a-1 if i<Array.length a-1
then ( then (
_write_vline ~out (_move_y pos' 1) (Box.size b).y _write_vline ~out (_move_y pos' 1) ((Box.size b).y-1)
); );
_render ~out b (_move_x pos' 2); _render ~out b (_move_x pos' 2);
let interline = if i<Array.length a-1 then 1 else 0 in _move_y pos' (Box.size b).y
_move_y pos' ((Box.size b).y + interline)
) pos' a ) pos' a
in in
() ()