src/pp.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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91

let divider =
  {|********************************************************************************|}

let header fmt name =
  let len = String.length name in
  Format.fprintf fmt
    {|%s

*                                                                              *

*%*s%s%*s*

*                                                                              *

%s|}
    divider
    ((78 - len) / 2)
    " " name
    ( ((78 - len) / 2)
    +
    if len mod 2 = 0 then
      0
    else
      1 )
    " " divider

let pp_transition fmt ((state, read), (to_state, write, direction)) =
  Format.fprintf fmt "(%s, %s) -> ( %s, %s, %s )" state read to_state write
    (Lang.from_direction direction)

let machine fmt
    (name, alphabet, _blank, states, initial_state, final_states, transitions) =
  Format.fprintf fmt
    {|%a
Alphabet: [ %a ]
States  : [ %a ]
Initial : %s
Finals  : [ %a ]
%a
%s@.|}
    header name
    (Format.pp_print_list
       ~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
       (fun fmt alphachar -> Format.fprintf fmt "%s" alphachar) )
    alphabet
    (Format.pp_print_list
       ~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
       (fun fmt state -> Format.fprintf fmt "%s" state) )
    (List.sort
       (fun s1 s2 -> compare (String.length s2) (String.length s1))
       (List.of_seq (Hashtbl.to_seq_keys states)) )
    initial_state
    (Format.pp_print_list
       ~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
       (fun fmt final -> Format.fprintf fmt "%s" final) )
    final_states
    (Format.pp_print_list
       ~pp_sep:(fun fmt () -> Format.fprintf fmt "@.")
       pp_transition )
    (List.sort
       (fun ((s1, _c1), _) ((s2, _c2), _) ->
         match compare s2 s1 with
         | 0 -> compare (String.length s2) (String.length s1)
         | n -> n )
       (List.of_seq (Hashtbl.to_seq transitions)) )
    divider

let pp_tape fmt (tape, index) =
  String.iteri
    (fun i s ->
      if i = index then
        Format.fprintf fmt "<%c>" s
      else
        Format.fprintf fmt "%c" s )
    tape

let blocked_tape fmt current_head state read print final_or_blocked =
  if print then
    Format.fprintf fmt {|[%a] (%s, %s) -> %s@.|} pp_tape current_head state read
      final_or_blocked
  else
    Format.ifprintf fmt {|[%a] (%s, %s) -> %s@.|} pp_tape current_head state
      read final_or_blocked

let current_tape fmt tape index transition print =
  if print then
    Format.fprintf fmt {|[%a] %a@.|} pp_tape (tape, index) pp_transition
      transition
  else
    Format.ifprintf fmt {|[%a] %a@.|} pp_tape (tape, index) pp_transition
      transition