Annotation of /trunk/src/compiler/IL/expr-fn.sml

Parent Directory | 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	1640	= STATE of IL.state_var
20 :			| VAR of IL.var
21 :	jhr	354	| LIT of Literal.literal
22 :	jhr	1116	| OP of Op.rator * expr list
23 :	jhr	1640	| MULTIOP of int * Op.rator * expr list (* n'th result of operator in multi-assignment *)
24 :	jhr	1923	| APPLY of MathFuns.name * expr list
25 :	jhr	1116	| CONS of IL.Ty.ty * expr list
26 :	jhr	1232	| PHI of expr list
27 :	jhr	354
28 :			withtype expr = expr_nd HashCons.obj
29 :
30 :			val same : expr * expr -> bool
31 :	jhr	1640	val toString : expr -> string
32 :	jhr	354
33 :			(* hash-cons construction of expressions *)
34 :			type tbl
35 :
36 :	jhr	1232	val new : unit -> tbl
37 :	jhr	354
38 :	jhr	1640	val mkSTATE : tbl -> IL.state_var -> expr
39 :	jhr	1232	val mkVAR : tbl -> IL.var -> expr
40 :			val mkLIT : tbl -> Literal.literal -> expr
41 :			val mkOP : tbl -> Op.rator * expr list -> expr
42 :	jhr	1640	val mkMULTIOP : tbl -> int * Op.rator * expr list -> expr
43 :	jhr	1923	val mkAPPLY : tbl -> MathFuns.name * expr list -> expr
44 :	jhr	1232	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	1640	= STATE of IL.state_var
63 :			| VAR of IL.var
64 :	jhr	354	| LIT of Literal.literal
65 :	jhr	1116	| OP of Op.rator * expr list
66 :	jhr	1640	| MULTIOP of int * Op.rator * expr list (* n'th result of operator *)
67 :	jhr	1923	| APPLY of MathFuns.name * expr list
68 :	jhr	1116	| CONS of IL.Ty.ty * expr list
69 :	jhr	1232	| 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	1640	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	1116	| sameNd (OP(op1, args1), OP(op2, args2)) =
80 :	jhr	2356	Op.same(op1, op2) andalso Op.isPure op1 andalso same'(args1, args2)
81 :	jhr	1640	| sameNd (MULTIOP(i1, op1, args1), MULTIOP(i2, op2, args2)) =
82 :			(i1 = i2) andalso Op.same(op1, op2) andalso same'(args1, args2)
83 :	jhr	1232	| sameNd (APPLY(f1, args1), APPLY(f2, args2)) =
84 :	jhr	1923	MathFuns.same(f1, f2) andalso same'(args1, args2)
85 :	jhr	1232	| sameNd (CONS(_, args1), CONS(_, args2)) = same'(args1, args2)
86 :			| sameNd (PHI args1, PHI args2) = same'(args1, args2)
87 :	jhr	354	| sameNd _ = false
88 :
89 :	jhr	1640	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 :			| MULTIOP(i, rator, args) =>
96 :			"#" :: Int.toString i :: "(" :: Op.toString rator :: "("
97 :			:: argsToS (args, "))" :: l)
98 :	jhr	1923	| APPLY(f, args) => MathFuns.toString f :: "(" :: argsToS (args, ")" :: l)
99 :	jhr	1640	| 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	1923	fun mkSTATE (Tbl tbl) x = HC.cons0 tbl (0w7477 + IL.StateVar.hash x, STATE x)
115 :	jhr	354	fun mkVAR (Tbl tbl) x = HC.cons0 tbl (0w7919 + IL.Var.hash x, VAR x)
116 :			fun mkLIT (Tbl tbl) a = HC.cons0 tbl (0w6997 + Literal.hash a, LIT a)
117 :	jhr	1232	fun mkOP (Tbl tbl) (rator, args) =
118 :	jhr	1116	HC.consList tbl (Op.hash rator, fn args => OP(rator, args)) args
119 :	jhr	1640	fun mkMULTIOP (Tbl tbl) (i, rator, args) =
120 :			HC.consList tbl (Op.hash rator + Word.fromInt i, fn args => OP(rator, args)) args
121 :	jhr	1232	fun mkAPPLY (Tbl tbl) (f, args) =
122 :	jhr	1923	HC.consList tbl (MathFuns.hash f, fn args => APPLY(f, args)) args
123 :	jhr	1232	fun mkCONS (Tbl tbl) (ty, args) =
124 :			HC.consList tbl (0w5987, fn args => CONS(ty, args)) args
125 :			fun mkPHI (Tbl tbl) args = HC.consList tbl (0w6079, PHI) args
126 :	jhr	354
127 :			(* hash tables *)
128 :			structure Tbl = HashTableFn (
129 :			struct
130 :			type hash_key = expr
131 :			fun hashVal (e : expr) = #tag e
132 :			val sameKey = same
133 :			end)
134 :
135 :			(* sets and maps *)
136 :			structure Ord =
137 :			struct
138 :			type ord_key = expr
139 :			fun compare (e1 : expr, e2 : expr) = Word.compare(#tag e1, #tag e2)
140 :			end
141 :			structure Set = RedBlackSetFn (Ord)
142 :			structure Map = RedBlackMapFn (Ord)
143 :
144 :			end

---

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