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/Elaborator/modules/sigmatch.sml
ViewVC logotype

Diff of /sml/branches/primop-branch-2/src/compiler/Elaborator/modules/sigmatch.sml

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

sml/trunk/src/compiler/Elaborator/modules/sigmatch.sml revision 1370, Mon Sep 15 03:38:25 2003 UTC sml/branches/primop-branch-2/src/compiler/Elaborator/modules/sigmatch.sml revision 1952, Thu Jul 6 03:07:18 2006 UTC
# Line 155  Line 155 
155    
156  (* returns true and the new instantiations if actual type > spec type *)  (* returns true and the new instantiations if actual type > spec type *)
157  (* matches an abstract version of a type with its actual version *)  (* matches an abstract version of a type with its actual version *)
158    (**
159  fun absEqvTy (spec, actual, dinfo) : (ty list * tyvar list * ty * bool) =  fun absEqvTy (spec, actual, dinfo) : (ty list * tyvar list * ty * bool) =
160    let val actual = TU.prune actual    let val actual = TU.prune actual
161        val spec = TU.prune spec        val spec = TU.prune spec
# Line 186  Line 187 
187            | _ =>insttys0)            | _ =>insttys0)
188  *)  *)
189        val insttys =        val insttys =
190  (* PRIMOP: ii2ty no longer exists --            case InlInfo.primopTy dinfo of
           case INS.Param.ii2ty dinfo of  
191                SOME st =>                SOME st =>
192                (let val (actinst', insttys') = TU.instantiatePoly st                (let val (actinst', insttys') = TU.instantiatePoly st
193                 in                 in
194                     Unify.unifyTy(actinst', actinst) handle _ => ();                     Unify.unifyTy(actinst', actinst) handle _ => ();
195                     insttys'                     insttys'
196                 end)                 end)
197              | NONE => *) insttys0              | NONE =>insttys0
198    
199        val res = (Unify.unifyTy(actinst, specinst); true) handle _ => false        val res = (Unify.unifyTy(actinst, specinst); true) handle _ => false
200    
201        val instbtvs = map TU.tyvarType insttys0        val instbtvs = map TU.tyvarType insttys0
202        (* should I use stys here instead, why insttys0 ? *)        (* should I use stys here instead?, why insttys0? *)
203    
204     in (insttys, instbtvs, specinst, res)     in (insttys, instbtvs, specinst, res)
205    end    end
206    *)
207    
208    (* dbm: obsolete!
209  fun eqvTnspTy (spec, actual, dinfo) : (ty list * tyvar list) =  fun eqvTnspTy (spec, actual, dinfo) : (ty list * tyvar list) =
210    let val actual = TU.prune actual    let val actual = TU.prune actual
211        val (actinst, insttys) = TU.instantiatePoly actual        val (actinst, insttys) = TU.instantiatePoly actual
# Line 231  Line 233 
233                 end)                 end)
234            | _ =>insttys)            | _ =>insttys)
235  *)  *)
 (* PRIMOP: ii2ty no longer exists ---  
236        val insttys =        val insttys =
237            case INS.Param.ii2ty dinfo of            case InlInfo.primopTy dinfo of
238                SOME st =>                SOME st =>
239                (let val (actinst', insttys') = TU.instantiatePoly st                (let val (actinst', insttys') = TU.instantiatePoly st
240                 in                 in
# Line 241  Line 242 
242                     insttys'                     insttys'
243                 end)                 end)
244              | NONE =>insttys              | NONE =>insttys
245  *)  
246        val (specinst, stys) = TU.instantiatePoly spec        val (specinst, stys) = TU.instantiatePoly spec
247        val _ = ((Unify.unifyTy(actinst, specinst))        val _ = ((Unify.unifyTy(actinst, specinst))
248                 handle _ => bug "unexpected types in eqvTnspTy")                 handle _ => bug "unexpected types in eqvTnspTy")
# Line 249  Line 250 
250    
251     in (insttys, btvs)     in (insttys, btvs)
252    end    end
253    *)
254    
255  (**************************************************************************  (**************************************************************************
256   *                                                                        *   *                                                                        *
# Line 270  Line 271 
271                                        elements=strElements,...},                                        elements=strElements,...},
272                             rlzn as {stamp=strStamp,entities=strEntEnv,...},                             rlzn as {stamp=strStamp,entities=strEntEnv,...},
273                             access = rootAcc, info = rootInfo },                             access = rootAcc, info = rootInfo },
274                strName : S.symbol, depth, matchEntEnv,                strName : S.symbol,
275                epath: EP.entVar list, rpath: IP.path, statenv, region,                depth, matchEntEnv,
276                compInfo as {mkStamp, mkLvar=mkv, error, ...}: EU.compInfo) = let                epath: EP.entVar list,
277                  rpath: IP.path,
278                  statenv,
279                  region,
280                  compInfo as {mkStamp, mkLvar=mkv, error, ...}: EU.compInfo) =
281    let
282    
283  val err = error region  val err = error region
284  val _ = let fun h pps sign =PPModules.ppSignature pps (sign,statenv,6)  val _ = let fun h pps sign =PPModules.ppSignature pps (sign,statenv,6)
# Line 280  Line 286 
286           in debugPrint (showsigs) (s, h, specSig)           in debugPrint (showsigs) (s, h, specSig)
287          end          end
288    
289  fun matchTypes (spec, actual, dinfo, name) : (T.ty list * T.tyvar list) =  (* dbm: we want matchTypes to produce:
290    if TU.compareTypes(spec, actual) then   (1) the actual type generic instantiation metavariables,
291         let val (insttys, btvs) = eqvTnspTy(spec, actual, dinfo)   (2) the spec type generic instantiation metavariables,
292          in (insttys, btvs)  So that matchTypes products can be used where matchTypes1 is called below.
293         end  It should prune (if necessary).
294    Test for whether actual type was a polytype reduces to testing whether
295    actual type produces and generic instantiation metavariables (i.e. null test).
296    
297      gk: compareTypes does pruning.
298    *)
299    
300      fun matchTypes (spec, actual, dinfo, name) : bool =
301          TU.compareTypes(spec, actual)
302    (*    if TU.compareTypes(spec, actual) then eqvTnspTy(spec, actual, dinfo) *)
303    else (err EM.COMPLAIN    else (err EM.COMPLAIN
304              "value type in structure doesn't match signature spec"              "value type in structure doesn't match signature spec"
305              (fn ppstrm =>              (fn ppstrm =>
# Line 348  Line 363 
363                          DATATYPE{index=index', family={members=members',...},                          DATATYPE{index=index', family={members=members',...},
364                                   ...} =>                                   ...} =>
365                          let val specDconSig = #dcons(Vector.sub(members,index))                          let val specDconSig = #dcons(Vector.sub(members,index))
366                              val strDconSig =                                val strDconSig = #dcons(Vector.sub(members',index'))
                                 #dcons(Vector.sub(members',index'))  
367                              val specnames = map #name specDconSig                              val specnames = map #name specDconSig
368                              val strnames = map #name strDconSig                              val strnames = map #name strDconSig
369    
# Line 843  Line 857 
857                     let val spectyp = typeInMatched("$specty(val/val)", spectyp)                     let val spectyp = typeInMatched("$specty(val/val)", spectyp)
858                         val acttyp = typeInOriginal("$actty(val/val)", acttyp)                         val acttyp = typeInOriginal("$actty(val/val)", acttyp)
859                         val dacc = DA.selAcc(rootAcc, actslot)                         val dacc = DA.selAcc(rootAcc, actslot)
860                         val dinfo = II.sel(rootInfo, actslot)                           val dinfo = II.selStrInfo(rootInfo, actslot)
861                         val (instys,btvs) =                           val _ =
862                           matchTypes(spectyp, acttyp, dinfo, sym)                             matchTypes(spectyp, acttyp, (* dinfo, dbm *) sym)
863    
864                         val spath = SP.SPATH[sym]                         val spath = SP.SPATH[sym]
865                         val actvar = VALvar{path=spath, typ=ref acttyp,                         val actvar = VALvar{path=spath, typ=ref acttyp,
866                                             access=dacc, info=dinfo}                                             access=dacc, info=dinfo}
867    
868                         val (decs', nv) =                         val (decs', nv) =
869                           case (TU.headReduceType acttyp,                             case TU.prune(TU.headReduceType acttyp)
870                                 TU.headReduceType spectyp)                               of POLYty _ =>
871                            of ((POLYty _, _) | (_, POLYty _))=>                                  let val (actinst, actParamTvs) =
872                                let val acc = DA.namedAcc(sym, mkv)                                          TU.instantiatePoly actual
873                                        val (specinst, specGenericTvs) =
874                                            TU.instantiatePoly spec
875                                        val _ = matchTypes1(actinst,specinst)
876                                        (* dbm: this is a variation on what the
877                                                original matchTypes does, so it
878                                                should be folded into that function *)
879                                        val acc = DA.namedAcc(sym, mkv)
880                                    val specvar =                                    val specvar =
881                                      VALvar{path=spath, typ=ref spectyp,                                      VALvar{path=spath, typ=ref spectyp,
882                                             access=acc, info=dinfo}                                             access=acc, info=dinfo}
883                                    val vb =                                    val vb =
884                                      A.VB {pat=A.VARpat specvar,                                      A.VB {pat=A.VARpat specvar,
885                                            exp=A.VARexp(ref actvar, instys),                                              exp=A.VARexp(ref actvar, actParamTvs),
886                                            boundtvs=btvs, tyvars=ref []}                                              boundtvs=specGenericTvs, tyvars=ref []}
887    
888                                 in ((A.VALdec [vb])::decs, specvar)                                 in ((A.VALdec [vb])::decs, specvar)
889                                end                                end

Legend:
Removed from v.1370  
changed lines
  Added in v.1952

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