Mercurial > urweb
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 |