Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/smlnj-lib/RegExp/Glue/match-tree.sml
ViewVC logotype

Annotation of /sml/trunk/src/smlnj-lib/RegExp/Glue/match-tree.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1248 - (view) (download)

1 : monnier 104 (* match-tree.sml
2 :     *
3 :     * COPYRIGHT (c) 1994 AT&T Bell Laboratories.
4 :     *
5 :     * Match trees are used to represent the results of matching regular
6 :     * expressions.
7 :     *)
8 :    
9 :     signature MATCH_TREE =
10 :     sig
11 :    
12 :     (* a match tree is used to represent the results of a nested
13 :     * grouping of regular expressions.
14 :     *)
15 :     datatype 'a match_tree = Match of 'a * 'a match_tree list
16 :    
17 :     val root : 'a match_tree -> 'a
18 :     (* return the root (outermost) match in the tree *)
19 :     val nth : ('a match_tree * int) -> 'a (* raises Subscript *)
20 :     (* return the nth match in the tree; matches are labeled in pre-order
21 :     * starting at 0.
22 :     *)
23 :     val map : ('a -> 'b) -> 'a match_tree -> 'b match_tree
24 :     (* map a function over the tree (in preorder) *)
25 :     val app : ('a -> unit) -> 'a match_tree -> unit
26 :     (* apply a given function over ever element of the tree (in preorder) *)
27 :     val find : ('a -> bool) -> 'a match_tree -> 'a option
28 :     (* find the first match that satisfies the predicate (or NONE) *)
29 :     val num : 'a match_tree -> int
30 :     (* return the number of submatches included in the match tree *)
31 :     end;
32 :    
33 :     structure MatchTree :> MATCH_TREE =
34 :     struct
35 :    
36 :     datatype 'a match_tree = Match of 'a * 'a match_tree list
37 :    
38 :     fun num m =
39 :     let fun countList [] = 0
40 :     | countList ((Match (x,l))::ms) = 1+countList(l)+countList(ms)
41 :     in
42 :     (countList [m])-1
43 :     end
44 :    
45 :     (* return the root (outermost) match in the tree *)
46 :     fun root (Match (x,_)) = x
47 :    
48 :     (* return the nth match in the tree; matches are labeled in pre-order
49 :     * starting at 0.
50 :     *)
51 :     fun nth (t, n) = let
52 :     datatype 'a sum = INL of int | INR of 'a
53 : jhr 1248 fun walk (0, Match (x, _)) = INR x
54 :     | walk (i, Match (_, children)) = let
55 :     fun walkList (i, []) = INL i
56 : monnier 104 | walkList (i, m::r) = (case walk(i, m)
57 :     of (INL j) => walkList (j, r)
58 :     | result => result
59 :     (* end case *))
60 :     in
61 :     walkList (i-1, children)
62 :     end
63 :     in
64 :     case walk(n, t)
65 :     of (INR x) => x
66 :     | (INL _) => raise Subscript
67 :     (* end case *)
68 :     end
69 :    
70 :     (* map a function over the tree (in preorder) *)
71 :     fun map f = let
72 :     fun mapf (Match (x, children)) = Match(f x, mapl children)
73 :     and mapl [] = []
74 :     | mapl (x::r) = (mapf x) :: (mapl r)
75 :     in
76 :     mapf
77 :     end
78 :    
79 :     fun app f (Match (c,children)) = (f c; List.app (app f) children)
80 :    
81 :     (* find the first match that satisfies the predicate *)
82 :     fun find pred = let
83 :     fun findP (Match (x, children)) =
84 :     if (pred x)
85 :     then SOME x
86 :     else findList children
87 :     and findList [] = NONE
88 :     | findList (m::r) = (case (findP m)
89 :     of NONE => findList r
90 :     | result => result
91 :     (* end case *))
92 :     in
93 :     findP
94 :     end
95 :    
96 :     end (* MatchTree *)
97 :    

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