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/translate.sml
ViewVC logotype

Diff of /sml/trunk/compiler/FLINT/trans/translate.sml

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

revision 2623, Tue May 29 21:53:56 2007 UTC revision 2624, Tue May 29 23:00:44 2007 UTC
# Line 159  Line 159 
159       | _ => if BT.isArrowType ty then toLty d ty       | _ => if BT.isArrowType ty then toLty d ty
160              else toLty d (BT.-->(BT.unitTy, ty)))              else toLty d (BT.-->(BT.unitTy, ty)))
161    
162    (*
163  (** the special lookup functions for the Core environment *)  (** the special lookup functions for the Core environment *)
164  (* DBM: not used -- superceded by CoreAccess *)  (* DBM: not used -- superceded by CoreAccess *)
165  fun coreLookup(id, env) =  fun coreLookup(id, env) =
# Line 166  Line 167 
167        val err = fn _ => fn _ => fn _ => raise NoCore        val err = fn _ => fn _ => fn _ => raise NoCore
168     in Lookup.lookVal(env, sp, err)     in Lookup.lookVal(env, sp, err)
169    end    end
170    *)
171    
172  fun CON' ((_, DA.REF, lt), ts, e) = APP (PRIM (PO.MAKEREF, lt, ts), e)  fun CON' ((_, DA.REF, lt), ts, e) = APP (PRIM (PO.MAKEREF, lt, ts), e)
173    | CON' ((_, DA.SUSP (SOME(DA.LVAR d, _)), lt), ts, e) =    | CON' ((_, DA.SUSP (SOME(DA.LVAR d, _)), lt), ts, e) =
# Line 343  Line 345 
345   *)   *)
346  exception NoCore  exception NoCore
347    
348  fun coreExn id =  fun coreExn ids =
349      (case CoreAccess.getCon' (fn () => raise NoCore) (oldenv, id) of      (case CoreAccess.getCon' (fn () => raise NoCore) oldenv ids of
350           TP.DATACON { name, rep as DA.EXN _, typ, ... } =>           TP.DATACON { name, rep as DA.EXN _, typ, ... } =>
351           let val nt = toDconLty DI.top typ           let val nt = toDconLty DI.top typ
352               val nrep = mkRep(rep, nt, name)               val nrep = mkRep(rep, nt, name)
# Line 357  Line 359 
359      handle NoCore => (say "WARNING: no Core access\n"; INT 0)      handle NoCore => (say "WARNING: no Core access\n"; INT 0)
360    
361  and coreAcc id =  and coreAcc id =
362      (case CoreAccess.getVar' (fn () => raise NoCore) (oldenv, id) of      (case CoreAccess.getVar' (fn () => raise NoCore) oldenv [id] of
363           V.VALvar { access, typ, path, ... } =>           V.VALvar { access, typ, path, ... } =>
364           mkAccT(access, toLty DI.top (!typ), getNameOp path)           mkAccT(access, toLty DI.top (!typ), getNameOp path)
365         | _ => bug "coreAcc in translate")         | _ => bug "coreAcc in translate")
# Line 576  Line 578 
578      val lt_neg = lt_arw (lt_arg, lt_arg)      val lt_neg = lt_arw (lt_arg, lt_arg)
579      val less = PRIM (PO.CMP { oper = PO.<, kind = nk }, lt_cmp, [])      val less = PRIM (PO.CMP { oper = PO.<, kind = nk }, lt_cmp, [])
580      val greater = PRIM (PO.CMP { oper = PO.>, kind = nk }, lt_cmp, [])      val greater = PRIM (PO.CMP { oper = PO.>, kind = nk }, lt_cmp, [])
581        val equal = PRIM (PO.CMP { oper = PO.EQL, kind = nk }, lt_cmp, [])
582      val negate =      val negate =
583          PRIM (PO.ARITH { oper = PO.~, overflow = overflow, kind = nk },          PRIM (PO.ARITH { oper = PO.~, overflow = overflow, kind = nk },
584                lt_neg, [])                lt_neg, [])
585  in  in
586      { lt_arg = lt_arg, lt_argpair = lt_argpair, lt_cmp = lt_cmp,      { lt_arg = lt_arg, lt_argpair = lt_argpair, lt_cmp = lt_cmp,
587        less = less, greater = greater,        less = less, greater = greater, equal = equal,
588        zero = zero, negate = negate }        zero = zero, negate = negate }
589  end  end
590    
591    fun inldiv (nk, po) =
592        let val { lt_argpair, lt_cmp, zero, equal, ... } = inlops nk
593            val z = mkv () val y = mkv ()
594        in FN (z, lt_argpair,
595               LET (y, SELECT (1, VAR z),
596                    COND (APP (equal, RECORD [VAR y, zero]),
597                          mkRaise (coreExn ["Assembly", "Div"], lt_bool),
598                          APP (PRIM (po, lt_cmp, []), VAR z))))
599        end
600    
601    
602  fun inlminmax (nk, ismax) = let  fun inlminmax (nk, ismax) = let
603      val { lt_argpair, less, greater, lt_cmp, ... } = inlops nk      val { lt_argpair, less, greater, lt_cmp, ... } = inlops nk
604      val x = mkv () and y = mkv () and z = mkv ()      val x = mkv () and y = mkv () and z = mkv ()
# Line 717  Line 731 
731          | g (PO.INLMAX nk) = inlminmax (nk, true)          | g (PO.INLMAX nk) = inlminmax (nk, true)
732          | g (PO.INLABS nk) = inlabs nk          | g (PO.INLABS nk) = inlabs nk
733    
734            | g (po as PO.ARITH { oper = (PO./ | PO.DIV | PO.MOD | PO.REM),
735                                  kind = nk as (PO.INT _ | PO.UINT _),
736                                  overflow }) =
737                inldiv (nk, po)
738    
739          | g (PO.INLNOT) =          | g (PO.INLNOT) =
740                let val x = mkv()                let val x = mkv()
741                 in FN(x, lt_bool, COND(VAR x, falseLexp, trueLexp))                 in FN(x, lt_bool, COND(VAR x, falseLexp, trueLexp))
# Line 778  Line 797 
797                          COND(APP(cmpOp(LESSU),                          COND(APP(cmpOp(LESSU),
798                                   RECORD[vi, APP(lenOp seqtc, va)]),                                   RECORD[vi, APP(lenOp seqtc, va)]),
799                               APP(oper, RECORD[va, vi]),                               APP(oper, RECORD[va, vi]),
800                               mkRaise(coreExn "Subscript", t1)))))                               mkRaise(coreExn ["Subscript"], t1)))))
801                end                end
802    
803          | g (PO.INLSUBSCRIPT) =          | g (PO.INLSUBSCRIPT) =
# Line 797  Line 816 
816                          COND(APP(cmpOp(LESSU),                          COND(APP(cmpOp(LESSU),
817                                   RECORD[vi, APP(lenOp seqtc, va)]),                                   RECORD[vi, APP(lenOp seqtc, va)]),
818                               APP(oper, RECORD[va, vi]),                               APP(oper, RECORD[va, vi]),
819                               mkRaise(coreExn "Subscript", t1)))))                               mkRaise(coreExn ["Subscript"], t1)))))
820                end                end
821    
822          | g (PO.NUMSUBSCRIPT{kind,checked=true,immutable}) =          | g (PO.NUMSUBSCRIPT{kind,checked=true,immutable}) =
# Line 817  Line 836 
836                          COND(APP(cmpOp(LESSU), RECORD[vi,                          COND(APP(cmpOp(LESSU), RECORD[vi,
837                                                   APP(lenOp tc1, va)]),                                                   APP(lenOp tc1, va)]),
838                               APP(oper', RECORD [va, vi]),                               APP(oper', RECORD [va, vi]),
839                               mkRaise(coreExn "Subscript", t2)))))                               mkRaise(coreExn ["Subscript"], t2)))))
840                end                end
841    
842          | g (PO.INLUPDATE) =          | g (PO.INLUPDATE) =
# Line 838  Line 857 
857                            COND(APP(cmpOp(LESSU),                            COND(APP(cmpOp(LESSU),
858                                     RECORD[vi,APP(lenOp seqtc, va)]),                                     RECORD[vi,APP(lenOp seqtc, va)]),
859                                 APP(oper, RECORD[va,vi,vv]),                                 APP(oper, RECORD[va,vi,vv]),
860                                 mkRaise(coreExn "Subscript", LT.ltc_unit))))))                                 mkRaise(coreExn ["Subscript"], LT.ltc_unit))))))
861                end                end
862    
863          | g (PO.NUMUPDATE{kind,checked=true}) =          | g (PO.NUMUPDATE{kind,checked=true}) =
# Line 860  Line 879 
879                            COND(APP(cmpOp(LESSU),                            COND(APP(cmpOp(LESSU),
880                                     RECORD[vi,APP(lenOp tc1, va)]),                                     RECORD[vi,APP(lenOp tc1, va)]),
881                                 APP(oper', RECORD[va,vi,vv]),                                 APP(oper', RECORD[va,vi,vv]),
882                                 mkRaise(coreExn "Subscript", LT.ltc_unit))))))                                 mkRaise(coreExn ["Subscript"], LT.ltc_unit))))))
883                end                end
884    
885  (**** ASSIGN(r, x) <> UPDATE(r, 0, x) under new array reps (JHR;1998-10-30)  (**** ASSIGN(r, x) <> UPDATE(r, 0, x) under new array reps (JHR;1998-10-30)

Legend:
Removed from v.2623  
changed lines
  Added in v.2624

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