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

revision 1952, Thu Jul 6 03:07:18 2006 UTC revision 1961, Fri Jul 7 21:06:11 2006 UTC
# Line 286  Line 286 
286             in debugPrint (showsigs) (s, h, specSig)             in debugPrint (showsigs) (s, h, specSig)
287            end            end
288    
289  (* dbm: we want matchTypes to produce:    (* matchTypes checks whether the spec type is a generic instance of
290   (1) the actual type generic instantiation metavariables,     * the actual type, and if so it returns two lists of type metavariables (tyvars):
291   (2) the spec type generic instantiation metavariables,     *  (1) the spec type generic instantiation metavariables (btvs),
292  So that matchTypes products can be used where matchTypes1 is called below.     *  (2) the actual type generic instantiation metavariables (ptvs).
293  It should prune (if necessary).     * In the matching, the btvs variables are not instantiated, while the
294  Test for whether actual type was a polytype reduces to testing whether     * ptvs are always instantiated, and their instantiations constitute the
295  actual type produces and generic instantiation metavariables (i.e. null test).     * "parameters of instantiatiation" that make the actual type agree with
296       * the (generic instance of the) spec. The parameter instantiations will
297    gk: compareTypes does pruning.     * contain types containing occurrences of the bound tyvars.
298       * If the actual is not a polytype, the ptvs list is nil. Similarly for
299       * the spec type and btvs. If both spec and actual are monotypes, the
300       * matching is equivalent to equalTypes(spec,actual). [dbm: 7/7/06]
301  *)  *)
302      fun matchTypes (spec, actual, name) : T.tyvar list * T.tyvar list =
303    fun matchTypes (spec, actual, dinfo, name) : bool =        case TU.matchInstTypes(spec, actual)
304        TU.compareTypes(spec, actual)         of SOME(btvs,ptvs) => (btvs,ptvs)
305  (*    if TU.compareTypes(spec, actual) then eqvTnspTy(spec, actual, dinfo) *)          | NONE =>
306      else (err EM.COMPLAIN            (err EM.COMPLAIN
307                "value type in structure doesn't match signature spec"                "value type in structure doesn't match signature spec"
308                (fn ppstrm =>                (fn ppstrm =>
309                     (PPType.resetPPType();                     (PPType.resetPPType();
# Line 857  Line 860 
860                       let val spectyp = typeInMatched("$specty(val/val)", spectyp)                       let val spectyp = typeInMatched("$specty(val/val)", spectyp)
861                           val acttyp = typeInOriginal("$actty(val/val)", acttyp)                           val acttyp = typeInOriginal("$actty(val/val)", acttyp)
862                           val dacc = DA.selAcc(rootAcc, actslot)                           val dacc = DA.selAcc(rootAcc, actslot)
863                           val dinfo = II.selStrInfo(rootInfo, actslot)                           val prim = PrimOpId.selStrPrimId(rootInfo, actslot)
864                           val _ =                           val (btvs,ptvs) = matchTypes(spectyp, acttyp, sym)
                            matchTypes(spectyp, acttyp, (* dinfo, dbm *) sym)  
865    
866                           val spath = SP.SPATH[sym]                           val spath = SP.SPATH[sym]
867                           val actvar = VALvar{path=spath, typ=ref acttyp,                           val actvar = VALvar{path=spath, typ=ref acttyp,
868                                               access=dacc, info=dinfo}                                               access=dacc, prim=prim}
869    
870                           val (decs', nv) =                           val (decs', nv) =
871                             case TU.prune(TU.headReduceType acttyp)                               case ptvs
872                               of POLYty _ =>                                 of [] => (decs, actvar) (* acttyp is mono *)
873                                  let val (actinst, actParamTvs) =                                  | _ =>
874                                          TU.instantiatePoly actual                                    let val acc = DA.namedAcc(sym, mkv)
                                     val (specinst, specGenericTvs) =  
                                         TU.instantiatePoly spec  
                                     val _ = matchTypes1(actinst,specinst)  
                                     (* dbm: this is a variation on what the  
                                             original matchTypes does, so it  
                                             should be folded into that function *)  
                                     val acc = DA.namedAcc(sym, mkv)  
875                                      val specvar =                                      val specvar =
876                                        VALvar{path=spath, typ=ref spectyp,                                        VALvar{path=spath, typ=ref spectyp,
877                                               access=acc, info=dinfo}                                                 access=acc, prim=prim}
878                                      val vb =                                      val vb =
879                                        A.VB {pat=A.VARpat specvar,                                        A.VB {pat=A.VARpat specvar,
880                                              exp=A.VARexp(ref actvar, actParamTvs),                                                exp=A.VARexp(ref actvar, ptvs),
881                                              boundtvs=specGenericTvs, tyvars=ref []}                                                boundtvs=btvs, tyvars=ref []}
   
882                                   in ((A.VALdec [vb])::decs, specvar)                                   in ((A.VALdec [vb])::decs, specvar)
883                                  end                                  end
                              | _ => (decs, actvar)  
884    
885                           val bindings' = (B.VALbind nv)::bindings                           val bindings' = (B.VALbind nv)::bindings
886    
# Line 898  Line 891 
891                                             rep, sign, lazyp}, slot} =>                                             rep, sign, lazyp}, slot} =>
892                       let val spectyp = typeInMatched("$specty(val/con)", spectyp)                       let val spectyp = typeInMatched("$specty(val/con)", spectyp)
893                           val acttyp = typeInOriginal("$actty(val/con)", acttyp)                           val acttyp = typeInOriginal("$actty(val/con)", acttyp)
894                           val (instys, btvs) =                           val (boundtvs,paramtvs) =
895                             matchTypes(spectyp, acttyp, II.Null, name)                               matchTypes(spectyp, acttyp, name)
896    
897                           val nrep =                           val nrep =
898                             case slot                             case slot
# Line 913  Line 906 
906                                 val acc = DA.namedAcc(name, mkv)                                 val acc = DA.namedAcc(name, mkv)
907                                 val specvar =                                 val specvar =
908                                   VALvar{path=SP.SPATH[name], access=acc,                                   VALvar{path=SP.SPATH[name], access=acc,
909                                          info=II.Null,                                          prim=PrimOpId.NonPrim,
910                                          typ=ref spectyp}                                          typ=ref spectyp}
911                                 val vb =                                 val vb =
912                                   A.VB {pat=A.VARpat specvar,                                   A.VB {pat=A.VARpat specvar,
913                                         exp=A.CONexp(con, instys),                                         exp=A.CONexp(con, paramtvs),
914                                         boundtvs=btvs, tyvars=ref []}                                         boundtvs=boundtvs, tyvars=ref []}
915                              in ((A.VALdec [vb])::decs,                              in ((A.VALdec [vb])::decs,
916                                  (B.VALbind specvar)::bindings)                                  (B.VALbind specvar)::bindings)
917                             end                             end
# Line 937  Line 930 
930                       if (DA.isExn specrep) = (DA.isExn actrep) then                       if (DA.isExn specrep) = (DA.isExn actrep) then
931                       let val spectyp = typeInMatched("$specty(con/con)", spectyp)                       let val spectyp = typeInMatched("$specty(con/con)", spectyp)
932                           val acttyp = typeInOriginal("$actty(con/con)", acttyp)                           val acttyp = typeInOriginal("$actty(con/con)", acttyp)
933                           val _ = matchTypes(spectyp, acttyp, II.Null, name)                           val _ = matchTypes(spectyp, acttyp, name)
934    
935                           val bindings' =                           val bindings' =
936                             case slot                             case slot
# Line 1300  Line 1293 
1293                (let val restyp = typeInRes("$spec-resty(packStr-val)", spectyp)                (let val restyp = typeInRes("$spec-resty(packStr-val)", spectyp)
1294                     val srctyp = typeInSrc("$spec-srcty(packStr-val)", spectyp)                     val srctyp = typeInSrc("$spec-srcty(packStr-val)", spectyp)
1295                     val dacc = DA.selAcc(rootAcc, s)                     val dacc = DA.selAcc(rootAcc, s)
1296                     val dinfo = II.sel(rootInfo, s)                     val dinfo = PrimOpId.selStrPrimId(rootInfo, s)
1297                     val (instys, btvs, resinst, eqflag) =                     val (instys, btvs, resinst, eqflag) =
1298                       absEqvTy(restyp, srctyp, dinfo)                       absEqvTy(restyp, srctyp, dinfo)
1299    
1300                     val spath = SP.SPATH[sym]                     val spath = SP.SPATH[sym]
1301                     val srcvar = VALvar{path=spath, typ=ref srctyp,                     val srcvar = VALvar{path=spath, typ=ref srctyp,
1302                                         access=dacc, info=dinfo}                                         access=dacc, prim=dinfo}
1303    
1304                     val (decs', nv) =                     val (decs', nv) =
1305                       if eqflag then (decs, srcvar)                       if eqflag then (decs, srcvar)
1306                       else (let val acc = DA.namedAcc(sym, mkv)                       else (let val acc = DA.namedAcc(sym, mkv)
1307                                 val resvar =                                 val resvar =
1308                                   VALvar{path=spath, typ=ref restyp,                                   VALvar{path=spath, typ=ref restyp,
1309                                          access=acc, info=II.Null}                                          access=acc, prim=PrimOpId.NonPrim}
1310    
1311                                 val ntycs = TU.filterSet(resinst, abstycs)                                 val ntycs = TU.filterSet(resinst, abstycs)
1312                                 val exp =                                 val exp =

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

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