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 1946, Tue Jun 20 22:15:23 2006 UTC revision 1957, Thu Jul 6 22:28:24 2006 UTC
# Line 7  Line 7 
7  local structure S   = Symbol  local structure S   = Symbol
8        structure SP  = SymPath        structure SP  = SymPath
9        structure IP  = InvPath        structure IP  = InvPath
       structure II = InlInfo  
10        structure CVP = ConvertPaths        structure CVP = ConvertPaths
11        structure EP  = EntPath        structure EP  = EntPath
12        structure EPC = EntPathContext        structure EPC = EntPathContext
# Line 79  Line 78 
78          (case EE.look(entEnv,entVar)          (case EE.look(entEnv,entVar)
79            of STRent entity =>            of STRent entity =>
80                 (STR{sign = sign, rlzn = entity, access = A.selAcc(dacc,slot),                 (STR{sign = sign, rlzn = entity, access = A.selAcc(dacc,slot),
81                      info = II.selStrInfo (dinfo, slot)},                      prim = PrimOpId.selStrPrimId (dinfo, slot)},
82                  entVar)                  entVar)
83             | _ => bug "getStr: bad entity")             | _ => bug "getStr: bad entity")
84       | _ => bug "getStr: wrong spec"       | _ => bug "getStr: wrong spec"
# Line 91  Line 90 
90          (case EE.look(entEnv,entVar)          (case EE.look(entEnv,entVar)
91            of FCTent entity =>            of FCTent entity =>
92                 (FCT{sign = sign, rlzn = entity, access = A.selAcc(dacc,slot),                 (FCT{sign = sign, rlzn = entity, access = A.selAcc(dacc,slot),
93                      info = II.selStrInfo (dinfo, slot)},                      prim = PrimOpId.selStrPrimId (dinfo, slot)},
94                  entVar)                  entVar)
95             | _ => bug "getFct: bad entity")             | _ => bug "getFct: bad entity")
96       | _ => bug "getFct: wrong spec"       | _ => bug "getFct: wrong spec"
# Line 107  Line 106 
106    | getStrName ERRORstr = errorStrName    | getStrName ERRORstr = errorStrName
107    | getStrName _ = bug "getStrName"    | getStrName _ = bug "getStrName"
108    
109  fun getStrs (STR { sign = SIG sg, rlzn = {entities,...}, access,info,...}) =  fun getStrs (STR { sign = SIG sg, rlzn = {entities,...}, access,prim,...}) =
110      let val elements = #elements sg      let val elements = #elements sg
111      in      in
112          List.mapPartial          List.mapPartial
# Line 115  Line 114 
114                  SOME(STR{sign = sign,                  SOME(STR{sign = sign,
115                           rlzn = EE.lookStrEnt(entities,entVar),                           rlzn = EE.lookStrEnt(entities,entVar),
116                           access = A.selAcc(access, slot),                           access = A.selAcc(access, slot),
117                           info = II.selStrInfo (info, slot)})                           prim = PrimOpId.selStrPrimId (prim, slot)})
118                | _ => NONE)                | _ => NONE)
119              elements              elements
120      end      end
# Line 175  Line 174 
174  fun strDefToStr(CONSTstrDef str, _) = str  fun strDefToStr(CONSTstrDef str, _) = str
175    | strDefToStr(VARstrDef(sign,entPath), entEnv) =    | strDefToStr(VARstrDef(sign,entPath), entEnv) =
176      STR{sign=sign,rlzn=EE.lookStrEP(entEnv,entPath),      STR{sign=sign,rlzn=EE.lookStrEP(entEnv,entPath),
177          access=A.nullAcc, info=II.nullInfo}          access=A.nullAcc, info=StrE []}
178    
179  (*  (*
180   * two pieces of essential structure information gathered during   * two pieces of essential structure information gathered during
# Line 449  Line 448 
448     in SE.atop(nenv,env)     in SE.atop(nenv,env)
449    end    end
450    
451  (** extract inl_info from a list of bindings *)  (** Get a strPrimElem with all the primIds found in
452  fun extractInfo(B.STRbind (M.STR { info, ... })) = info      a list of bindings
453    | extractInfo(B.FCTbind (M.FCT { info, ... })) = info  
454    | extractInfo(B.VALbind (V.VALvar {info, ...})) = info      Used in Elaborator/elaborate/elabmod.sml and
455    | extractInfo(B.CONbind _) = II.nullInfo      SigMatch
456    | extractInfo _ = bug "unexpected binding in extractInfo"   *)
457    fun strPrimElemInBinds [] = StrE []
458      | strPrimElemInBinds (bind::rest) =
459        let
460            val strPrims =
461               (case bind
462                 of B.STRbind (M.STR { prim, ... }) => prim
463                  | B.FCTbind (M.FCT { prim, ... }) => prim
464                  | B.VALbind (V.VALvar {info, ...}) => PrimE info
465                  | B.CONbind _ => PrimE NonPrim
466                  | B.TYCbind _  =>
467                      bug "unexpected binding in strPrimElemInBinds")
468        in
469           (case (strPrimElemInBinds rest) of
470                (StrE restPrims) =>
471                  StrE (strPrims :: restPrims)
472              | PrimE id => StrE (PrimE id))
473        end
474    
475  (* extract all signature names from a structure --  (* extract all signature names from a structure --
476   *  doesn't look into functor components *)   *  doesn't look into functor components *)

Legend:
Removed from v.1946  
changed lines
  Added in v.1957

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