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/FLINT/src/compiler/Semant/types/overload.sml
ViewVC logotype

Diff of /sml/branches/FLINT/src/compiler/Semant/types/overload.sml

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

revision 142, Mon Sep 7 21:37:09 1998 UTC revision 143, Mon Sep 7 21:46:44 1998 UTC
# Line 51  Line 51 
51  fun softUnify(ty1: ty, ty2: ty): unit =  fun softUnify(ty1: ty, ty2: ty): unit =
52    let val subst: subst ref = ref nil    let val subst: subst ref = ref nil
53        fun softInst(tv as ref info: tyvar, ty: ty) : unit =        fun softInst(tv as ref info: tyvar, ty: ty) : unit =
54              let fun scan(ty: ty) : unit =  (* simple occurrence check *)              let fun scan eq (ty: ty) : unit =  (* simple occurrence check *)
55                     case ty                     case ty
56                       of VARty(tv') =>                       of VARty(tv') =>
57                            if TU.eqTyvar(tv, tv')                            if TU.eqTyvar(tv, tv')
58                            then raise SoftUnify                            then raise SoftUnify
59                            else (case tv'                            else (case tv'
60                                    of ref(OPEN{kind=FLEX fields,...}) =>                                    of ref(OPEN{kind=FLEX fields,...}) =>
61                                         app (fn (_,ty') => scan ty') fields                                          (* DBM: can this happen? *)
62                                            app (fn (_,ty') => scan eq ty') fields
63                                     | _ => ())                                     | _ => ())
64                        | CONty(_, args) => app scan args                         | CONty(tycon, args) =>
65                             (* check equality property if necessary *)
66                               if eq
67                               then (case tycon
68                                       of DEFtyc _ =>
69                                           scan eq (TU.headReduceType ty)
70                                        | GENtyc{eq=eqp,...} =>
71                                           (case !eqp
72                                              of YES => app (scan eq) args
73                                               | OBJ => app (scan false) args
74                                                  (* won't happen *)
75                                               | _ => raise SoftUnify)
76                                        | _ => raise SoftUnify) (* won't happen? *)
77                               else app (scan eq) args
78                        | ty => ()  (* propagate error *)                        | ty => ()  (* propagate error *)
79               in case info               in case info
80                    of (SCHEME _ | OPEN{kind=META,...}) => ()                    of (SCHEME eq | OPEN{kind=META,eq,...}) =>
81                     | _ => raise SoftUnify;                        (scan eq ty;
                 scan ty;  
82                  subst := (tv, info)::(!subst);                  subst := (tv, info)::(!subst);
83                  tv := INSTANTIATED ty                         tv := INSTANTIATED ty)
84                       | _ => raise SoftUnify
85              end              end
86    
87          fun unify(ty1: ty, ty2: ty): unit =          fun unify(ty1: ty, ty2: ty): unit =
# Line 148  Line 162 
162  end (* local *)  end (* local *)
163  end (* structure Overload *)  end (* structure Overload *)
164    
 (*  
  * $Log$  
  *)  

Legend:
Removed from v.142  
changed lines
  Added in v.143

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