comparison src/corify.sml @ 768:3b7e46790fa7

Path rewriting
author Adam Chlipala <adamc@hcoop.net>
date Sat, 02 May 2009 13:23:07 -0400
parents a28982de5645
children 0e554bfd6d6a
comparison
equal deleted inserted replaced
767:d27ed5ddeb52 768:3b7e46790fa7
35 structure SM = BinaryMapFn(struct 35 structure SM = BinaryMapFn(struct
36 type ord_key = string 36 type ord_key = string
37 val compare = String.compare 37 val compare = String.compare
38 end) 38 end)
39 39
40 val restify = ref (fn s : string => s) 40 fun doRestify k (mods, s) =
41
42 fun doRestify (mods, s) =
43 let 41 let
44 val s = if String.isPrefix "wrap_" s then 42 val s = if String.isPrefix "wrap_" s then
45 String.extract (s, 5, NONE) 43 String.extract (s, 5, NONE)
46 else 44 else
47 s 45 s
48 in 46 in
49 !restify (String.concatWith "/" (rev (s :: mods))) 47 Settings.rewrite k (String.concatWith "/" (rev (s :: mods)))
50 end 48 end
51 49
52 val relify = CharVector.map (fn #"/" => #"_" 50 val relify = CharVector.map (fn #"/" => #"_"
53 | ch => ch) 51 | ch => ch)
54 52
700 ((L'.DCon (x, n, k', cBase), loc) :: cds, st) 698 ((L'.DCon (x, n, k', cBase), loc) :: cds, st)
701 end 699 end
702 | L.DVal (x, n, t, e) => 700 | L.DVal (x, n, t, e) =>
703 let 701 let
704 val (st, n) = St.bindVal st x n 702 val (st, n) = St.bindVal st x n
705 val s = doRestify (mods, x) 703 val s = doRestify Settings.Url (mods, x)
706 in 704 in
707 ([(L'.DVal (x, n, corifyCon st t, corifyExp st e, s), loc)], st) 705 ([(L'.DVal (x, n, corifyCon st t, corifyExp st e, s), loc)], st)
708 end 706 end
709 | L.DValRec vis => 707 | L.DValRec vis =>
710 let 708 let
718 st vis 716 st vis
719 717
720 val vis = map 718 val vis = map
721 (fn (x, n, t, e) => 719 (fn (x, n, t, e) =>
722 let 720 let
723 val s = doRestify (mods, x) 721 val s = doRestify Settings.Url (mods, x)
724 in 722 in
725 (x, n, corifyCon st t, corifyExp st e, s) 723 (x, n, corifyCon st t, corifyExp st e, s)
726 end) 724 end)
727 vis 725 vis
728 in 726 in
980 | _ => raise Fail "Non-const signature for 'export'") 978 | _ => raise Fail "Non-const signature for 'export'")
981 979
982 | L.DTable (_, x, n, c, pe, pc, ce, cc) => 980 | L.DTable (_, x, n, c, pe, pc, ce, cc) =>
983 let 981 let
984 val (st, n) = St.bindVal st x n 982 val (st, n) = St.bindVal st x n
985 val s = relify (doRestify (mods, x)) 983 val s = relify (doRestify Settings.Table (mods, x))
986 in 984 in
987 ([(L'.DTable (x, n, corifyCon st c, s, 985 ([(L'.DTable (x, n, corifyCon st c, s,
988 corifyExp st pe, corifyCon st pc, 986 corifyExp st pe, corifyCon st pc,
989 corifyExp st ce, corifyCon st cc), loc)], st) 987 corifyExp st ce, corifyCon st cc), loc)], st)
990 end 988 end
991 | L.DSequence (_, x, n) => 989 | L.DSequence (_, x, n) =>
992 let 990 let
993 val (st, n) = St.bindVal st x n 991 val (st, n) = St.bindVal st x n
994 val s = relify (doRestify (mods, x)) 992 val s = relify (doRestify Settings.Sequence (mods, x))
995 in 993 in
996 ([(L'.DSequence (x, n, s), loc)], st) 994 ([(L'.DSequence (x, n, s), loc)], st)
997 end 995 end
998 | L.DView (_, x, n, e, c) => 996 | L.DView (_, x, n, e, c) =>
999 let 997 let
1000 val (st, n) = St.bindVal st x n 998 val (st, n) = St.bindVal st x n
1001 val s = relify (doRestify (mods, x)) 999 val s = relify (doRestify Settings.View (mods, x))
1002 in 1000 in
1003 ([(L'.DView (x, n, s, corifyExp st e, corifyCon st c), loc)], st) 1001 ([(L'.DView (x, n, s, corifyExp st e, corifyCon st c), loc)], st)
1004 end 1002 end
1005 1003
1006 | L.DDatabase s => ([(L'.DDatabase s, loc)], st) 1004 | L.DDatabase s => ([(L'.DDatabase s, loc)], st)
1007 1005
1008 | L.DCookie (_, x, n, c) => 1006 | L.DCookie (_, x, n, c) =>
1009 let 1007 let
1010 val (st, n) = St.bindVal st x n 1008 val (st, n) = St.bindVal st x n
1011 val s = doRestify (mods, x) 1009 val s = doRestify Settings.Cookie (mods, x)
1012 in 1010 in
1013 ([(L'.DCookie (x, n, corifyCon st c, s), loc)], st) 1011 ([(L'.DCookie (x, n, corifyCon st c, s), loc)], st)
1014 end 1012 end
1015 | L.DStyle (_, x, n) => 1013 | L.DStyle (_, x, n) =>
1016 let 1014 let
1017 val (st, n) = St.bindVal st x n 1015 val (st, n) = St.bindVal st x n
1018 val s = relify (doRestify (mods, x)) 1016 val s = relify (doRestify Settings.Style (mods, x))
1019 in 1017 in
1020 ([(L'.DStyle (x, n, s), loc)], st) 1018 ([(L'.DStyle (x, n, s), loc)], st)
1021 end 1019 end
1022 1020
1023 and corifyStr mods ((str, _), st) = 1021 and corifyStr mods ((str, _), st) =