comparison src/cjr_print.sml @ 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 c5991cdb0c4b
comparison
equal deleted inserted replaced
610:c41b2abf156b 611:a8704dfc58cf
846 fun urlify' rf level (t as (_, loc)) = 846 fun urlify' rf level (t as (_, loc)) =
847 case #1 t of 847 case #1 t of
848 TFfi ("Basis", "unit") => box [] 848 TFfi ("Basis", "unit") => box []
849 | TFfi (m, t) => box [string ("uw_" ^ ident m ^ "_urlify" ^ capitalize t 849 | TFfi (m, t) => box [string ("uw_" ^ ident m ^ "_urlify" ^ capitalize t
850 ^ "_w(ctx, it" ^ Int.toString level ^ ");"), 850 ^ "_w(ctx, it" ^ Int.toString level ^ ");"),
851 newline,
852 string "uw_write(ctx, \"/\");",
853 newline] 851 newline]
854 852
855 | TRecord 0 => box [] 853 | TRecord 0 => box []
856 | TRecord i => 854 | TRecord i =>
857 let 855 let
856 fun empty (t, _) =
857 case t of
858 TFfi ("Basis", "unit") => true
859 | TRecord 0 => true
860 | TRecord j =>
861 List.all (fn (_, t) => empty t) (E.lookupStruct env j)
862 | _ => false
863
858 val xts = E.lookupStruct env i 864 val xts = E.lookupStruct env i
865
866 val (blocks, _) = ListUtil.foldlMap
867 (fn ((x, t), wasEmpty) =>
868 (box [string "{",
869 newline,
870 p_typ env t,
871 space,
872 string ("it" ^ Int.toString (level + 1)),
873 space,
874 string "=",
875 space,
876 string ("it" ^ Int.toString level ^ ".__uwf_" ^ x ^ ";"),
877 newline,
878 box (if wasEmpty then
879 []
880 else
881 [string "uw_write(ctx, \"/\");",
882 newline]),
883 urlify' rf (level + 1) t,
884 string "}",
885 newline],
886 empty t))
887 false xts
859 in 888 in
860 p_list_sep newline 889 box blocks
861 (fn (x, t) =>
862 box [string "{",
863 newline,
864 p_typ env t,
865 space,
866 string ("it" ^ Int.toString (level + 1)),
867 space,
868 string "=",
869 space,
870 string ("it" ^ Int.toString level ^ ".__uwf_" ^ x ^ ";"),
871 newline,
872 urlify' rf (level + 1) t,
873 string "}"])
874 xts
875 end 890 end
876 891
877 | TDatatype (Enum, i, _) => box [] 892 | TDatatype (Enum, i, _) => box []
878 (*let 893 (*let
879 val (x, xncs) = E.lookupDatatype env i 894 val (x, xncs) = E.lookupDatatype env i