Mercurial > urweb
comparison src/elab_util.sml @ 1345:9e0fa4f6ac93
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 |