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/trunk/src/system/Init/core.sml
ViewVC logotype

Diff of /sml/trunk/src/system/Init/core.sml

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

revision 417, Fri Sep 3 23:51:27 1999 UTC revision 498, Tue Dec 7 15:44:50 1999 UTC
# Line 209  Line 209 
209      fun polyequal (a : 'a, b : 'a) = peql(a,b)      fun polyequal (a : 'a, b : 'a) = peql(a,b)
210            orelse (boxed a andalso boxed b            orelse (boxed a andalso boxed b
211              andalso let              andalso let
212                (* NOTE: since GC may strip the header from the pair in question,
213                 * we must fetch the length before getting the tag, whenever we
214                 * might be dealing with a pair.
215                 *)
216                  val aLen = getObjLen a
217                val aTag = getObjTag a                val aTag = getObjTag a
218                fun pairEq () = let                fun pairEq () = let
219                        val bLen = getObjLen b
220                      val bTag = getObjTag b                      val bTag = getObjTag b
221                      in                      in
222                        ((ieql(bTag, 0x02) andalso ieql(getObjLen b, 2))                        ((ieql(bTag, 0x02) andalso ieql(bLen, 2))
223                          orelse ineq(andb(bTag, 0x3),0x2))                          orelse ineq(andb(bTag, 0x3),0x2))
224                        andalso polyequal(recSub(a, 0), recSub(b, 0))                        andalso polyequal(recSub(a, 0), recSub(b, 0))
225                        andalso polyequal(recSub(a, 1), recSub(b, 1))                        andalso polyequal(recSub(a, 1), recSub(b, 1))
# Line 227  Line 233 
233                      end                      end
234                in                in
235                  case aTag                  case aTag
236                   of 0x02 (* tag_record *) => let                   of 0x02 (* tag_record *) =>
                       val aLen = getObjLen a  
                       in  
237                          (ieql(aLen, 2) andalso pairEq())                          (ieql(aLen, 2) andalso pairEq())
238                          orelse (                          orelse (
239                            ieql(getObjTag b, 0x02) andalso ieql(getObjLen b, aLen)                            ieql(getObjTag b, 0x02) andalso ieql(getObjLen b, aLen)
240                            andalso eqVecData(aLen, a, b))                            andalso eqVecData(aLen, a, b))
                       end  
241                    | 0x06 (* tag_vec_hdr *) => (                    | 0x06 (* tag_vec_hdr *) => (
242                      (* length encodes element type *)                      (* length encodes element type *)
243                        case (getObjLen a)                        case (getObjLen a)
# Line 246  Line 249 
249                                  andalso eqVecData(aLen, getData a, getData b)                                  andalso eqVecData(aLen, getData a, getData b)
250                              end                              end
251                          | 1 (* seq_word8 *) => stringequal(cast a, cast b)                          | 1 (* seq_word8 *) => stringequal(cast a, cast b)
252                            | _ => raise Match (* shut up compiler *)
253                        (* end case *))                        (* end case *))
254                    | 0x0a (* tag_arr_hdr *) => peql(getData a, getData b)                    | 0x0a (* tag_arr_hdr *) => peql(getData a, getData b)
255                    | 0x0e (* tag_arr_data and tag_ref *) => false                    | 0x0e (* tag_arr_data and tag_ref *) => false
# Line 260  Line 264 
264    
265    end    end
266    
267    (*
268     * $Log: core.sml,v $
269     * Revision 1.3  1998/05/23 14:09:57  george
270     *   Fixed RCS keyword syntax
271     *
272     *
273     *)

Legend:
Removed from v.417  
changed lines
  Added in v.498

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