Mercurial > urweb
changeset 611:a8704dfc58cf
Avoid extra slashes in Cjr urlification
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 15 Feb 2009 11:24:16 -0500 |
| parents | c41b2abf156b |
| children | d80256efc160 |
| files | src/cjr_print.sml |
| diffstat | 1 files changed, 32 insertions(+), 17 deletions(-) [+] |
line wrap: on
line diff
--- a/src/cjr_print.sml Sun Feb 15 10:54:00 2009 -0500 +++ b/src/cjr_print.sml Sun Feb 15 11:24:16 2009 -0500 @@ -848,30 +848,45 @@ 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 []