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/temi-branch/compiler/ElabData/types/typesutil.sml
ViewVC logotype

Diff of /sml/branches/temi-branch/compiler/ElabData/types/typesutil.sml

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

revision 3019, Tue May 6 20:25:44 2008 UTC revision 3020, Wed May 7 02:59:25 2008 UTC
# Line 152  Line 152 
152        Stamps.eq(s1,s2)        Stamps.eq(s1,s2)
153    | eqTycon _ = false    | eqTycon _ = false
154    
155  fun prune(VARty(tv as ref(INSTANTIATED ty))) : ty =  fun prune(VARty(tv as ref(INSTANTIATED ty)) |
156              MARKty(VARty(tv as ref(INSTANTIATED ty)),_)) : ty =
157        let val pruned = prune ty        let val pruned = prune ty
158        in tv := INSTANTIATED pruned; pruned        in tv := INSTANTIATED pruned; pruned
159        end        end
# Line 222  Line 223 
223                 | POLYty {sign, tyfun=TYFUN{arity, body}} =>                 | POLYty {sign, tyfun=TYFUN{arity, body}} =>
224                    POLYty{sign=sign, tyfun=TYFUN{arity=arity,body=mapTy body}}                    POLYty{sign=sign, tyfun=TYFUN{arity=arity,body=mapTy body}}
225                 | VARty(ref(INSTANTIATED ty)) => mapTy ty                 | VARty(ref(INSTANTIATED ty)) => mapTy ty
226                   | MARKty(ty, region) => mapTy ty
227                 | _ => ty                 | _ => ty
228       in mapTy       in mapTy
229      end      end
# Line 232  Line 234 
234                of CONty (tc, tl) => (f tc;  app appTy tl)                of CONty (tc, tl) => (f tc;  app appTy tl)
235                 | POLYty {sign, tyfun=TYFUN{arity, body}} => appTy body                 | POLYty {sign, tyfun=TYFUN{arity, body}} => appTy body
236                 | VARty(ref(INSTANTIATED ty)) => appTy ty                 | VARty(ref(INSTANTIATED ty)) => appTy ty
237                   | MARKty(ty, region) => appTy ty
238                 | _ => ()                 | _ => ()
239       in appTy       in appTy
240      end      end
# Line 242  Line 245 
245  fun reduceType(CONty(DEFtyc{tyfun,...}, args)) = applyTyfun(tyfun,args)  fun reduceType(CONty(DEFtyc{tyfun,...}, args)) = applyTyfun(tyfun,args)
246    | reduceType(POLYty{sign=[],tyfun=TYFUN{arity=0,body}}) = body    | reduceType(POLYty{sign=[],tyfun=TYFUN{arity=0,body}}) = body
247    | reduceType(VARty(ref(INSTANTIATED ty))) = ty    | reduceType(VARty(ref(INSTANTIATED ty))) = ty
248      | reduceType(MARKty(ty, region)) = reduceType ty
249    | reduceType _ = raise ReduceType    | reduceType _ = raise ReduceType
250    
251  fun headReduceType ty = headReduceType(reduceType ty) handle ReduceType => ty  fun headReduceType ty = headReduceType(reduceType ty) handle ReduceType => ty
# Line 284  Line 288 
288                 handle ReduceType => false)                 handle ReduceType => false)
289            | eq(WILDCARDty,_) = true            | eq(WILDCARDty,_) = true
290            | eq(_,WILDCARDty) = true            | eq(_,WILDCARDty) = true
291              | eq(ty1, MARKty(ty, region)) = eq(ty1, ty)
292              | eq(MARKty(ty, region), ty2) = eq(ty, ty2)
293            | eq _ = false            | eq _ = false
294       in eq(prune ty, prune ty')       in eq(prune ty, prune ty')
295      end      end
# Line 361  Line 367 
367          fun f (POLYty{tyfun=TYFUN{body,...},...},b) = f (body,b)          fun f (POLYty{tyfun=TYFUN{body,...},...},b) = f (body,b)
368            | f (CONty(tyc,_),true) = tyc            | f (CONty(tyc,_),true) = tyc
369            | f (CONty(_,[_,CONty(tyc,_)]),false) = tyc            | f (CONty(_,[_,CONty(tyc,_)]),false) = tyc
370              | f (MARKty(ty, region), b) = f(ty, b)
371            | f _ = bug "dconTyc"            | f _ = bug "dconTyc"
372       in f (typ,const)       in f (typ,const)
373      end      end
# Line 409  Line 416 
416                             (match(scheme, reduceType pt)                             (match(scheme, reduceType pt)
417                              handle ReduceType =>                              handle ReduceType =>
418                                bug "matchScheme, match -- tycons "))                                bug "matchScheme, match -- tycons "))
419                   | (MARKty(ty1,region1), MARKty(ty2,region2)) => match(ty1,ty2)
420                   | (MARKty(ty1,region1), ty2) => match(ty1,ty2)
421                   | (ty1, MARKty(ty2,region2)) => match(ty1,ty2)
422                 | _ => bug "matchScheme, match"                 | _ => bug "matchScheme, match"
423       in case prune target       in case prune target
424            of POLYty{sign,tyfun=TYFUN{arity=arity',body=body'}} =>            of POLYty{sign,tyfun=TYFUN{arity=arity',body=body'}} =>
# Line 653  Line 663 
663            | match'(_, CONty _) = (debugmsg' "unmatched CONty"; raise CompareTypes)            | match'(_, CONty _) = (debugmsg' "unmatched CONty"; raise CompareTypes)
664            | match'(t1, VARty vk) = (debugmsg' "VARty other";            | match'(t1, VARty vk) = (debugmsg' "VARty other";
665                                      raise CompareTypes)                                      raise CompareTypes)
666              | match'(MARKty (t, _), t') = match'(t, t')
667              | match'(t, MARKty (t', _)) = match'(t, t')
668          and match(ty1,ty2) = match'(headReduceType ty1, headReduceType ty2)          and match(ty1,ty2) = match'(headReduceType ty1, headReduceType ty2)
669          val (actinst, actParamTvs) = instantiatePoly actualTy          val (actinst, actParamTvs) = instantiatePoly actualTy
670          val (specinst, specGenericTvs) = instantiatePoly specTy          val (specinst, specGenericTvs) = instantiatePoly specTy

Legend:
Removed from v.3019  
changed lines
  Added in v.3020

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