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

SCM Repository

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

Annotation of /branches/pure-cfg/src/compiler/IL/expr-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3349 - (view) (download)

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

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