summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-02-15 11:24:16 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-02-15 11:24:16 -0500
commita2199267e2408ebed10bb6dad01bdbdf891c0cc6 (patch)
tree84cc2fe3a6be72dad3e7396ff727ee91c5247b22
parent592d39486f05fae200449d7d683648ea03d2219d (diff)
Avoid extra slashes in Cjr urlification
-rw-r--r--src/cjr_print.sml49
1 files changed, 32 insertions, 17 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 9b82e8c4..fcd18fb7 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -848,30 +848,45 @@ fun urlify env t =
TFfi ("Basis", "unit") => box []
| TFfi (m, t) => box [string ("uw_" ^ ident m ^ "_urlify" ^ capitalize t
^ "_w(ctx, it" ^ Int.toString level ^ ");"),
- newline,
- string "uw_write(ctx, \"/\");",
newline]
| TRecord 0 => box []
| TRecord i =>
let
+ fun empty (t, _) =
+ case t of
+ TFfi ("Basis", "unit") => true
+ | TRecord 0 => true
+ | TRecord j =>
+ List.all (fn (_, t) => empty t) (E.lookupStruct env j)
+ | _ => false
+
val xts = E.lookupStruct env i
+
+ val (blocks, _) = ListUtil.foldlMap
+ (fn ((x, t), wasEmpty) =>
+ (box [string "{",
+ newline,
+ p_typ env t,
+ space,
+ string ("it" ^ Int.toString (level + 1)),
+ space,
+ string "=",
+ space,
+ string ("it" ^ Int.toString level ^ ".__uwf_" ^ x ^ ";"),
+ newline,
+ box (if wasEmpty then
+ []
+ else
+ [string "uw_write(ctx, \"/\");",
+ newline]),
+ urlify' rf (level + 1) t,
+ string "}",
+ newline],
+ empty t))
+ false xts
in
- p_list_sep newline
- (fn (x, t) =>
- box [string "{",
- newline,
- p_typ env t,
- space,
- string ("it" ^ Int.toString (level + 1)),
- space,
- string "=",
- space,
- string ("it" ^ Int.toString level ^ ".__uwf_" ^ x ^ ";"),
- newline,
- urlify' rf (level + 1) t,
- string "}"])
- xts
+ box blocks
end
| TDatatype (Enum, i, _) => box []