# HG changeset patch # User Adam Chlipala # Date 1234715056 18000 # Node ID a8704dfc58cfa2d96fb38eaedc37b279ad029cbf # Parent c41b2abf156b37ba9251faeba8694db82366ea59 Avoid extra slashes in Cjr urlification diff -r c41b2abf156b -r a8704dfc58cf src/cjr_print.sml --- 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 []