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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1232 - (view) (download)

1 : jhr 354 (* expr-fn.sml
2 :     *
3 : jhr 435 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 : jhr 354 * All rights reserved.
5 :     *
6 :     * This functor implements hash-consing for IL expressions. It can be used to implement
7 :     * optimizations such as CSE and PRE.
8 :     *)
9 :    
10 :     signature EXPR =
11 :     sig
12 :    
13 :     structure IL : SSA
14 :     structure Op : OPERATORS where type rator = IL.Op.rator
15 :    
16 :     datatype expr_nd
17 :     = VAR of IL.var
18 :     | LIT of Literal.literal
19 : jhr 1116 | OP of Op.rator * expr list
20 :     | APPLY of ILBasis.name * expr list
21 :     | CONS of IL.Ty.ty * expr list
22 : jhr 1232 | PHI of expr list
23 : jhr 354
24 :     withtype expr = expr_nd HashCons.obj
25 :    
26 :     val same : expr * expr -> bool
27 :    
28 :     (* hash-cons construction of expressions *)
29 :     type tbl
30 :    
31 : jhr 1232 val new : unit -> tbl
32 : jhr 354
33 : jhr 1232 val mkVAR : tbl -> IL.var -> expr
34 :     val mkLIT : tbl -> Literal.literal -> expr
35 :     val mkOP : tbl -> Op.rator * expr list -> expr
36 :     val mkAPPLY : tbl -> ILBasis.name * expr list -> expr
37 :     val mkCONS : tbl -> IL.Ty.ty * expr list -> expr
38 :     val mkPHI : tbl -> expr list -> expr
39 :    
40 : jhr 354 (* tables, sets, and maps *)
41 :     structure Tbl : MONO_HASH_TABLE where type Key.hash_key = expr
42 :     structure Set : ORD_SET where type Key.ord_key = expr
43 :     structure Map : ORD_MAP where type Key.ord_key = expr
44 :    
45 :     end
46 :    
47 :     functor ExprFn (IL : SSA) : EXPR =
48 :     struct
49 :    
50 :     structure IL = IL
51 :     structure Op = IL.Op
52 :     structure HC = HashCons
53 :    
54 :     datatype expr_nd
55 :     = VAR of IL.var
56 :     | LIT of Literal.literal
57 : jhr 1116 | OP of Op.rator * expr list
58 :     | APPLY of ILBasis.name * expr list
59 :     | CONS of IL.Ty.ty * expr list
60 : jhr 1232 | PHI of expr list
61 : jhr 354
62 :     withtype expr = expr_nd HashCons.obj
63 :    
64 :     val same : expr * expr -> bool = HC.same
65 :     val same' = ListPair.allEq same
66 :    
67 :     fun sameNd (VAR x, VAR y) = IL.Var.same(x, y)
68 :     | sameNd (LIT a, LIT b) = Literal.same(a, b)
69 : jhr 1116 | sameNd (OP(op1, args1), OP(op2, args2)) =
70 : jhr 354 Op.same(op1, op2) andalso same'(args1, args2)
71 : jhr 1232 | sameNd (APPLY(f1, args1), APPLY(f2, args2)) =
72 :     ILBasis.same(f1, f2) andalso same'(args1, args2)
73 :     | sameNd (CONS(_, args1), CONS(_, args2)) = same'(args1, args2)
74 :     | sameNd (PHI args1, PHI args2) = same'(args1, args2)
75 : jhr 354 | sameNd _ = false
76 :    
77 :     (* hash-cons construction of expressions *)
78 :     datatype tbl = Tbl of expr_nd HC.tbl
79 :    
80 :     fun new () = Tbl(HC.new{eq = sameNd})
81 :    
82 :     fun mkVAR (Tbl tbl) x = HC.cons0 tbl (0w7919 + IL.Var.hash x, VAR x)
83 :     fun mkLIT (Tbl tbl) a = HC.cons0 tbl (0w6997 + Literal.hash a, LIT a)
84 : jhr 1232 fun mkOP (Tbl tbl) (rator, args) =
85 : jhr 1116 HC.consList tbl (Op.hash rator, fn args => OP(rator, args)) args
86 : jhr 1232 fun mkAPPLY (Tbl tbl) (f, args) =
87 :     HC.consList tbl (ILBasis.hash f, fn args => APPLY(f, args)) args
88 :     fun mkCONS (Tbl tbl) (ty, args) =
89 :     HC.consList tbl (0w5987, fn args => CONS(ty, args)) args
90 :     fun mkPHI (Tbl tbl) args = HC.consList tbl (0w6079, PHI) args
91 : jhr 354
92 :     (* hash tables *)
93 :     structure Tbl = HashTableFn (
94 :     struct
95 :     type hash_key = expr
96 :     fun hashVal (e : expr) = #tag e
97 :     val sameKey = same
98 :     end)
99 :    
100 :     (* sets and maps *)
101 :     structure Ord =
102 :     struct
103 :     type ord_key = expr
104 :     fun compare (e1 : expr, e2 : expr) = Word.compare(#tag e1, #tag e2)
105 :     end
106 :     structure Set = RedBlackSetFn (Ord)
107 :     structure Map = RedBlackMapFn (Ord)
108 :    
109 :     end

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