Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Diff of /branches/charisee/src/compiler/mid-to-low/mid-to-low.sml
ViewVC logotype

Diff of /branches/charisee/src/compiler/mid-to-low/mid-to-low.sml

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

revision 1639, Wed Nov 16 01:48:07 2011 UTC revision 1640, Wed Nov 16 02:19:51 2011 UTC
# Line 14  Line 14 
14    
15      structure SrcIL = MidIL      structure SrcIL = MidIL
16      structure SrcOp = MidOps      structure SrcOp = MidOps
17        structure SrcSV = SrcIL.StateVar
18        structure SrcTy = MidILTypes
19      structure VTbl = SrcIL.Var.Tbl      structure VTbl = SrcIL.Var.Tbl
20      structure DstIL = LowIL      structure DstIL = LowIL
21      structure DstTy = LowILTypes      structure DstTy = LowILTypes
22      structure DstOp = LowOps      structure DstOp = LowOps
23    
24      (* instantiate the translation environment *)
25        local
26      type var_env = DstIL.var VTbl.hash_table      type var_env = DstIL.var VTbl.hash_table
27          type state_var_env = DstIL.state_var SrcSV.Tbl.hash_table
28    
29      fun rename (env : var_env, x) = (case VTbl.find env x      fun rename (env : var_env, x) = (case VTbl.find env x
30             of SOME x' => x'             of SOME x' => x'
# Line 30  Line 35 
35                    x'                    x'
36                  end                  end
37            (* end case *))            (* end case *))
38      fun renameList (env, xs) = List.map (fn x => rename(env, x)) xs  
39            fun renameSV (env : state_var_env, x) = (case SrcSV.Tbl.find env x
40                   of SOME x' => x'
41                    | NONE => let
42                        val x' = DstIL.StateVar.new (SrcSV.isOutput x, SrcSV.name x, SrcSV.ty x)
43                        in
44                          SrcSV.Tbl.insert env (x, x');
45                          x'
46                        end
47                  (* end case *))
48        in
49        structure Env = TranslateEnvFn (
50          struct
51            structure SrcIL = SrcIL
52            structure DstIL = DstIL
53            type var_env = var_env
54            type state_var_env = state_var_env
55            val rename = rename
56            val renameSV = renameSV
57          end)
58        end (* local *)
59    
60    (* convert a rational to a FloatLit.float value.  We do this by long division    (* convert a rational to a FloatLit.float value.  We do this by long division
61     * with a cutoff when we get to 12 digits.     * with a cutoff when we get to 12 digits.
# Line 283  Line 308 
308      fun expandTrace (y, d, [m]) = let      fun expandTrace (y, d, [m]) = let
309            val matTy = DstTy.TensorTy[d,d]            val matTy = DstTy.TensorTy[d,d]
310            val rowTy = DstTy.TensorTy[d]            val rowTy = DstTy.TensorTy[d]
311            fun f (i, dst) = if (i < d)            fun f (i, dst) = if (i < d-1)
312                  then let                  then let
313                    val i' = Int.toString i                    val i' = Int.toString i
314                    val ix = DstIL.Var.new ("ix" ^ i', DstTy.intTy)                    val ix = DstIL.Var.new ("ix" ^ i', DstTy.intTy)
# Line 303  Line 328 
328                      ilit(ix, i)                      ilit(ix, i)
329                    ] end                    ] end
330            in            in
331              List.rev (f (1, y))              List.rev (f (0, y))
332            end            end
333    
334      fun expandOp (env, y, rator, args) = let      fun expandOp (env, y, rator, args) = let
335            val args' = renameList(env, args)            val args' = Env.renameList (env, args)
336            fun assign rator' = [(y, DstIL.OP(rator', args'))]            fun assign rator' = [(y, DstIL.OP(rator', args'))]
337            in            in
338              case rator              case rator
# Line 333  Line 358 
358                | SrcOp.MulMatVec(d1, d2) => assign (DstOp.MulMatVec(d1, d2))                | SrcOp.MulMatVec(d1, d2) => assign (DstOp.MulMatVec(d1, d2))
359                | SrcOp.MulMatMat(d1, d2, d3) => assign (DstOp.MulMatMat(d1, d2, d3))                | SrcOp.MulMatMat(d1, d2, d3) => assign (DstOp.MulMatMat(d1, d2, d3))
360                | SrcOp.Cross => assign (DstOp.Cross)                | SrcOp.Cross => assign (DstOp.Cross)
               | SrcOp.Select(ty, i) => assign (DstOp.Select(ty, i))  
361                | SrcOp.Norm ty => assign (DstOp.Norm ty)                | SrcOp.Norm ty => assign (DstOp.Norm ty)
362                | SrcOp.Normalize d => assign (DstOp.Normalize d)                | SrcOp.Normalize d => assign (DstOp.Normalize d)
363                | SrcOp.Scale ty => assign (DstOp.Scale ty)                | SrcOp.Scale ty => assign (DstOp.Scale ty)
364                | SrcOp.Zero ty => assign (DstOp.Zero ty)                | SrcOp.Zero ty => assign (DstOp.Zero ty)
365                | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec ty)                | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec ty)
366                  | SrcOp.EigenVals2x2 => assign (DstOp.EigenVals2x2)
367                  | SrcOp.EigenVals3x3 => assign (DstOp.EigenVals3x3)
368                | SrcOp.Identity n => assign (DstOp.Identity n)                | SrcOp.Identity n => assign (DstOp.Identity n)
369                | SrcOp.Trace d => expandTrace (y, d, args')                | SrcOp.Trace d => expandTrace (y, d, args')
370                  | SrcOp.Select(ty as SrcTy.TupleTy tys, i) => assign (DstOp.Select(ty, i))
371                  | SrcOp.Index(ty, i) => assign (DstOp.Index(ty, i))
372                | SrcOp.Subscript ty => assign (DstOp.Subscript ty)                | SrcOp.Subscript ty => assign (DstOp.Subscript ty)
373                | SrcOp.Ceiling d => assign (DstOp.Ceiling d)                | SrcOp.Ceiling d => assign (DstOp.Ceiling d)
374                | SrcOp.Floor d => assign (DstOp.Floor d)                | SrcOp.Floor d => assign (DstOp.Floor d)
# Line 358  Line 386 
386                | SrcOp.Input(ty, s, desc) => assign (DstOp.Input(ty, s, desc))                | SrcOp.Input(ty, s, desc) => assign (DstOp.Input(ty, s, desc))
387                | SrcOp.InputWithDefault(ty, s, desc) =>                | SrcOp.InputWithDefault(ty, s, desc) =>
388                    assign (DstOp.InputWithDefault(ty, s, desc))                    assign (DstOp.InputWithDefault(ty, s, desc))
389                  | rator => raise Fail("bogus operator " ^ SrcOp.toString rator)
390              (* end case *)              (* end case *)
391            end            end
392    
393    (* expand a SrcIL assignment to a DstIL CFG *)    (* expand a SrcIL assignment to a DstIL CFG *)
394      fun expand (env, (y, rhs)) = let      fun expand (env, (y, rhs)) = let
395            val y' = rename (env, y)            val y' = Env.rename (env, y)
396            fun assign rhs = [(y', rhs)]            fun assign rhs = [DstIL.ASSGN(y', rhs)]
397            in            in
398              case rhs              case rhs
399               of SrcIL.VAR x => assign (DstIL.VAR(rename(env, x)))               of SrcIL.STATE x => assign (DstIL.STATE(Env.renameSV(env, x)))
400                  | SrcIL.VAR x => assign (DstIL.VAR(Env.rename(env, x)))
401                | SrcIL.LIT lit => assign (DstIL.LIT lit)                | SrcIL.LIT lit => assign (DstIL.LIT lit)
402                | SrcIL.OP(rator, args) => expandOp (env, y', rator, args)                | SrcIL.OP(rator, args) => List.map DstIL.ASSGN (expandOp (env, y', rator, args))
403                | SrcIL.APPLY(f, args) => assign(DstIL.APPLY(f, renameList(env, args)))                | SrcIL.APPLY(f, args) => assign (DstIL.APPLY(f, Env.renameList(env, args)))
404                | SrcIL.CONS(ty, args) => assign (DstIL.CONS(ty, renameList(env, args)))                | SrcIL.CONS(ty, args) => assign (DstIL.CONS(ty, Env.renameList(env, args)))
405              (* end case *)              (* end case *)
406            end            end
407    
408      (* expand a SrcIL multi-assignment to a DstIL CFG *)
409        fun mexpand (env, (ys, rator, xs)) = let
410              val ys' = Env.renameList(env, ys)
411              val rator' = (case rator
412                     of SrcOp.EigenVecs2x2 => DstOp.EigenVecs2x2
413                      | SrcOp.EigenVecs3x3 => DstOp.EigenVecs3x3
414                      | SrcOp.Print tys => DstOp.Print tys
415                      | _ => raise Fail("bogus operator " ^ SrcOp.toString rator)
416                    (* end case *))
417              val xs' = Env.renameList(env, xs)
418              val nd = DstIL.Node.mkMASSIGN(ys', rator', xs')
419              in
420                DstIL.CFG{entry=nd, exit=nd}
421              end
422    
423      structure Trans =  TranslateFn (      structure Trans =  TranslateFn (
424        struct        struct
425          structure SrcIL = SrcIL          open Env
         structure DstIL = DstIL  
   
         type var_env = var_env  
   
         val rename = rename  
         val renameList = renameList  
426          val expand = DstIL.CFG.mkBlock o expand          val expand = DstIL.CFG.mkBlock o expand
427            val mexpand = mexpand
428        end)        end)
429    
430      fun translate prog = let      fun translate prog = let

Legend:
Removed from v.1639  
changed lines
  Added in v.1640

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