Skip to content

Commit 6f3e7fd

Browse files
nojafnojaf
committed
Try CPS
1 parent 312eee0 commit 6f3e7fd

File tree

1 file changed

+90
-78
lines changed

1 file changed

+90
-78
lines changed

‎tools/src/print_tast.ml

Lines changed: 90 additions & 78 deletions
Original file line numberDiff line numberDiff line change
@@ -45,92 +45,104 @@ module Oak = struct
4545
| Rpresent _ -> Ident "row_field.Rpresent"
4646
| Reither _ -> Ident "row_field.Reither"
4747
| Rabsent -> Ident "row_field.Rabsent"
48-
let rec mk_type_desc (desc : Types.type_desc) : oak =
48+
49+
let rec mk_type_desc_cps (desc : Types.type_desc) (continuation : oak -> oak)
50+
: oak =
4951
match desc with
50-
| Tvar var -> (
51-
match var with
52-
| None -> Application {name = "type_desc.Tvar"; argument = Ident "None"}
53-
| Some s -> Application {name = "type_desc.Tvar"; argument = Ident s})
52+
| Tvar var ->
53+
continuation
54+
(Application {name = "type_desc.Tvar"; argument = mk_string_option var})
5455
| Tarrow (_, t1, t2, _) ->
55-
Application
56-
{
57-
name = "type_desc.Tarrow";
58-
argument =
59-
Tuple
60-
[
61-
{name = "t1"; value = mk_type_desc t1.desc};
62-
{name = "t2"; value = mk_type_desc t2.desc};
63-
];
64-
}
65-
| Ttuple _ -> Ident "type_desc.Ttuple"
56+
mk_type_desc_cps t1.desc (fun t1_result ->
57+
mk_type_desc_cps t2.desc (fun t2_result ->
58+
continuation
59+
(Application
60+
{
61+
name = "type_desc.Tarrow";
62+
argument =
63+
Tuple
64+
[
65+
{name = "t1"; value = t1_result};
66+
{name = "t2"; value = t2_result};
67+
];
68+
})))
69+
| Ttuple _ -> continuation (Ident "type_desc.Ttuple")
6670
| Tconstr (path, ts, _) ->
6771
let ts =
68-
ts |> List.map (fun (t : Types.type_expr) -> mk_type_desc t.desc)
72+
List.map
73+
(fun (t : Types.type_expr) -> mk_type_desc_cps t.desc (fun t -> t))
74+
ts
6975
in
70-
Application
71-
{
72-
name = "type_desc.Tconstr";
73-
argument =
74-
Tuple
75-
[
76-
{name = "path"; value = Ident (path_to_string path)};
77-
{name = "ts"; value = List ts};
78-
];
79-
}
80-
| Tobject _ -> Ident "type_desc.Tobject"
81-
| Tfield _ -> Ident "type_desc.Tfield"
82-
| Tnil -> Ident "type_desc.Tnil"
76+
continuation
77+
(Application
78+
{
79+
name = "type_desc.Tconstr";
80+
argument =
81+
Tuple
82+
[
83+
{name = "path"; value = Ident (path_to_string path)};
84+
{name = "ts"; value = List ts};
85+
];
86+
})
87+
| Tobject _ -> continuation (Ident "type_desc.Tobject")
88+
| Tfield _ -> continuation (Ident "type_desc.Tfield")
89+
| Tnil -> continuation (Ident "type_desc.Tnil")
8390
| Tlink {desc} ->
84-
Application {name = "type_desc.Tlink"; argument = mk_type_desc desc}
85-
| Tsubst _ -> Ident "type_desc.Tsubst"
91+
mk_type_desc_cps desc (fun result ->
92+
continuation
93+
(Application {name = "type_desc.Tlink"; argument = result}))
94+
| Tsubst _ -> continuation (Ident "type_desc.Tsubst")
8695
| Tvariant row_descr ->
87-
Application
88-
{name = "type_desc.Tvariant"; argument = mk_row_desc row_descr}
89-
| Tunivar _ -> Ident "type_desc.Tunivar"
90-
| Tpoly _ -> Ident "type_desc.Tpoly"
91-
| Tpackage _ -> Ident "type_desc.Tpackage"
92-
93-
and mk_row_desc (row_desc : Types.row_desc) : oak =
94-
let fields =
95-
[
96-
{
97-
name = "row_fields";
98-
value =
99-
( row_desc.row_fields
100-
|> List.map (fun (label, row_field) ->
101-
Tuple
102-
[
103-
{name = "label"; value = Ident label};
104-
{name = "row_field"; value = mk_row_field row_field};
105-
])
106-
|> fun ts -> List ts );
107-
};
108-
{name = "row_more"; value = mk_type_desc row_desc.row_more.desc};
109-
{name = "row_closed"; value = mk_bool row_desc.row_closed};
110-
{name = "row_fixed"; value = mk_bool row_desc.row_fixed};
111-
]
112-
in
113-
match row_desc.row_name with
114-
| None -> Record fields
115-
| Some (path, ts) ->
116-
Record
117-
({
118-
name = "row_name";
96+
continuation
97+
(Application {name = "type_desc.Tvariant"; argument = Ident "row_descr"})
98+
| Tunivar _ -> continuation (Ident "type_desc.Tunivar")
99+
| Tpoly _ -> continuation (Ident "type_desc.Tpoly")
100+
| Tpackage _ -> continuation (Ident "type_desc.Tpackage")
101+
102+
let mk_type_desc (desc : Types.type_desc) : oak =
103+
mk_type_desc_cps desc (fun result -> result)
104+
105+
(* and mk_row_desc (row_desc : Types.row_desc) : oak =
106+
let fields =
107+
[
108+
{
109+
name = "row_fields";
119110
value =
120-
Tuple
121-
[
122-
{name = "Path.t"; value = Ident (path_to_string path)};
123-
{
124-
name = "fields";
125-
value =
126-
List
127-
(ts
128-
|> List.map (fun (t : Types.type_expr) ->
129-
mk_type_desc t.desc));
130-
};
131-
];
132-
}
133-
:: fields)
111+
( row_desc.row_fields
112+
|> List.map (fun (label, row_field) ->
113+
Tuple
114+
[
115+
{name = "label"; value = Ident label};
116+
{name = "row_field"; value = mk_row_field row_field};
117+
])
118+
|> fun ts -> List ts );
119+
};
120+
{name = "row_more"; value = mk_type_desc row_desc.row_more.desc};
121+
{name = "row_closed"; value = mk_bool row_desc.row_closed};
122+
{name = "row_fixed"; value = mk_bool row_desc.row_fixed};
123+
]
124+
in
125+
match row_desc.row_name with
126+
| None -> Record fields
127+
| Some (path, ts) ->
128+
Record
129+
({
130+
name = "row_name";
131+
value =
132+
Tuple
133+
[
134+
{name = "Path.t"; value = Ident (path_to_string path)};
135+
{
136+
name = "fields";
137+
value =
138+
List
139+
(ts
140+
|> List.map (fun (t : Types.type_expr) ->
141+
mk_type_desc t.desc));
142+
};
143+
];
144+
}
145+
:: fields) *)
134146

135147
let mk_package (package : SharedTypes.package) : oak =
136148
Record

0 commit comments

Comments
 (0)