Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/branches/primop-branch-2/src/compiler/ElabData/modules/moduleutil.sml
ViewVC logotype

Diff of /sml/branches/primop-branch-2/src/compiler/ElabData/modules/moduleutil.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1958, Thu Jul 6 23:01:06 2006 UTC revision 1959, Fri Jul 7 20:36:18 2006 UTC
# Line 20  Line 20 
20        structure M   = Modules        structure M   = Modules
21        structure MI  = ModuleId        structure MI  = ModuleId
22        structure SE  = StaticEnv        structure SE  = StaticEnv
23          structure POI = PrimOpId
24        open Modules        open Modules
25  in  in
26    
# Line 78  Line 79 
79          (case EE.look(entEnv,entVar)          (case EE.look(entEnv,entVar)
80            of STRent entity =>            of STRent entity =>
81                 (STR{sign = sign, rlzn = entity, access = A.selAcc(dacc,slot),                 (STR{sign = sign, rlzn = entity, access = A.selAcc(dacc,slot),
82                      prim = PrimOpId.selStrPrimId (dinfo, slot)},                      prim = POI.selStrPrimId (dinfo, slot)},
83                  entVar)                  entVar)
84             | _ => bug "getStr: bad entity")             | _ => bug "getStr: bad entity")
85       | _ => bug "getStr: wrong spec"       | _ => bug "getStr: wrong spec"
# Line 90  Line 91 
91          (case EE.look(entEnv,entVar)          (case EE.look(entEnv,entVar)
92            of FCTent entity =>            of FCTent entity =>
93                 (FCT{sign = sign, rlzn = entity, access = A.selAcc(dacc,slot),                 (FCT{sign = sign, rlzn = entity, access = A.selAcc(dacc,slot),
94                      prim = PrimOpId.selStrPrimId (dinfo, slot)},                      prim = POI.selStrPrimId (dinfo, slot)},
95                  entVar)                  entVar)
96             | _ => bug "getFct: bad entity")             | _ => bug "getFct: bad entity")
97       | _ => bug "getFct: wrong spec"       | _ => bug "getFct: wrong spec"
# Line 114  Line 115 
115                  SOME(STR{sign = sign,                  SOME(STR{sign = sign,
116                           rlzn = EE.lookStrEnt(entities,entVar),                           rlzn = EE.lookStrEnt(entities,entVar),
117                           access = A.selAcc(access, slot),                           access = A.selAcc(access, slot),
118                           prim = PrimOpId.selStrPrimId (prim, slot)})                           prim = POI.selStrPrimId (prim, slot)})
119                | _ => NONE)                | _ => NONE)
120              elements              elements
121      end      end
# Line 174  Line 175 
175  fun strDefToStr(CONSTstrDef str, _) = str  fun strDefToStr(CONSTstrDef str, _) = str
176    | strDefToStr(VARstrDef(sign,entPath), entEnv) =    | strDefToStr(VARstrDef(sign,entPath), entEnv) =
177      STR{sign=sign,rlzn=EE.lookStrEP(entEnv,entPath),      STR{sign=sign,rlzn=EE.lookStrEP(entEnv,entPath),
178          access=A.nullAcc, info=StrE []}          access=A.nullAcc, prim=POI.StrE []}
179    
180  (*  (*
181   * two pieces of essential structure information gathered during   * two pieces of essential structure information gathered during
# Line 182  Line 183 
183   * being searched is a STRSIG; otherwise it return STRINFO.   * being searched is a STRSIG; otherwise it return STRINFO.
184   *)   *)
185  datatype strInfo = SIGINFO of EP.entPath  (* reverse order! *)  datatype strInfo = SIGINFO of EP.entPath  (* reverse order! *)
186                   | STRINFO of strEntity * A.access * InlInfo.inl_info                   | STRINFO of strEntity * A.access * POI.strPrimElem
187    
188  val bogusInfo = STRINFO (bogusStrEntity, A.nullAcc, II.nullInfo)  val bogusInfo = STRINFO (bogusStrEntity, A.nullAcc, POI.StrE [])
189    
190  fun getStrElem (sym, sign as SIG {elements,...}, sInfo) =  fun getStrElem (sym, sign as SIG {elements,...}, sInfo) =
191        (case getSpec (elements,sym)        (case getSpec (elements,sym)
# Line 194  Line 195 
195                     of SIGINFO ep => SIGINFO (entVar::ep)                     of SIGINFO ep => SIGINFO (entVar::ep)
196                      | STRINFO ({entities,...}, dacc, dinfo) =>                      | STRINFO ({entities,...}, dacc, dinfo) =>
197                        STRINFO(EE.lookStrEnt(entities,entVar),                        STRINFO(EE.lookStrEnt(entities,entVar),
198                                A.selAcc(dacc,slot), II.selStrInfo (dinfo, slot))                                A.selAcc(dacc,slot), POI.selStrPrimId (dinfo, slot))
199                in (subsig, newInfo)                in (subsig, newInfo)
200               end)               end)
201           | _ => bug "getStrElem: wrong spec case")           | _ => bug "getStrElem: wrong spec case")
# Line 207  Line 208 
208          of FCTspec{sign=subfsig, entVar, slot} =>          of FCTspec{sign=subfsig, entVar, slot} =>
209               FCT{sign=subfsig, rlzn=EE.lookFctEnt(entities,entVar),               FCT{sign=subfsig, rlzn=EE.lookFctEnt(entities,entVar),
210                   access=A.selAcc(dacc, slot),                   access=A.selAcc(dacc, slot),
211                   info=II.selStrInfo (dinfo, slot)}                   prim=POI.selStrPrimId (dinfo, slot)}
212           | _ => bug "mkFctVar - bad spec")           | _ => bug "mkFctVar - bad spec")
213    
214    | getFctElem _ = ERRORfct    | getFctElem _ = ERRORfct
# Line 231  Line 232 
232      (case getSpec(elements, sym) of      (case getSpec(elements, sym) of
233           VALspec{spec,slot} =>           VALspec{spec,slot} =>
234           V.VAL(V.VALvar{access = A.selAcc(dacc,slot),           V.VAL(V.VALvar{access = A.selAcc(dacc,slot),
235                          info = II.selStrInfo (dinfo, slot),                          prim = POI.selValPrimFromStrPrim (dinfo, slot),
236                          path = sp,                          path = sp,
237                          typ = ref(transType entities spec)})                          typ = ref(transType entities spec)})
238         | CONspec{spec=T.DATACON{name, const, typ, rep, sign, lazyp},         | CONspec{spec=T.DATACON{name, const, typ, rep, sign, lazyp},
# Line 257  Line 258 
258            (case newInfo            (case newInfo
259               of STRINFO(newrlzn, newacc, newinfo) =>               of STRINFO(newrlzn, newacc, newinfo) =>
260                  STR{sign=newsig, rlzn=newrlzn, access=newacc,                  STR{sign=newsig, rlzn=newrlzn, access=newacc,
261                      info=newinfo}                      prim=newinfo}
262                | SIGINFO ep => STRSIG{sign=newsig, entPath=rev ep})                | SIGINFO ep => STRSIG{sign=newsig, entPath=rev ep})
263    end    end
264    
# Line 271  Line 272 
272             (case newInfo             (case newInfo
273                of STRINFO (newrlzn, newacc, newinfo) =>                of STRINFO (newrlzn, newacc, newinfo) =>
274                    CONSTstrDef(STR{sign=newsig, rlzn=newrlzn,                    CONSTstrDef(STR{sign=newsig, rlzn=newrlzn,
275                                    access=newacc, info=newinfo})                                    access=newacc, prim=newinfo})
276                 | SIGINFO ep => VARstrDef(newsig, rev ep))                 | SIGINFO ep => VARstrDef(newsig, rev ep))
277    end    end
278    
# Line 286  Line 287 
287          | loop _ = bug "getPath.loop"          | loop _ = bug "getPath.loop"
288    
289     in case str     in case str
290         of STR { sign, rlzn, access, info } =>         of STR { sign, rlzn, access, prim } =>
291            loop(spath, sign, STRINFO(rlzn, access, info))            loop(spath, sign, STRINFO(rlzn, access, prim))
292          | STRSIG{sign, entPath} =>          | STRSIG{sign, entPath} =>
293              loop(spath, sign, SIGINFO (rev entPath))              loop(spath, sign, SIGINFO (rev entPath))
294          | _ => loop(spath, ERRORsig, bogusInfo)          | _ => loop(spath, ERRORsig, bogusInfo)
# Line 409  Line 410 
410   *)   *)
411  fun getBinding (sym, str as STR st) =  fun getBinding (sym, str as STR st) =
412      (case st of      (case st of
413           {sign as SIG _, rlzn, access=dacc, info=dinfo} =>           {sign as SIG _, rlzn, access=dacc, prim=dinfo} =>
414           let val sinfo = STRINFO(rlzn, dacc, dinfo)           let val sinfo = STRINFO(rlzn, dacc, dinfo)
415               val entities = #entities rlzn               val entities = #entities rlzn
416           in           in
# Line 454  Line 455 
455      Used in Elaborator/elaborate/elabmod.sml and      Used in Elaborator/elaborate/elabmod.sml and
456      SigMatch      SigMatch
457   *)   *)
458  fun strPrimElemInBinds [] = StrE []  fun strPrimElemInBinds [] = POI.StrE []
459    | strPrimElemInBinds (bind::rest) =    | strPrimElemInBinds (bind::rest) =
460      let      let
461          val strPrims =          val strPrims =
462             (case bind             (case bind
463               of B.STRbind (M.STR { prim, ... }) => prim               of B.STRbind (M.STR { prim, ... }) => prim
464                | B.FCTbind (M.FCT { prim, ... }) => prim                | B.FCTbind (M.FCT { prim, ... }) => prim
465                | B.VALbind (V.VALvar {info, ...}) => PrimE info                | B.VALbind (V.VALvar {prim, ...}) => POI.PrimE prim
466                | B.CONbind _ => PrimE NonPrim                | B.CONbind _ => POI.PrimE POI.NonPrim
467                | B.TYCbind _  =>                | _  =>
468                    bug "unexpected binding in strPrimElemInBinds")                    bug "unexpected binding in strPrimElemInBinds")
469      in      in
470         (case (strPrimElemInBinds rest) of         (case (strPrimElemInBinds rest) of
471              (StrE restPrims) =>              (POI.StrE restPrims) =>
472                StrE (strPrims :: restPrims)                POI.StrE (strPrims :: restPrims)
473            | PrimE id => StrE (PrimE id))            | POI.PrimE id => POI.StrE ([POI.PrimE id]))
474      end      end (* let *)
475    
476  (* extract all signature names from a structure --  (* extract all signature names from a structure --
477   *  doesn't look into functor components *)   *  doesn't look into functor components *)

Legend:
Removed from v.1958  
changed lines
  Added in v.1959

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0