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

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/high-to-mid/avail-rhs.sml
ViewVC logotype

Annotation of /branches/vis15/src/compiler/high-to-mid/avail-rhs.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3556 - (view) (download)

1 : jhr 3554 (* avail-rhs.sml
2 :     *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2016 The University of Chicago
6 :     * All rights reserved.
7 :     *)
8 :    
9 :     (* tracking available MidIR rhs expressions *)
10 :     structure AvailRHS : sig
11 :    
12 :     type rhs = MidIR.rhs
13 :    
14 :     (* a table for tracking available applications *)
15 :     type t
16 :    
17 :     (* create a new table *)
18 :     val new : unit -> t
19 :    
20 :     (* add a MidIR assignment to the table and return the lhs variable. If the assignment
21 :     * is redundant, then we return the lhs of the previous assignment.
22 :     *)
23 :     val addAssign : t -> MidIR.var * rhs -> MidIR.var
24 :    
25 :     (* get the assignments from the table *)
26 :     val getAssignments : t -> MidIR.assignment list
27 :    
28 :     end = struct
29 :    
30 :     structure IR = MidIR
31 :     structure ST = Stats
32 :    
33 :     val cntNewAssign = ST.newCounter "high-to-mid:new-assignment"
34 :     val cntReuseAssign = ST.newCounter "high-to-mid:reuse-assignment"
35 :    
36 :     datatype rhs = datatype IR.rhs
37 :    
38 :     structure Tbl = HashTableFn (
39 :     struct
40 :     type hash_key = rhs
41 : jhr 3556 fun addHashVar (x, h) = IR.Var.hash x + h
42 : jhr 3554 fun hashVal rhs = (case rhs
43 :     of IR.GLOBAL x => 0w9941 + IR.GlobalVar.hash x
44 :     | IR.STATE x => 0w7477 + IR.StateVar.hash x
45 :     | IR.VAR x => 0w7919 + IR.Var.hash x
46 :     | IR.LIT lit => 0w6997 + Literal.hash lit
47 :     | IR.OP(rator, args) => List.foldl addHashVar (IR.Op.hash rator) args
48 :     | IR.CONS(args, _) => List.foldl addHashVar 0w5987 args
49 :     | IR.SEQ(args, _) => List.foldl addHashVar 0w6011 args
50 :     | IR.EINAPP(ein, args) => List.foldl addHashVar (EinUtil.hash ein) args
51 :     (* end case *))
52 :     fun sameKey (rhs1, rhs2) = (case (rhs1, rhs2)
53 :     of (IR.GLOBAL x, IR.GLOBAL y) => IR.GlobalVar.same(x, y)
54 :     | (IR.STATE x, IR.STATE y) => IR.StateVar.same(x, y)
55 :     | (IR.VAR x, IR.VAR y) => IR.Var.same(x, y)
56 :     | (IR.LIT a, IR.LIT b) => Literal.same(a, b)
57 :     | (IR.OP(op1, xs), IR.OP(op2, ys)) =>
58 : jhr 3556 IR.Op.same(op1, op2) andalso ListPair.allEq IR.Var.same (xs, ys)
59 :     | (IR.CONS(xs, _), IR.CONS(ys, _)) => ListPair.allEq IR.Var.same (xs, ys)
60 :     | (IR.SEQ(xs, _), IR.SEQ(ys, _)) => ListPair.allEq IR.Var.same (xs, ys)
61 : jhr 3554 | (IR.EINAPP(ein1, xs), IR.EINAPP(ein2, ys)) =>
62 : jhr 3556 EinUtil.same(ein1, ein2) andalso ListPair.allEq IR.Var.same (xs, ys)
63 :     | _ => false
64 : jhr 3554 (* end case *))
65 :     end)
66 :    
67 :     datatype t = TBL of {
68 :     assigns : IR.assignment list ref,
69 :     avail : IR.var Tbl.hash_table
70 :     }
71 :    
72 :     fun new () = TBL{
73 :     assigns = ref[],
74 :     avail = Tbl.mkTable (32, Fail "AvailRHS")
75 :     }
76 :    
77 : jhr 3556 fun addAssign (TBL{assigns, avail}) = let
78 :     val find = Tbl.find avail
79 :     val insert = Tbl.insert avail
80 : jhr 3554 fun add (lhs, rhs) = (case find rhs
81 :     of SOME y => (ST.tick cntReuseAssign; y)
82 :     | NONE => (
83 :     ST.tick cntNewAssign;
84 :     insert (rhs, lhs);
85 :     assigns := IR.ASSGN(lhs, rhs) :: !assigns;
86 :     lhs)
87 :     (* end case *))
88 :     in
89 : jhr 3556 add
90 : jhr 3554 end
91 :    
92 :     fun getAssignments (TBL{assigns, ...}) = !assigns
93 :    
94 :     end

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