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/primop-branch-2/src/compiler/FLINT/trans/translate.sml
ViewVC logotype

Diff of /sml/branches/primop-branch-2/src/compiler/FLINT/trans/translate.sml

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

revision 1178, Mon Mar 25 20:51:48 2002 UTC revision 1183, Fri Mar 29 19:09:48 2002 UTC
# Line 444  Line 444 
444     in FN(v, argt, COND(APP(eq, VAR v), falseLexp, trueLexp))     in FN(v, argt, COND(APP(eq, VAR v), falseLexp, trueLexp))
445    end    end
446    
 fun intOp p = PRIM(p, lt_intop, [])  
447  fun cmpOp p = PRIM(p, lt_icmp, [])  fun cmpOp p = PRIM(p, lt_icmp, [])
448  fun inegOp p = PRIM(p, lt_ineg, [])  fun inegOp p = PRIM(p, lt_ineg, [])
449    
 fun ADD(b,c) = APP(intOp(PO.IADD), RECORD[b, c])  
 fun SUB(b,c) = APP(intOp(PO.ISUB), RECORD[b, c])  
 fun MUL(b,c) = APP(intOp(PO.IMUL), RECORD[b, c])  
 fun DIV(b,c) = APP(intOp(PO.IDIV), RECORD[b, c])  
