-
Notifications
You must be signed in to change notification settings - Fork 0
/
terminal.ml
62 lines (53 loc) · 1.62 KB
/
terminal.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
(* ferret terminal
*
* copyright (c) 2012 by jeffrey massung
* all rights reserved
*
* terminal.ml
*)
open Cell
(* terminal ansi colors *)
let red = "\x1b[31m"
let green = "\x1b[32m"
let yellow = "\x1b[33m"
let blue = "\x1b[34m"
let magenta = "\x1b[35m"
let cyan = "\x1b[36m"
let gray = "\x1b[37m"
let clear = "\x1b[0m"
(* ready the terminal to handle interrupts *)
let setup_term () =
Sys.interactive := true;
Sys.catch_break true
(* display the ok prompt *)
let show_ok () = Printf.printf " %sok%s\n" cyan clear
(* print the output of a value *)
let show_top stack =
let show x = Printf.sprintf "%s==%s %s" green clear (Cell.mold x) in
let rest xs = Printf.sprintf "%s (+ %d)%s" yellow (List.length xs) clear in
match stack with
[] -> show_ok ()
| [x] -> Printf.printf "%s\n" (show x)
| x::xs -> Printf.printf "%s%s\n" (show x) (rest xs)
(* print an exception to stderr *)
let show_err = function
| Sys.Break -> Printf.printf "\n%s** Interrupt!%s\n" red clear
| e -> Printf.printf "%s** %s%s\n" red (Printexc.to_string e) clear
(* display an entire stack *)
let show_stack = function
| [] -> Printf.printf "%sEmpty stack%s\n" blue clear
| xs -> let show i x =
let color = if i = 0 then cyan else blue in
Printf.printf "%s[ +%d ]%s %s\n" color i clear (mold x);
i+1
in
ignore (List.fold_left show 0 xs)
(* display a stack in reverse contents *)
let show_rev_stack xs =
let xs' = List.rev xs in
let len = List.length xs in
let show i x =
Printf.printf "%s[ -%d ]%s %s\n" blue i clear (mold x);
i-1
in
ignore (List.fold_left show len xs')