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

SCM Repository

[smlnj] Diff of /smlnj-lib/trunk/RegExp/BackEnd/bt-engine.sml
ViewVC logotype

Diff of /smlnj-lib/trunk/RegExp/BackEnd/bt-engine.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2957, Thu Mar 6 03:17:28 2008 UTC revision 2958, Tue Mar 18 16:08:01 2008 UTC
# Line 1  Line 1 
1  (* bt-engine.sml  (* bt-engine.sml
2   *   *
3   * COPYRIGHT (c) 1998 Bell Labs, Lucent Technologies.   * COPYRIGHT (c) 2008 The Fellowship of SML/NJ (http://www.smlnj.org)
4     * All rights reserved.
5   *   *
6   * Implements a regular expressions matcher based on a backtracking search.   * Implements a regular expressions matcher based on a backtracking search.
7   *)   *)
# Line 15  Line 16 
16    
17          type regexp = S.syntax          type regexp = S.syntax
18    
19      (* a match specifies the position (as a stream) and the length of the match *)
20        type 'a match = {pos : 'a, len : int} MatchTree.match_tree
21    
22          fun compile r = r          fun compile r = r
23    
24          fun scan (regexp,getc,pos,stream) =          fun scan (regexp,getc,pos,stream) =
# Line 24  Line 28 
28                  (* This function gets an empty match structure, for when the appropriate                  (* This function gets an empty match structure, for when the appropriate
29                   * alternative is not followed at all                   * alternative is not followed at all
30                   *)                   *)
31                  fun getMatchStructure (S.Group e) = [M.Match (NONE,getMatchStructure e)]              fun getMatchStructure (S.Group e) = (*[M.Match (NONE,getMatchStructure e)]*) getMatchStructure e
32                    | getMatchStructure (S.Alt l) = List.concat (map getMatchStructure l)                    | getMatchStructure (S.Alt l) = List.concat (map getMatchStructure l)
33                    | getMatchStructure (S.Concat l) = List.concat (map getMatchStructure l)                    | getMatchStructure (S.Concat l) = List.concat (map getMatchStructure l)
34                    | getMatchStructure (S.Interval (e,_,_)) = getMatchStructure e                    | getMatchStructure (S.Interval (e,_,_)) = getMatchStructure e
# Line 33  Line 37 
37                    | getMatchStructure (S.Plus e) = getMatchStructure e                    | getMatchStructure (S.Plus e) = getMatchStructure e
38                    | getMatchStructure (_) = []                    | getMatchStructure (_) = []
39                  (* Walk a regular expression in continuation-passing style                  (* Walk a regular expression in continuation-passing style
40                   * The continuation is simply a list of all this is left to do               * The continuation is simply a list of all that is left to do
41                   * Continuations only seem to arise when concatenation are considered               * Continuations only seem to arise when concatenation is considered
42                   *                   *
43                   * Walk returns the boolean status of the beast, and a match_tree                   * Walk returns the boolean status of the beast, and a match_tree
44                   * containing the match information.                   * containing the match information.
# Line 64  Line 68 
68                                 let val [(b,matches,last,s)] = cList                                 let val [(b,matches,last,s)] = cList
69                                     val [(b',matches',last',s')] = cCont                                     val [(b',matches',last',s')] = cCont
70                                 in                                 in
71                                     [(b', (M.Match (SOME {pos=inits, len=last-p},                                 [(b', (M.Match ({pos=inits, len=last-p},
72                                                     matches))::matches',last',s')]                                                     matches))::matches',last',s')]
73                                 end                                 end
74                                   | loop [] cLast n cCont cList = raise Error                                   | loop [] cLast n cCont cList = raise Error
# Line 107  Line 111 
111                               if ((b andalso b' andalso last >= last') orelse (b andalso (not b')))                               if ((b andalso b' andalso last >= last') orelse (b andalso (not b')))
112                                   then [(b,matches,last,s)]                                   then [(b,matches,last,s)]
113                               else if ((b' andalso b andalso last' > last) orelse (b' andalso (not b)))                               else if ((b' andalso b andalso last' > last) orelse (b' andalso (not b)))
114    (* FIXME: getMatchStructure isn't really doing anything so we need to fix this code.  But how? *)
115                                        then [(b',(getMatchStructure e)@matches',last',s')]                                        then [(b',(getMatchStructure e)@matches',last',s')]
116                                    else [(false,[],p,inits)]                                    else [(false,[],p,inits)]
117                      end                      end
# Line 192  Line 197 
197                  val l = walk (regexp,[],pos,stream) handle Subscript => [(false,[],pos,stream)]                  val l = walk (regexp,[],pos,stream) handle Subscript => [(false,[],pos,stream)]
198                  val v as (result,matches,last,s') = longest l handle _ => (false,[],pos,stream)                  val v as (result,matches,last,s') = longest l handle _ => (false,[],pos,stream)
199              in              in
200                  if result              if result then SOME(M.Match ({pos=stream,len=last-pos}, matches),s')
                     then SOME (M.Match (SOME {pos=stream,len=last-pos}, matches),s')  
201                  else NONE                  else NONE
202              end              end
203    
# Line 211  Line 215 
215    
216          fun match [] getc stream = NONE          fun match [] getc stream = NONE
217            | match l getc stream =            | match l getc stream =
218              let val m = map (fn (r,f) => (prefix r getc stream,f)) l          let val m = map (fn (r,f) => (scan (r, getc,0,stream), f)) l
219                  (* find the longest SOME *)                  (* find the longest SOME *)
220                  fun loop ([],max,len) = max                  fun loop ([],max,len) = max
221                    | loop ((NONE,_)::xs,max,maxlen) = loop (xs,max,maxlen)                    | loop ((NONE,_)::xs,max,maxlen) = loop (xs,max,maxlen)
222                    | loop ((SOME(m,cs),f)::xs,max,maxlen) =                    | loop ((SOME(m,cs),f)::xs,max,maxlen) =
223                      let val (SOME {pos,len}) = MatchTree.nth (m,0)                  let val {len, pos} = MatchTree.root m
224                      in                      in
225                          if (len>maxlen)                          if (len>maxlen)
226                              then loop (xs,(SOME(m,cs),f),len)                              then loop (xs,(SOME(m,cs),f),len)

Legend:
Removed from v.2957  
changed lines
  Added in v.2958

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