Mercurial > urweb

comparison src/elab_util.sml @ 1345:9e0fa4f6ac93

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fiddly tweaks
author Adam Chlipala <adam@chlipala.net>
date Thu, 16 Dec 2010 13:35:40 -0500
parents c7b9a33c26c8
children c37d8341940a
comparison
equal deleted inserted replaced
1344:660a2715e2bd 1345:9e0fa4f6ac93
769 RelK of string 769 RelK of string
770 | RelC of string * Elab.kind 770 | RelC of string * Elab.kind
771 | NamedC of string * int * Elab.kind * Elab.con option 771 | NamedC of string * int * Elab.kind * Elab.con option
772 | RelE of string * Elab.con 772 | RelE of string * Elab.con
773 | NamedE of string * Elab.con 773 | NamedE of string * Elab.con
774 | Str of string * Elab.sgn 774 | Str of string * int * Elab.sgn
775 | Sgn of string * Elab.sgn 775 | Sgn of string * int * Elab.sgn
776 776
777 fun mapfoldB {kind = fk, con = fc, exp = fe, sgn_item = fsgi, sgn = fsg, str = fst, decl = fd, bind} = 777 fun mapfoldB {kind = fk, con = fc, exp = fe, sgn_item = fsgi, sgn = fsg, str = fst, decl = fd, bind} =
778 let 778 let
779 val mfk = Kind.mapfoldB {kind = fk, bind = fn (ctx, x) => bind (ctx, RelK x)} 779 val mfk = Kind.mapfoldB {kind = fk, bind = fn (ctx, x) => bind (ctx, RelK x)}
780 780
806 let 806 let
807 val b' = case b of 807 val b' = case b of
808 Sgn.RelK x => RelK x 808 Sgn.RelK x => RelK x
809 | Sgn.RelC x => RelC x 809 | Sgn.RelC x => RelC x
810 | Sgn.NamedC x => NamedC x 810 | Sgn.NamedC x => NamedC x
811 | Sgn.Sgn (x, _, y) => Sgn (x, y) 811 | Sgn.Sgn x => Sgn x
812 | Sgn.Str (x, _, y) => Str (x, y) 812 | Sgn.Str x => Str x
813 in 813 in
814 bind (ctx, b') 814 bind (ctx, b')
815 end 815 end
816 val mfsg = Sgn.mapfoldB {kind = fk, con = fc, sgn_item = fsgi, sgn = fsg, bind = bind'} 816 val mfsg = Sgn.mapfoldB {kind = fk, con = fc, sgn_item = fsgi, sgn = fsg, bind = bind'}
817 817
859 SOME (CModProj (m, ms, x'), loc))) 859 SOME (CModProj (m, ms, x'), loc)))
860 | DVal (x, _, c, _) => 860 | DVal (x, _, c, _) =>
861 bind (ctx, NamedE (x, c)) 861 bind (ctx, NamedE (x, c))
862 | DValRec vis => 862 | DValRec vis =>
863 foldl (fn ((x, _, c, _), ctx) => bind (ctx, NamedE (x, c))) ctx vis 863 foldl (fn ((x, _, c, _), ctx) => bind (ctx, NamedE (x, c))) ctx vis
864 | DSgn (x, _, sgn) => 864 | DSgn (x, n, sgn) =>
865 bind (ctx, Sgn (x, sgn)) 865 bind (ctx, Sgn (x, n, sgn))
866 | DStr (x, _, sgn, _) => 866 | DStr (x, n, sgn, _) =>
867 bind (ctx, Str (x, sgn)) 867 bind (ctx, Str (x, n, sgn))
868 | DFfiStr (x, _, sgn) => 868 | DFfiStr (x, n, sgn) =>
869 bind (ctx, Str (x, sgn)) 869 bind (ctx, Str (x, n, sgn))
870 | DConstraint _ => ctx 870 | DConstraint _ => ctx
871 | DExport _ => ctx 871 | DExport _ => ctx
872 | DTable (tn, x, n, c, _, pc, _, cc) => 872 | DTable (tn, x, n, c, _, pc, _, cc) =>
873 let 873 let
874 val ct = (CModProj (n, [], "sql_table"), loc) 874 val ct = (CModProj (n, [], "sql_table"), loc)
1142 decl = fn ctx => fn x => fn st => S.Continue (decl (ctx, x, st)), 1142 decl = fn ctx => fn x => fn st => S.Continue (decl (ctx, x, st)),
1143 bind = bind} ctx d st of 1143 bind = bind} ctx d st of
1144 S.Continue x => x 1144 S.Continue x => x
1145 | S.Return _ => raise Fail "ElabUtil.Decl.foldMapB: Impossible" 1145 | S.Return _ => raise Fail "ElabUtil.Decl.foldMapB: Impossible"
1146 1146
1147 fun map {kind, con, exp, sgn_item, sgn, str, decl} s =
1148 case mapfold {kind = fn k => fn () => S.Continue (kind k, ()),
1149 con = fn c => fn () => S.Continue (con c, ()),
1150 exp = fn e => fn () => S.Continue (exp e, ()),
1151 sgn_item = fn si => fn () => S.Continue (sgn_item si, ()),
1152 sgn = fn s => fn () => S.Continue (sgn s, ()),
1153 str = fn si => fn () => S.Continue (str si, ()),
1154 decl = fn s => fn () => S.Continue (decl s, ())} s () of
1155 S.Return () => raise Fail "Elab_util.Decl.map"
1156 | S.Continue (s, ()) => s
1157
1158 fun mapB {kind, con, exp, sgn_item, sgn, str, decl, bind} ctx s =
1159 case mapfoldB {kind = fn ctx => fn k => fn () => S.Continue (kind ctx k, ()),
1160 con = fn ctx => fn c => fn () => S.Continue (con ctx c, ()),
1161 exp = fn ctx => fn c => fn () => S.Continue (exp ctx c, ()),
1162 sgn_item = fn ctx => fn sgi => fn () => S.Continue (sgn_item ctx sgi, ()),
1163 sgn = fn ctx => fn s => fn () => S.Continue (sgn ctx s, ()),
1164 str = fn ctx => fn sgi => fn () => S.Continue (str ctx sgi, ()),
1165 decl = fn ctx => fn s => fn () => S.Continue (decl ctx s, ()),
1166 bind = bind} ctx s () of
1167 S.Continue (s, ()) => s
1168 | S.Return _ => raise Fail "ElabUtil.Decl.mapB: Impossible"
1169
1147 end 1170 end
1148 1171
1149 structure File = struct 1172 structure File = struct
1150 1173
1151 fun maxName ds = foldl (fn (d, count) => Int.max (maxNameDecl d, count)) 0 ds 1174 fun maxName ds = foldl (fn (d, count) => Int.max (maxNameDecl d, count)) 0 ds