Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2017 Matthew Fluet. |
2 | * Copyright (C) 2003-2006 Henry Cejtin, Matthew Fluet, Suresh | |
3 | * Jagannathan, and Stephen Weeks. | |
4 | * | |
5 | * MLton is released under a BSD-style license. | |
6 | * See the file MLton-LICENSE for details. | |
7 | *) | |
8 | ||
9 | structure Pretty: PRETTY = | |
10 | struct | |
11 | ||
12 | open Layout | |
13 | ||
14 | fun casee {default, rules, test} = | |
15 | let | |
16 | val rules = | |
17 | case default of | |
18 | NONE => rules | |
19 | | SOME l => Vector.concat [rules, Vector.new1 (str "_", l)] | |
20 | in | |
21 | align [seq [str "case ", test, str " of"], | |
22 | indent (alignPrefix (Vector.toListMap | |
23 | (rules, fn (lhs, rhs) => | |
24 | mayAlign [seq [lhs, str " =>"], rhs]), | |
25 | "| "), | |
26 | 2)] | |
27 | end | |
28 | ||
29 | fun conApp {arg, con, targs} = | |
30 | seq [con, | |
31 | if !Control.showTypes | |
32 | then tuple (Vector.toList targs) | |
33 | else empty, | |
34 | case arg of | |
35 | NONE => empty | |
36 | | SOME x => seq [str " ", x]] | |
37 | ||
38 | fun handlee {catch, handler, try} = | |
39 | align [try, | |
40 | seq [str "handle ", catch, str " => ", handler]] | |
41 | ||
42 | fun nest (prefix, x, y) = | |
43 | align [seq [str prefix, x], | |
44 | str "in", | |
45 | indent (y, 3), | |
46 | str "end"] | |
47 | ||
48 | fun lett (d, e) = nest ("let ", d, e) | |
49 | ||
50 | fun locall (d, d') = nest ("local ", d, d') | |
51 | ||
52 | fun primApp {args, prim, targs} = | |
53 | seq [prim, | |
54 | if !Control.showTypes | |
55 | andalso 0 < Vector.length targs | |
56 | then list (Vector.toList targs) | |
57 | else empty, | |
58 | str " ", | |
59 | tuple (Vector.toList args)] | |
60 | ||
61 | fun raisee exn = seq [str "raise ", exn] | |
62 | ||
63 | fun seq es = mayAlign (separateLeft (Vector.toList es, ";")) | |
64 | ||
65 | end |