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-3/compiler/FLINT/trans/fctkind.sml
ViewVC logotype

Diff of /sml/branches/primop-branch-3/compiler/FLINT/trans/fctkind.sml

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

revision 3387, Tue May 26 06:44:22 2009 UTC revision 3388, Tue May 26 19:00:15 2009 UTC
# Line 9  Line 9 
9    
10  signature FCTKIND =  signature FCTKIND =
11  sig  sig
12    val fsigToTkind : Absyn.dec CompInfo.compInfo -> Modules.fctSig * EntityEnv.entityEnv    val fsigToKnd : ElabUtil.compInfo
13                      -> {sign:Modules.fctSig, entEnv: EntityEnv.entityEnv}
14                      -> PLambdaType.tkind                      -> PLambdaType.tkind
15    val primaryToBind : Absyn.dec CompInfo.compInfo * EntityEnv.entityEnv    val primaryToBind : ElabUtil.compInfo * EntityEnv.entityEnv
16                        -> Modules.primary -> Stamps.stamp * PLambdaType.tkind                        -> Modules.primary -> Stamps.stamp * PLambdaType.tkind
17  end  end
18    
# Line 24  Line 25 
25        structure PT = PLambdaType        structure PT = PLambdaType
26        structure EE = EntityEnv        structure EE = EntityEnv
27        structure INS = Instantiate        structure INS = Instantiate
       structure LT = LtyExtern  
28    
29        fun bug msg = ErrorMsg.impossible ("FctKind: " ^ msg)        fun bug msg = ErrorMsg.impossible ("FctKind: " ^ msg)
30     in     in
31    
   
 fun tycToKind tyc = PT.tkc_int(TypesUtil.tyconArity tyc)  
   
32  fun getEntEnv (entities: EntityEnv.entityEnv,[]) =  fun getEntEnv (entities: EntityEnv.entityEnv,[]) =
33      entities  (* top-level functor element *)      entities  (* top-level functor element *)
34    | getEntEnv (entities, ep) =    | getEntEnv (entities, ep) =
# Line 48  Line 45 
45                     entEnv} =                     entEnv} =
46      let val region=SourceMap.nullRegion  (* dummy region, required by instFormal *)      let val region=SourceMap.nullRegion  (* dummy region, required by instFormal *)
47          val rpath=InvPath.empty (* dummy rpath, required by instFormal *)          val rpath=InvPath.empty (* dummy rpath, required by instFormal *)
48          val {rlzn=paramRlzn, primaries=(parTycs,parFcts)} =          val {rlzn=paramRlzn, primaries=parPrimaries} =
49              INS.instFormal{sign=paramsig, entEnv=entEnv,              INS.instFormal{sign=paramsig, entEnv=entEnv,
50                         rpath=rpath, region=region, compInfo=compInfo}                         rpath=rpath, region=region, compInfo=compInfo}
51    
52          val entEnvBody = EE.bind(paramvar, STRent paramRlzn, entEnv))          val entEnvBody = EE.bind(paramvar, M.STRent paramRlzn, entEnv)
53    
54          val {rlzn=bodyRlzn, primaries=(bodyTycs,bodyFcts)} =          val {rlzn=bodyRlzn, primaries=bodyPrimaries} =
55              INS.instFormal{sign=bodysig, entEnv=entEnvBody,              INS.instFormal{sign=bodysig, entEnv=entEnvBody,
56                         rpath=rpath, region=region, compInfo=compInfo}                         rpath=rpath, region=region, compInfo=compInfo}
57    
# Line 63  Line 60 
60           * for formal functor components, we have to recurse *)           * for formal functor components, we have to recurse *)
61    
62          (* can directly compute the tyc kinds from the primary tycs *)          (* can directly compute the tyc kinds from the primary tycs *)
         val paramTycTks = map tycToKind parTycs  
         val bodyTycTks = map tycToKind bodyTycs  
   
63          (* for primary fcts in param and body, we need to pass appropriate          (* for primary fcts in param and body, we need to pass appropriate
64           * entEnvs, providing the right context for the fsig.  This will be           * entEnvs, providing the right context for the fsig.  This will be
65           * the entities field of the rlzn of the immediately enclosing str. *)           * the entities field of the rlzn of the immediately enclosing str. *)
         val parFctTks = map (entPathToKind paramRlzn) paramFcts  
         val bodyFctTks = map (entPathToKind bodyRlzn) bodyFcts  
66    
67       in PT.tkc_fun(parTycTks @ parFctTks, PT.tkc_seq (bodyTycTks @ bodyFctTycs)          val parPrimaryKnds =
68                map (fn (M.PrimaryTyc(x),_,_) => PT.tkc_int x
69                      | (M.PrimaryFct(fsg),_,ep) => entPathToKind paramRlzn (fsg,ep))
70                    parPrimaries
71    
72            val bodyPrimaryKnds =
73                map (fn (M.PrimaryTyc(x),_,_) => PT.tkc_int x
74                      | (M.PrimaryFct(fsg),_,ep) => entPathToKind bodyRlzn (fsg,ep))
75                    bodyPrimaries
76    
77    
78         in PT.tkc_fun(parPrimaryKnds,
79                       PT.tkc_seq bodyPrimaryKnds)
80      end      end
81    | fsigToKnd' _ = PT.tkc_fun([], PT.tkc_seq [])    | fsigToKnd' _ = PT.tkc_fun([], PT.tkc_seq [])
82        (* one of paramsig or bodysig is ERRORsig *)        (* one of paramsig or bodysig is ERRORsig *)
83    
84  and entPathToKind ({entities,...}: M.strEntity)  and entPathToKind ({entities,...}: M.strEntity)
85                    (_, fsig, entPath) =                    (fsig, entPath) =
86      (* 1. look up the entPath in the signature (how?).      (* 1. look up the entPath in the signature (how?).
87         2. if the entity determined by the entPath is *)         2. if the entity determined by the entPath is *)
88      fsigToKnd'(fsig,getEntEnv(entities,entPath))      fsigToKnd'{sign=fsig,entEnv=getEntEnv(entities,entPath)}
89    
90   in fsigToKnd'   in fsigToKnd'
91  end  end
92    
93  fun primaryToBind (compInfo, entEnv: EE.entityEnv)  fun primaryToBind (compInfo, entEnv: EE.entityEnv)
94                    (M.PrimaryTyc arity, stamp, _) =                    (M.PrimaryTyc arity, stamp, _) =
95      (stamp, LT.tkc_int arity)      (stamp, PT.tkc_int arity)
96    | primaryToBind (compInfo,entEnv) (M.PrimaryFct fsig, stamp, ep) =    | primaryToBind (compInfo,entEnv) (M.PrimaryFct fsig, stamp, ep) =
97      (stamp, fsigToKnd compInfo (fsig, getEntEnv(entEnv,ep)))      (stamp, fsigToKnd compInfo {sign=fsig, entEnv=getEntEnv(entEnv,ep)})
   | primaryToBind (compInfo,entEnv) _ = bug "primaryToKnd"  
98    
99     end (* local *)     end (* local *)
100  end (* structure FctKind *)  end (* structure FctKind *)

Legend:
Removed from v.3387  
changed lines
  Added in v.3388

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