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/compiler/FLINT/trans/matchcomp.sml
 [smlnj] / sml / trunk / compiler / FLINT / trans / matchcomp.sml

# Diff of /sml/trunk/compiler/FLINT/trans/matchcomp.sml

revision 4493, Sun Oct 15 02:18:10 2017 UTC revision 4494, Sun Oct 15 03:04:17 2017 UTC
# Line 96  Line 96
96       | _ => if BT.isArrowType ty then toLty ty       | _ => if BT.isArrowType ty then toLty ty
97              else toLty (BT.-->(BT.unitTy, ty)))              else toLty (BT.-->(BT.unitTy, ty)))
98
99    (* test for 64-bit int/word types, which are represented as pairs of 32-bit words *)
100    fun isInt64 ty = TU.equalType(ty, BT.int64Ty)
101    fun isWord64 ty = TU.equalType(ty, BT.word64Ty)
102
103  (**************************************************************************)  (**************************************************************************)
104  type ruleno = int   (* the number identifying a rule *)  type ruleno = int   (* the number identifying a rule *)
105  type rules = ruleno list  (* a list (set) of rule numbers *)  type rules = ruleno list  (* a list (set) of rule numbers *)
# Line 294  Line 298
298            addConstraint ((k,t), NONE, rule, genAndor(bpat, rule))            addConstraint ((k,t), NONE, rule, genAndor(bpat, rule))
299        | genAndor (LAYEREDpat(APPpat(k,t,lpat), bpat), rule) =        | genAndor (LAYEREDpat(APPpat(k,t,lpat), bpat), rule) =
300            addConstraint ((k,t), SOME lpat, rule, genAndor(bpat, rule))            addConstraint ((k,t), SOME lpat, rule, genAndor(bpat, rule))
301        | genAndor (INTpat (s,t), rule) =        | genAndor (NUMpat{value, ty}, rule) =
302            if TU.equalType (t, BT.int64Ty) then genAndor64 (LN.int64 s, rule)            if isInt64 ty then genAndor64 (LN.int64 value, rule)
303            else let val con = numCon(s, t, "genAndor INTpat")            else if isWord64 ty then genAndor64 (LN.word64 value, rule)
304                 in CASE{bindings = nil, constraints = nil, sign = DA.CNIL,            else let
305                         cases = [(con, [rule], nil)]}              val con = if TU.equalType(ty, BT.wordTy) orelse TU.equalType(ty, BT.word32Ty)
306                 end                    then wordCon(value, ty, "genAndor WORDpat")
307        | genAndor (WORDpat(s,t), rule) =                    else numCon(value, ty, "genAndor INTpat")
308            if TU.equalType (t, BT.word64Ty) then genAndor64 (LN.word64 s, rule)              in
309            else let val con = wordCon(s, t, "genAndor WORDpat")                CASE{bindings = nil, constraints = nil, sign = DA.CNIL, cases = [(con, [rule], nil)]}
in CASE{bindings = nil, constraints = nil, sign = DA.CNIL,
cases = [(con, [rule], nil)]}
310                 end                 end
311        | genAndor (REALpat r, rule) =        | genAndor (REALpat r, rule) =
312            CASE {bindings = nil, constraints = nil, sign = DA.CNIL,            CASE {bindings = nil, constraints = nil, sign = DA.CNIL,
# Line 337  Line 339
339            bug "genandor applied to inapplicable pattern"            bug "genandor applied to inapplicable pattern"
340
341      (* simulate 64-bit words and ints as pairs of 32-bit words *)      (* simulate 64-bit words and ints as pairs of 32-bit words *)
342      and genAndor64 ((hi, lo), rule) =      and genAndor64 ((hi, lo), rule) = let
343          let fun p32 w = WORDpat (Word32.toLargeInt w, BT.word32Ty)            fun p32 w = NUMpat{value = Word32.toLargeInt w, ty = BT.word32Ty}
344          in genAndor (AbsynUtil.TUPLEpat [p32 hi, p32 lo], rule)            in
345                genAndor (AbsynUtil.TUPLEpat [p32 hi, p32 lo], rule)
346          end          end
347
348      and multiGen(nil, rule) = nil      and multiGen(nil, rule) = nil
# Line 373  Line 376
376                    AND{bindings=bindings, constraints=constraints,                    AND{bindings=bindings, constraints=constraints,
377                        subtrees=subtrees}                        subtrees=subtrees}
378                | _ => bug "genAndor returned bogusly")                | _ => bug "genAndor returned bogusly")
379        | mergeAndor (INTpat (s,t), c as CASE{bindings, cases,        | mergeAndor (NUMpat{value, ty}, c as CASE{bindings, cases, constraints, sign}, rule) =
380                                              constraints, sign}, rule) =            if isInt64 ty then mergeAndor64 (LN.int64 value, c, rule)
381            if TU.equalType (t, BT.int64Ty) then            else if isWord64 ty then mergeAndor64 (LN.word64 value, c, rule)
382                mergeAndor64 (LN.int64 s, c, rule)            else let
383            else let val pcon = numCon(s, t, "mergeAndor INTpat")              val pcon = if TU.equalType(ty, BT.wordTy) orelse TU.equalType(ty, BT.word8Ty)
384                 in CASE{bindings = bindings, constraints = constraints,                    orelse TU.equalType(ty, BT.word32Ty)
385                         sign = sign, cases = addACase(pcon, nil, rule, cases)}                      then wordCon(value, ty, "mergeAndor WORDpat")
386                 end                      else numCon(value, ty, "mergeAndor INTpat")
387        | mergeAndor (INTpat (s, t), c as AND _, rule) =              in
388            if TU.equalType (t, BT.int64Ty) then                CASE{
389                mergeAndor64 (LN.int64 s, c, rule)                    bindings = bindings, constraints = constraints,
390            else bug "bad pattern merge: INTpat AND (not 64)"                    sign = sign, cases = addACase(pcon, [], rule, cases)
391        | mergeAndor (WORDpat(s,t), c as CASE{bindings, cases,                  }
392                                              constraints, sign}, rule) =              end
393            if TU.equalType (t, BT.word64Ty) then        | mergeAndor (NUMpat{value, ty}, c as AND _, rule) =
394                mergeAndor64 (LN.word64 s, c, rule)            if isInt64 ty then mergeAndor64 (LN.int64 value, c, rule)
395            else let val pcon = wordCon(s, t, "mergeAndor WORDpat")            else if isWord64 ty then mergeAndor64 (LN.word64 value, c, rule)
396                 in CASE{bindings = bindings, constraints = constraints,            else bug "bad pattern merge: NUMpat AND (not 64)"
sign = sign, cases = addACase(pcon, nil, rule, cases)}
end
| mergeAndor (WORDpat(s,t),c as AND _, rule) =
if TU.equalType (t, BT.word64Ty) then
mergeAndor64 (LN.word64 s, c, rule)
else bug "bad pattern merge: WORDpat AND (not 64)"
397        | mergeAndor (REALpat r, CASE{bindings, cases, constraints,sign}, rule) =        | mergeAndor (REALpat r, CASE{bindings, cases, constraints,sign}, rule) =
398            CASE {bindings = bindings, constraints = constraints, sign=sign,            CASE {bindings = bindings, constraints = constraints, sign=sign,
399                  cases = addACase(REALpcon r, nil, rule, cases)}                  cases = addACase(REALpcon r, nil, rule, cases)}
# Line 439  Line 436
436
437      (* simulate 64-bit words and ints as pairs of 32-bit words *)      (* simulate 64-bit words and ints as pairs of 32-bit words *)
438      and mergeAndor64 ((hi, lo), c, rule) =      and mergeAndor64 ((hi, lo), c, rule) =
439          let fun p32 w = WORDpat (Word32.toLargeInt w, BT.word32Ty)          let fun p32 w = NUMpat{value = Word32.toLargeInt w, ty = BT.word32Ty}
440          in mergeAndor (AbsynUtil.TUPLEpat [p32 hi, p32 lo], c, rule)          in mergeAndor (AbsynUtil.TUPLEpat [p32 hi, p32 lo], c, rule)
441          end          end
442

Legend:
 Removed from v.4493 changed lines Added in v.4494

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