450  val LESSU = PO.CMP{oper=PO.LTU, kind=PO.UINT 31}  val LESSU = PO.CMP{oper=PO.LTU, kind=PO.UINT 31}
451    
452  val lt_len = LT.ltc_poly([LT.tkc_mono], [lt_arw(LT.ltc_tv 0, lt_int)])  val lt_len = LT.ltc_poly([LT.tkc_mono], [lt_arw(LT.ltc_tv 0, lt_int)])
# Line 501  Line 496 
496                            RECORD [vw, vcnt])))))                            RECORD [vw, vcnt])))))
497    end    end
498    
499    fun inlops nk = let
500        val (lt_arg, zero, overflow) =
501            case nk of
502                PO.INT 31 => (LT.ltc_int, INT 0, true)
503              | PO.UINT 31 => (LT.ltc_int, WORD 0w0, false)
504              | PO.INT 32 => (LT.ltc_int32, INT32 0, true)
505              | PO.UINT 32 => (LT.ltc_int32, WORD32 0w0, false)
506              | PO.FLOAT 64 => (LT.ltc_real, REAL "0.0", false)
507              | _ => bug "inlops: bad numkind"
508        val lt_argpair = lt_tup [lt_arg, lt_arg]
509        val lt_cmp = lt_arw (lt_argpair, lt_bool)
510        val lt_neg = lt_arw (lt_arg, lt_arg)
511        val less = PRIM (PO.CMP { oper = PO.<, kind = nk }, lt_cmp, [])
512        val greater = PRIM (PO.CMP { oper = PO.>, kind = nk }, lt_cmp, [])
513        val negate =
514            PRIM (PO.ARITH { oper = PO.~, overflow = overflow, kind = nk },
515                  lt_neg, [])
516    in
517        { lt_arg = lt_arg, lt_argpair = lt_argpair, lt_cmp = lt_cmp,
518          less = less, greater = greater,
519          zero = zero, negate = negate }
520    end
521    
522    fun inlminmax (nk, ismax) = let
523        val { lt_argpair, less, greater, lt_cmp, ... } = inlops nk
524        val x = mkv () and y = mkv () and z = mkv ()
525        val cmpop = if ismax then greater else less
526        val elsebranch =
527            case nk of
528                PO.FLOAT _ => let
529                    (* testing for NaN *)
530                    val fequal =
531                        PRIM (PO.CMP { oper = PO.EQL, kind = nk }, lt_cmp, [])
532                in
533                    COND (APP (fequal, RECORD [VAR y, VAR y]), VAR x, VAR y)
534                end
535              | _ => VAR y
536    in
537        FN (z, lt_argpair,
538            LET (x, SELECT (0, VAR z),
539                 LET (y, SELECT (1, VAR z),
540                      COND (APP (cmpop, RECORD [VAR x, VAR y]),
541                            VAR x, elsebranch))))
542    end
543    
544    fun inlabs nk = let
545        val { lt_arg, greater, zero, negate, ... } = inlops nk
546        val x = mkv ()
547    in
548        FN (x, lt_arg,
549            COND (APP (greater, RECORD [VAR x, zero]),
550                  VAR x, APP (negate, VAR x)))
551    end
552    
553  fun transPrim (prim, lt, ts) =  fun transPrim (prim, lt, ts) =
554    let fun g (PO.INLLSHIFT k) = inlineShift(lshiftOp, k, fn _ => lword0(k))    let fun g (PO.INLLSHIFT k) = inlineShift(lshiftOp, k, fn _ => lword0(k))
# Line 511  Line 559 
559                 in inlineShift(rshiftOp, k, clear)                 in inlineShift(rshiftOp, k, clear)
560                end                end
561    
562          | g (PO.INLDIV) =          | g (PO.INLMIN nk) = inlminmax (nk, false)
563                let val a = mkv() and b = mkv() and z = mkv()          | g (PO.INLMAX nk) = inlminmax (nk, true)
564                 in FN(z, lt_ipair,          | g (PO.INLABS nk) = inlabs nk
565                      LET(a, SELECT(0, VAR z),  
                       LET(b, SELECT(1, VAR z),  
                         COND(APP(cmpOp(PO.IGE), RECORD[VAR b, INT 0]),  
                           COND(APP(cmpOp(PO.IGE), RECORD[VAR a, INT 0]),  
                                DIV(VAR a, VAR b),  
                                SUB(DIV(ADD(VAR a, INT 1), VAR b), INT 1)),  
                           COND(APP(cmpOp(PO.IGT), RECORD[VAR a, INT 0]),  
                                SUB(DIV(SUB(VAR a, INT 1), VAR b), INT 1),  
                                DIV(VAR a, VAR b))))))  
               end  
   
         | g (PO.INLMOD) =  
               let val a = mkv() and b = mkv() and z = mkv()  
                in FN(z, lt_ipair,  
                     LET(a,SELECT(0, VAR z),  
                       LET(b,SELECT(1,VAR z),  
                         COND(APP(cmpOp(PO.IGE), RECORD[VAR b, INT 0]),  
                           COND(APP(cmpOp(PO.IGE), RECORD[VAR a, INT 0]),  
                                SUB(VAR a, MUL(DIV(VAR a, VAR b), VAR b)),  
                                ADD(SUB(VAR a,MUL(DIV(ADD(VAR a,INT 1), VAR b),  
                                                  VAR b)), VAR b)),  
                           COND(APP(cmpOp(PO.IGT), RECORD[VAR a,INT 0]),  
                                ADD(SUB(VAR a,MUL(DIV(SUB(VAR a,INT 1), VAR b),  
                                                  VAR b)), VAR b),  
                                COND(APP(cmpOp(PO.IEQL),RECORD[VAR a,  
                                                          INT ~1073741824]),  
                                     COND(APP(cmpOp(PO.IEQL),  
                                              RECORD[VAR b,INT 0]),  
                                          INT 0,  
                                          SUB(VAR a, MUL(DIV(VAR a, VAR b),  
                                                     VAR b))),  
                                     SUB(VAR a, MUL(DIV(VAR a, VAR b),  
                                                    VAR b))))))))  
               end  
   
         | g (PO.INLREM) =  
               let val a = mkv() and b = mkv() and z = mkv()  
                in FN(z, lt_ipair,  
                     LET(a, SELECT(0,VAR z),  
                       LET(b, SELECT(1,VAR z),  
                           SUB(VAR a, MUL(DIV(VAR a,VAR b),VAR b)))))  
               end  
   
         | g (PO.INLMIN) =  
               let val x = mkv() and y = mkv() and z = mkv()  
                in FN(z, lt_ipair,  
                     LET(x, SELECT(0,VAR z),  
                        LET(y, SELECT(1,VAR z),  
                          COND(APP(cmpOp(PO.ILT), RECORD[VAR x,VAR y]),  
                               VAR x, VAR y))))  
               end  
         | g (PO.INLMAX) =  
               let val x = mkv() and y = mkv() and z = mkv()  
                in FN(z, lt_ipair,  
                     LET(x, SELECT(0,VAR z),  
                        LET(y, SELECT(1,VAR z),  
                          COND(APP(cmpOp(PO.IGT), RECORD[VAR x,VAR y]),  
                               VAR x, VAR y))))  
               end  
         | g (PO.INLABS) =  
               let val x = mkv()  
                in FN(x, lt_int,  
                      COND(APP(cmpOp(PO.IGT), RECORD[VAR x,INT 0]),  
                           VAR x, APP(inegOp(PO.INEG), VAR x)))  
               end  
566          | g (PO.INLNOT) =          | g (PO.INLNOT) =
567                let val x = mkv()                let val x = mkv()
568                 in FN(x, lt_bool, COND(VAR x, falseLexp, trueLexp))                 in FN(x, lt_bool, COND(VAR x, falseLexp, trueLexp))
# Line 606  Line 590 
590                    val x = mkv()                    val x = mkv()
591                 in FN(x, argt, SELECT(0,VAR x))                 in FN(x, argt, SELECT(0,VAR x))
592                end                end
593            | g (PO.INLIGNORE) =
594              let val argt =
595                      case ts of [a] => lt_tyc a
596                               | _ => bug "unexpected type for INLIGNORE"
597              in FN (mkv (), argt, unitLexp)
598              end
599    
600          | g (PO.INLSUBSCRIPTV) =          | g (PO.INLSUBSCRIPTV) =
601                let val (tc1, t1) = case ts of [z] => (z, lt_tyc z)                let val (tc1, t1) = case ts of [z] => (z, lt_tyc z)

Legend:
Removed from v.1178  
changed lines
  Added in v.1183

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