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

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/cfg-ir/expr-fn.sml
ViewVC logotype

Annotation of /branches/vis15/src/compiler/cfg-ir/expr-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3522 - (view) (download)

1 : jhr 3522 (* expr-fn.sml
2 :     *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2015 The University of Chicago
6 :     * All rights reserved.
7 :     *
8 :     * This functor implements hash-consing for IR expressions. It can be used to implement
9 :     * optimizations such as CSE and PRE.
10 :     *)
11 :    
12 :     signature EXPR =
13 :     sig
14 :    
15 :     structure IR : SSA
16 :     structure Op : OPERATORS where type rator = IR.Op.rator
17 :    
18 :     datatype expr_nd
19 :     = GLOBAL of IR.global_var
20 :     | STATE of IR.state_var
21 :     | VAR of IR.var
22 :     | LIT of Literal.t
23 :     | OP of Op.rator * expr list
24 :     | MULTIOP of int * Op.rator * expr list (* n'th result of operator in multi-assignment *)
25 :     | CONS of IR.Ty.ty * expr list
26 :     | PHI of expr list
27 :     | EINAPP of Ein.ein * expr list
28 :    
29 :     withtype expr = expr_nd HashCons.obj
30 :    
31 :     val same : expr * expr -> bool
32 :     val toString : expr -> string
33 :    
34 :     (* hash-cons construction of expressions *)
35 :     type tbl
36 :    
37 :     val new : unit -> tbl
38 :    
39 :     val mkGLOBAL : tbl -> IR.global_var -> expr
40 :     val mkSTATE : tbl -> IR.state_var -> expr
41 :     val mkVAR : tbl -> IR.var -> expr
42 :     val mkLIT : tbl -> Literal.t -> expr
43 :     val mkOP : tbl -> Op.rator * expr list -> expr
44 :     val mkMULTIOP : tbl -> int * Op.rator * expr list -> expr
45 :     val mkCONS : tbl -> IR.Ty.ty * expr list -> expr
46 :     val mkPHI : tbl -> expr list -> expr
47 :     val mkEinOP : tbl -> Ein.ein * expr list -> expr
48 :    
49 :     (* tables, sets, and maps *)
50 :     structure Tbl : MONO_HASH_TABLE where type Key.hash_key = expr
51 :     structure Set : ORD_SET where type Key.ord_key = expr
52 :     structure Map : ORD_MAP where type Key.ord_key = expr
53 :    
54 :     end
55 :    
56 :     functor ExprFn (IR : SSA) : EXPR =
57 :     struct
58 :    
59 :     structure IR = IR
60 :     structure Op = IR.Op
61 :     structure HC = HashCons
62 :    
63 :     datatype expr_nd
64 :     = GLOBAL of IR.global_var
65 :     | STATE of IR.state_var
66 :     | VAR of IR.var
67 :     | LIT of Literal.t
68 :     | OP of Op.rator * expr list
69 :     | MULTIOP of int * Op.rator * expr list (* n'th result of operator *)
70 :     | CONS of IR.Ty.ty * expr list
71 :     | PHI of expr list
72 :     | EINAPP of Ein.ein * expr list
73 :    
74 :     withtype expr = expr_nd HashCons.obj
75 :    
76 :     val same : expr * expr -> bool = HC.same
77 :     val same' = ListPair.allEq same
78 :    
79 :     fun sameNd (GLOBAL x, GLOBAL y) = IR.GlobalVar.same(x, y)
80 :     | sameNd (STATE x, STATE y) = IR.StateVar.same(x, y)
81 :     | sameNd (VAR x, VAR y) = IR.Var.same(x, y)
82 :     | sameNd (LIT a, LIT b) = Literal.same(a, b)
83 :     | sameNd (OP(op1, args1), OP(op2, args2)) =
84 :     Op.same(op1, op2) andalso Op.isPure op1 andalso same'(args1, args2)
85 :     | sameNd (MULTIOP(i1, op1, args1), MULTIOP(i2, op2, args2)) =
86 :     (i1 = i2) andalso Op.same(op1, op2) andalso same'(args1, args2)
87 :     | sameNd (CONS(_, args1), CONS(_, args2)) = same'(args1, args2)
88 :     | sameNd (PHI args1, PHI args2) = same'(args1, args2)
89 :     | sameNd (EINAPP(ein1, a1), EINAPP(ein2, a2)) =
90 :     EinUtil.same(ein1, ein2) andalso same'(a1, a2)
91 :     | sameNd _ = false
92 :    
93 :     fun toString exp = let
94 :     fun toS (e : expr, l) = (case #nd e
95 :     of GLOBAL x => IR.GlobalVar.toString x :: l
96 :     | STATE x => IR.StateVar.toString x :: l
97 :     | VAR x => IR.Var.toString x :: l
98 :     | LIT lit => Literal.toString lit :: l
99 :     | OP(rator, args) => Op.toString rator :: "(" :: argsToS (args, ")" :: l)
100 :     | MULTIOP(i, rator, args) =>
101 :     "#" :: Int.toString i :: "(" :: Op.toString rator :: "("
102 :     :: argsToS (args, "))" :: l)
103 :     | CONS(ty, args) => "<" :: IR.Ty.toString ty :: ">[" :: argsToS (args, "]" :: l)
104 :     | PHI args => "PHI(" :: argsToS (args, ")" :: l)
105 :     | EINAPP _=> "EINAPP" :: l (* FIXME *)
106 :     (* end case *))
107 :     and argsToS ([], l) = l
108 :     | argsToS ([e], l) = toS(e, l)
109 :     | argsToS (e::es, l) = toS(e, ","::argsToS(es, l))
110 :     in
111 :     String.concat (toS (exp, []))
112 :     end
113 :    
114 :     (* hash-cons construction of expressions *)
115 :     datatype tbl = Tbl of expr_nd HC.tbl
116 :    
117 :     fun new () = Tbl(HC.new{eq = sameNd})
118 :    
119 :     fun mkGLOBAL (Tbl tbl) x = HC.cons0 tbl (0w9941 + IR.GlobalVar.hash x, GLOBAL x)
120 :     fun mkSTATE (Tbl tbl) x = HC.cons0 tbl (0w7477 + IR.StateVar.hash x, STATE x)
121 :     fun mkVAR (Tbl tbl) x = HC.cons0 tbl (0w7919 + IR.Var.hash x, VAR x)
122 :     fun mkLIT (Tbl tbl) a = HC.cons0 tbl (0w6997 + Literal.hash a, LIT a)
123 :     fun mkOP (Tbl tbl) (rator, args) =
124 :     HC.consList tbl (Op.hash rator, fn args => OP(rator, args)) args
125 :     fun mkMULTIOP (Tbl tbl) (i, rator, args) =
126 :     HC.consList tbl (Op.hash rator + Word.fromInt i, fn args => OP(rator, args)) args
127 :     fun mkCONS (Tbl tbl) (ty, args) =
128 :     HC.consList tbl (0w5987, fn args => CONS(ty, args)) args
129 :     fun mkPHI (Tbl tbl) args = HC.consList tbl (0w6079, PHI) args
130 :     fun mkEinOP (Tbl tbl) (rator, args) = (
131 :     HC.consList tbl (EinUtil.hash rator, fn args => EINAPP(rator, args)) args)
132 :    
133 :     (* hash tables *)
134 :     structure Tbl = HashTableFn (
135 :     struct
136 :     type hash_key = expr
137 :     fun hashVal (e : expr) = #tag e
138 :     val sameKey = same
139 :     end)
140 :    
141 :     (* sets and maps *)
142 :     structure Ord =
143 :     struct
144 :     type ord_key = expr
145 :     fun compare (e1 : expr, e2 : expr) = Word.compare(#tag e1, #tag e2)
146 :     end
147 :     structure Set = RedBlackSetFn (Ord)
148 :     structure Map = RedBlackMapFn (Ord)
149 :    
150 :     end

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