Repository navigation
Expand file tree
/
Copy pathprint.ml
More file actions
129 lines (117 loc) · 4.94 KB
/
Copy pathprint.ml
File metadata and controls
129 lines (117 loc) · 4.94 KB
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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
(*
* Copyright (c) 2017-2018, Artem Shinkarov <artyom.shinkaroff@gmail.com>
*
* Permission to use, copy, modify, and/or distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
* REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
* AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
* INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
* LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
* OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
* PERFORMANCE OF THIS SOFTWARE.
*)
open Ast
open Value
open Ordinals
open Printf
(* Convert value to string. *)
let rec value_to_str v =
match v with
| VFalse ->
"vfalse"
| VTrue ->
"vtrue"
| VNum o ->
ord_to_str o
| VArray (shp, data) ->
sprintf "<[%s], [%s]>" (val_lst_to_str shp) (val_lst_to_str data)
| VClosure (e, func_env) ->
sprintf "[%s, %s]" (expr_to_str e) (Env.env_to_str func_env)
| VImap (p1, p2, partitions, imap_env) ->
sprintf "[imap %s|%s { %s; %s]" p1 p2 (vpart_lst_to_str partitions) (Env.env_to_str imap_env)
| VFilter (p1, p2, filter_parts) ->
sprintf "[filter %s %s { %s]" p1 p2 (filter_parts_to_str filter_parts)
and val_lst_to_str lst =
String.concat ", " (List.map value_to_str lst)
and vpart_lst_to_str lst =
String.concat ",\n " (List.map (fun gen_exp_ptr ->
let vg, ep = gen_exp_ptr in
let vgs = vgen_to_str vg in
match ep with
| EPptr p -> sprintf "%s: %s" vgs p
| EPexpr e -> sprintf "%s: %s" vgs (expr_to_str e)) lst)
and filter_parts_to_str fps =
String.concat ", " (List.map (fun ord_vl_max ->
let o, lst, maxidx = ord_vl_max in
sprintf "%s |-> [%s] max:%d" (ord_to_str o) (val_lst_to_str lst) maxidx)
fps)
and vgen_to_str vg =
let lb, x, ub = vg in
sprintf "%s <= %s < %s" (value_to_str lb) x (value_to_str ub)
(* TODO This printing is concise, but horribly inefficient as we copy the same string
over and over again when substituting patterns recursively. An alternative would
be to combine patterns in a string tree first and then flatten it once. *)
and expr_to_str e =
match e with
| { expr_kind = ETrue } ->
"true"
| { expr_kind = EFalse } ->
"false"
| { expr_kind = ENum (e1) } ->
ord_to_str e1
| { expr_kind = EArray (e1) } ->
sprintf "[%s]" (array_to_str e1)
| { expr_kind = EVar (x) } ->
sprintf "%s" x
| { expr_kind = EFilter (e1, e2) } ->
sprintf "filter %s %s" (expr_to_str e1) (expr_to_str e2)
| { expr_kind = EReduce (e1, e2, e3) } ->
sprintf "reduce %s %s %s"
(expr_to_str e1) (expr_to_str e2) (expr_to_str e3)
| { expr_kind = EImap (e1, e2, gelst) } ->
sprintf "imap (%s)|%s { %s"
(expr_to_str e1) (expr_to_str e2) (gen_expr_list_to_str gelst)
| { expr_kind = ELetRec (x, e1, e2) } ->
sprintf "letrec %s = %s in %s"
x (expr_to_str e1) (expr_to_str e2)
| { expr_kind = ECond (e1, e2, e3) } ->
sprintf "if %s then %s else %s"
(expr_to_str e1) (expr_to_str e2) (expr_to_str e3)
| { expr_kind = EApply (e1, e2) } ->
sprintf "((%s) (%s))" (expr_to_str e1) (expr_to_str e2)
| { expr_kind = ESel (e1, e2) } ->
sprintf "((%s).(%s))" (expr_to_str e1) (expr_to_str e2)
| { expr_kind = ELambda (x, e1) } ->
sprintf "λ%s.(%s)" x (expr_to_str e1)
| { expr_kind = EBinOp (bop, e1, e2) } ->
sprintf "%s %s %s" (expr_to_str e1) (bop_to_str bop) (expr_to_str e2)
| { expr_kind = EUnary (uop, e1) } ->
match uop with
| OpShape -> sprintf "|%s|" (expr_to_str e1)
| OpIsLim -> sprintf "islim (%s)" (expr_to_str e1)
and array_to_str e =
String.concat ", " (List.map expr_to_str e)
and gen_expr_list_to_str gelst =
String.concat ", "
(List.map (fun ge ->
let (g, e1) = ge in
sprintf "%s: (%s)" (gen_to_str g) (expr_to_str e1)) gelst)
and gen_to_str g =
let (e1, x, e2) = g in
sprintf "%s <= %s < %s" (expr_to_str e1) x (expr_to_str e2)
and bop_to_str bop =
match bop with
| OpPlus -> "+"
| OpMinus -> "-"
| OpMult -> "*"
| OpDiv -> "/"
| OpMod -> "%"
| OpLt -> "<"
| OpLe -> "<="
| OpGt -> ">"
| OpGe -> ">="
| OpEq -> "="
| OpNe -> "<>"