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

SCM Repository

[diderot] Annotation of /trunk/src/compiler/fields/shape.sml
ViewVC logotype

Annotation of /trunk/src/compiler/fields/shape.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 435 - (view) (download)

1 : jhr 342 (* shape.sml
2 :     *
3 : jhr 435 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 : jhr 342 * All rights reserved.
5 :     *
6 : jhr 349 * A tree representation of the shape of a tensor (or loop nest). The height
7 :     * of the tree corresponds to the order of the tensor (or nesting depth) plus
8 :     * one. I.e., a 0-order tensor is represented by a leaf, a 1-order tensor
9 :     * will be ND(_, [LF _, ..., LF _]), etc.
10 : jhr 342 *)
11 :    
12 : jhr 349 structure Shape : sig
13 : jhr 342
14 :     datatype ('nd, 'lf) shape
15 :     = LF of 'lf
16 :     | ND of ('nd * ('nd, 'lf) shape list)
17 :    
18 : jhr 349 (* create (depth, wid, labelNd, f, labelLf, root)
19 :     *)
20 :     val create : int * int * ('a -> 'nd) * (int * 'a -> 'a) * ('a -> 'lf) * 'a -> ('nd, 'lf) shape
21 :    
22 :     val map : ('a -> 'b) * ('c -> 'd) -> ('a,'c) shape -> ('b,'d) shape
23 :    
24 : jhr 353 (* right-to-left traversal of the tree *)
25 : jhr 349 val foldr : ('a * 'b -> 'b) -> 'b -> ('c,'a) shape -> 'b
26 :    
27 : jhr 353 val appPreOrder : ('nd -> unit) * ('lf -> unit) -> ('nd, 'lf) shape -> unit
28 :    
29 : jhr 349 end = struct
30 :    
31 :     datatype ('nd, 'lf) shape
32 :     = LF of 'lf
33 :     | ND of ('nd * ('nd, 'lf) shape list)
34 :    
35 : jhr 342 (* creates a shape with the given depth and width at each level *)
36 :     fun create (depth, width, ndAttr, f, lfAttr, init) = let
37 :     fun mk (d, i, arg) = if (d < depth)
38 :     then ND(ndAttr arg, List.tabulate(width, fn j => mk(d+1, j, f(j, arg))))
39 :     else LF(lfAttr arg)
40 :     in
41 :     mk (0, 0, init)
42 :     end
43 :    
44 :     fun map (nd, lf) t = let
45 :     fun mapf (LF x) = LF(lf x)
46 :     | mapf (ND(i, kids)) = ND(nd i, List.map mapf kids)
47 :     in
48 :     mapf t
49 :     end
50 :    
51 :     fun foldr f init t = let
52 :     fun fold (LF x, acc) = f(x, acc)
53 :     | fold (ND(_, kids), acc) = List.foldr fold acc kids
54 :     in
55 : jhr 349 fold (t, init)
56 : jhr 342 end
57 :    
58 : jhr 353 fun appPreOrder (ndFn, lfFn) = let
59 :     fun app (ND(attr, kids)) = (ndFn attr; List.app app kids)
60 :     | app (LF attr) = lfFn attr
61 :     in
62 :     app
63 :     end
64 :    
65 : jhr 342 end

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