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/trunk/src/compiler/Semant/statenv/lookup.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/Semant/statenv/lookup.sml

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

revision 586, Thu Mar 30 05:08:07 2000 UTC revision 587, Thu Mar 30 09:01:52 2000 UTC
# Line 13  Line 13 
13        structure A = Access        structure A = Access
14        structure V = VarCon        structure V = VarCon
15        structure B = Bindings        structure B = Bindings
       structure E = Env  
16        structure SE = StaticEnv        structure SE = StaticEnv
17        structure EM = ErrorMsg        structure EM = ErrorMsg
18        structure S = Symbol        structure S = Symbol
# Line 38  Line 37 
37    
38  (*** look for a fixity binding ***)  (*** look for a fixity binding ***)
39  fun lookFix (env,id) : Fixity.fixity =  fun lookFix (env,id) : Fixity.fixity =
40    let val b = case E.look(env,id)    let val b = case SE.look(env,id)
41                 of B.FIXbind fixity => fixity                 of B.FIXbind fixity => fixity
42                  | _ => bug "lookFIX"                  | _ => bug "lookFIX"
43     in b     in b
44    end handle E.Unbound => Fixity.NONfix    end handle SE.Unbound => Fixity.NONfix
45    
46  (*** look for a signature ***)  (*** look for a signature ***)
47  fun lookSig (env,id,err) : M.Signature =  fun lookSig (env,id,err) : M.Signature =
48    let val b = case Env.look(env,id)    let val b = case SE.look(env,id)
49                 of B.SIGbind sign => sign                 of B.SIGbind sign => sign
50                  | _ => bug "lookSIG"                  | _ => bug "lookSIG"
51     in b     in b
52    end handle Env.Unbound => (unboundError(id,"",err); M.ERRORsig)    end handle SE.Unbound => (unboundError(id,"",err); M.ERRORsig)
53    
54  (*** look for a functor signature ***)  (*** look for a functor signature ***)
55  fun lookFsig (env,id,err) : M.fctSig =  fun lookFsig (env,id,err) : M.fctSig =
56    let val b = case Env.look(env,id)    let val b = case SE.look(env,id)
57                 of B.FSGbind fs => fs                 of B.FSGbind fs => fs
58                  | _ => bug "lookFSIG"                  | _ => bug "lookFSIG"
59     in b     in b
60    end handle Env.Unbound => (unboundError(id,"",err); M.ERRORfsig)    end handle SE.Unbound => (unboundError(id,"",err); M.ERRORfsig)
61    
62  (*** look for a variable or a constructor bound to a symbol ***)  (*** look for a variable or a constructor bound to a symbol ***)
63  fun lookValSym (env,sym,err) : V.value =  fun lookValSym (env,sym,err) : V.value =
# Line 78  Line 77 
77   *   2. actual structure environments   *   2. actual structure environments
78   *   3. signature parsing environments   *   3. signature parsing environments
79   *)   *)
80  fun lookGen(env,spath as SP.SPATH(first::rest),outBind,getPath,errorVal,err) =  fun lookGen(env,spath,outBind,getPath,errorVal,err) =
81        (case spath      case spath of
82          of SP.SPATH [id] =>          SP.SPATH [id] =>
83              (outBind(SE.look(env,id))              (outBind(SE.look(env,id))
84              handle SE.Unbound => (unboundError(id,spmsg spath,err); errorVal))              handle SE.Unbound => (unboundError(id,spmsg spath,err); errorVal))
85           | SP.SPATH(first::rest) =>           | SP.SPATH(first::rest) =>
# Line 91  Line 90 
90                        (unboundError(sym,spmsg spath,err); errorVal))                        (unboundError(sym,spmsg spath,err); errorVal))
91                  | _ =>  bug "lookGen1")                  | _ =>  bug "lookGen1")
92              handle SE.Unbound => (unboundError(first,spmsg spath,err);              handle SE.Unbound => (unboundError(first,spmsg spath,err);
93                                    errorVal)))                                 errorVal))
94    | lookGen _ = bug "lookGen2"        | SP.SPATH [] => bug "lookGen:SP.SPATH[]"
95    
96  (*** look for a variable or a constructor (complete path) ***)  (*** look for a variable or a constructor (complete path) ***)
97  fun lookVal(env,path,err) : V.value =  fun lookVal(env,path,err) : V.value =
# Line 111  Line 110 
110    
111  (*** look for a strDef; used in elabsig.sml ***)  (*** look for a strDef; used in elabsig.sml ***)
112  fun lookStrDef(env,path,err) : M.strDef =  fun lookStrDef(env,path,err) : M.strDef =
113    let fun outSD(B.STRbind(M.STRSIG{sign,entPath})) = M.VARstrDef(sign,entPath)    let fun outSD(B.STRbind s) =
114          | outSD(B.STRbind s) = M.CONSTstrDef s            (case s of
115                   M.STRSIG{sign,entPath} => M.VARstrDef(sign,entPath)
116                 | sv => M.CONSTstrDef sv)
117          | outSD _ = bug "lookStrDef"          | outSD _ = bug "lookStrDef"
118     in lookGen(env,path,outSD,MU.getStrDef,M.CONSTstrDef bogusSTR,err)     in lookGen(env,path,outSD,MU.getStrDef,M.CONSTstrDef bogusSTR,err)
119    end    end

Legend:
Removed from v.586  
changed lines
  Added in v.587

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