Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Tracker SCM

SCM Repository

[smlnj] Diff of /sml/branches/SMLNJ/src/compiler/Semant/modules/sigmatch.sml
ViewVC logotype

Diff of /sml/branches/SMLNJ/src/compiler/Semant/modules/sigmatch.sml

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

revision 105, Thu May 28 21:30:17 1998 UTC revision 106, Thu May 28 21:30:17 1998 UTC
# Line 354  Line 354 
354  fun lookStr (elements,entEnv) (SP.SPATH spath) : (M.Signature * M.entity) =  fun lookStr (elements,entEnv) (SP.SPATH spath) : (M.Signature * M.entity) =
355    let fun loop ([sym],elements,entEnv) =    let fun loop ([sym],elements,entEnv) =
356              ((case MU.getSpec(elements,sym)              ((case MU.getSpec(elements,sym)
357                 of STRspec{entVar,sign,...} => (sign,EE.look(entEnv,entVar))                 of STRspec{entVar,sign,...} =>
358                       (debugmsg ("$lookStr.1: "^S.name sym^", "^EP.entVarToString entVar);
359                       (sign,EE.look(entEnv,entVar)))
360                  | _ => bug "looStr 1b")                  | _ => bug "looStr 1b")
361                handle MU.Unbound _ => bug "lookStr 1c")                handle MU.Unbound _ => bug "lookStr 1c")
362    
# Line 362  Line 364 
364              ((case MU.getSpec(elements,sym)              ((case MU.getSpec(elements,sym)
365                 of STRspec{sign=SIG{elements,...},entVar,...} =>                 of STRspec{sign=SIG{elements,...},entVar,...} =>
366                      (case EE.look(entEnv,entVar)                      (case EE.look(entEnv,entVar)
367                        of STRent{entities,...} => loop(rest,elements,entities)                        of STRent{entities,...} =>
368                       (debugmsg ("$lookStr.2: "^S.name sym^", "^EP.entVarToString entVar);                   loop(rest,elements,entities))
369                         | ERRORent => (ERRORsig,ERRORent)                         | ERRORent => (ERRORsig,ERRORent)
370                         | _ => bug "lookStr 2a")                         | _ => bug "lookStr 2a")
371                  | _ => bug "lookStr 2b")                  | _ => bug "lookStr 2b")
# Line 439  Line 442 
442                        STRent{stamp=s2,entities=ee2,...}) =>                        STRent{stamp=s2,entities=ee2,...}) =>
443                        if ST.eq(s1,s2) then () (* shortcut! *)                        if ST.eq(s1,s2) then () (* shortcut! *)
444                        else if MU.eqSign(sign1,sign2) then                        else if MU.eqSign(sign1,sign2) then
445                               let val SIG{elements,...} = sign1                               let val _ = debugmsg "$compStr: equal signs"
446                                     val SIG{elements,...} = sign1
447                                in for elements (fn                                in for elements (fn
448                                      (sym,TYCspec{entVar,...}) =>                                      (sym,TYCspec{entVar,...}) =>
449                                        let val TYCent tyc1 = EE.look(ee1,entVar)                                        let val TYCent tyc1 = EE.look(ee1,entVar)
# Line 459  Line 463 
463                                    | _ => ())                                    | _ => ())
464                               end                               end
465                             else                             else
466                               let val common = commonElements(sign1,sign2)                               let val _ = debugmsg "$compStr: unequal signs"
467                                     val common = commonElements(sign1,sign2)
468                                in for common (fn                                in for common (fn
469                                     (sym,TYCspec{entVar=v1,...},                                     (sym,TYCspec{entVar=v1,...},
470                                          TYCspec{entVar=v2,...}) =>                                          TYCspec{entVar=v2,...}) =>
# Line 475  Line 480 
480                                          STRspec{entVar=v2,sign=sign2',...}) =>                                          STRspec{entVar=v2,sign=sign2',...}) =>
481                                        let val str1 = EE.look(ee1,v1)                                        let val str1 = EE.look(ee1,v1)
482                                            val str2 = EE.look(ee2,v2)                                            val str2 = EE.look(ee2,v2)
483                                         in compStr((SP.extend(p1,sym),(sign1,str1)),                                         in compStr((SP.extend(p1,sym),(sign1',str1)),
484                                                    (SP.extend(p2,sym),(sign1,str2)))                                                    (SP.extend(p2,sym),(sign1',str2)))
485                                        end                                        end
486                                   | _ => ()) (* values, constructors, functors *)                                   | _ => ()) (* values, constructors, functors *)
487                               end                               end
# Line 788  Line 793 
793                     end                     end
794    
795                    | CONspec{spec=DATACON{typ=acttyp, name, const,                    | CONspec{spec=DATACON{typ=acttyp, name, const,
796                                           rep, sign}, slot} =>                                           rep, sign, lazyp}, slot} =>
797                     let val spectyp = typeInMatched("$specty(val/con)", spectyp)                     let val spectyp = typeInMatched("$specty(val/con)", spectyp)
798                         val acttyp = typeInOriginal("$actty(val/con)", acttyp)                         val acttyp = typeInOriginal("$actty(val/con)", acttyp)
799                         val (instys, btvs) =                         val (instys, btvs) =
# Line 802  Line 807 
807                         val (decs', bindings') =                         val (decs', bindings') =
808                           let val con =                           let val con =
809                                 DATACON{typ=acttyp, name=name, const=const,                                 DATACON{typ=acttyp, name=name, const=const,
810                                         rep=nrep, sign=sign}                                         rep=nrep, sign=sign, lazyp=lazyp}
811                               val acc = DA.namedAcc(name, mkv)                               val acc = DA.namedAcc(name, mkv)
812                               val specvar =                               val specvar =
813                                 VALvar{path=SP.SPATH[name], access=acc,                                 VALvar{path=SP.SPATH[name], access=acc,
# Line 821  Line 826 
826                 | _ => bug "matchVElem.1")                 | _ => bug "matchVElem.1")
827               handle MU.Unbound sym => matchErr(SOME "value"))               handle MU.Unbound sym => matchErr(SOME "value"))
828    
829             | CONspec{spec=DATACON{name, typ=spectyp,             | CONspec{spec=DATACON{name, typ=spectyp, lazyp,
830                                    rep=specrep, ...},...} =>                                    rep=specrep, ...},...} =>
831               ((case MU.getSpec(strElements, sym)               ((case MU.getSpec(strElements, sym)
832                  of CONspec{spec=DATACON{typ=acttyp, rep=actrep, const,                  of CONspec{spec=DATACON{typ=acttyp, rep=actrep, const,
# Line 839  Line 844 
844                                     val nrep = exnRep(actrep, dacc)                                     val nrep = exnRep(actrep, dacc)
845                                     val con = DATACON{typ=acttyp, name=name,                                     val con = DATACON{typ=acttyp, name=name,
846                                                       const=const, rep=nrep,                                                       const=const, rep=nrep,
847                                                       sign=sign}                                                       sign=sign, lazyp=lazyp}
848                                  in (B.CONbind(con)) :: bindings                                  in (B.CONbind(con)) :: bindings
849                                 end                                 end
850    
# Line 1214  Line 1219 
1219                  in packElems(elems, entEnv, decs', bindings')                  in packElems(elems, entEnv, decs', bindings')
1220                 end)                 end)
1221    
1222             | CONspec{spec=DATACON{name, typ, rep, const, sign}, slot} =>             | CONspec{spec=DATACON{name, typ, rep, const, sign, lazyp}, slot} =>
1223                (let val bindings' =                (let val bindings' =
1224                       case slot                       case slot
1225                        of NONE => bindings                        of NONE => bindings
# Line 1223  Line 1228 
1228                                   typeInRes("$spec-resty(packStr-con)", typ)                                   typeInRes("$spec-resty(packStr-con)", typ)
1229                                 val dacc = DA.selAcc(rootAcc, s)                                 val dacc = DA.selAcc(rootAcc, s)
1230                                 val nrep = exnRep(rep, dacc)                                 val nrep = exnRep(rep, dacc)
1231                                 val con = DATACON{typ=restyp, name=name,                                 val con = DATACON{typ=restyp, name=name, lazyp=lazyp,
1232                                             const=const, rep=nrep, sign=sign}                                             const=const, rep=nrep, sign=sign}
1233                              in (B.CONbind(con)) :: bindings                              in (B.CONbind(con)) :: bindings
1234                             end                             end
# Line 1467  Line 1472 
1472    
1473  (*  (*
1474   * $Log: sigmatch.sml,v $   * $Log: sigmatch.sml,v $
1475     * Revision 1.2  1998/05/15 03:44:34  dbm
1476     *   Fix for bug 1369 (EntityEnv.Unbound exception).
1477     *
1478   * Revision 1.1.1.1  1998/04/08 18:39:28  george   * Revision 1.1.1.1  1998/04/08 18:39:28  george
1479   * Version 110.5   * Version 110.5
1480   *   *

Legend:
Removed from v.105  
changed lines
  Added in v.106

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