diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-02-15 11:24:16 -0500 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-02-15 11:24:16 -0500 |
| commit | a2199267e2408ebed10bb6dad01bdbdf891c0cc6 (patch) | |
| tree | 84cc2fe3a6be72dad3e7396ff727ee91c5247b22 | |
| parent | 592d39486f05fae200449d7d683648ea03d2219d (diff) | |
Avoid extra slashes in Cjr urlification
| -rw-r--r-- | src/cjr_print.sml | 49 |
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 [] |