implement Regex; include "regex.m"; # syntax # RE ALT regular expression # NUL # ALT CAT alternation # CAT | ALT # # CAT DUP catenation # DUP CAT # # DUP PRIM possibly duplicated primary # PCLO # CLO # OPT # # PCLO PRIM + 1 or more # CLO PRIM * 0 or more # OPT PRIM ? 0 or 1 # # PRIM ( RE ) # () # DOT any character # CHAR a single character # ESC escape sequence # [ SET ] character set # NUL null string # HAT beginning of string # DOL end of string # NIL : con -1; # a refRex constant NONE: con -2; # ditto, for an un-set value BAD: con 1<<16; # a non-character HUGE: con (1<<31) - 1; # the data structures of re.m would like to be ref-linked, but are # circular (see fn walk), thus instead of pointers we use indexes # into an array (arena) of nodes of the syntax tree of a regular expression. # from a storage-allocation standpoint, this replaces many small # allocations of one size with one big one of variable size. ReStr: adt { s : string; i : int; # cursor postion n : int; # number of chars left; -1 on error peek : fn(s: self ref ReStr): int; next : fn(s: self ref ReStr): int; }; ReStr.peek(s: self ref ReStr): int { if(s.n <= 0) return BAD; return s.s[s.i]; } ReStr.next(s: self ref ReStr): int { if(s.n <= 0) return BAD; s.n--; return s.s[s.i++]; } newRe(kind: int, left, right: refRex, set: ref Set, ar: ref Arena, pno: int): refRex { ar.rex[ar.ptr] = Rex(kind, left, right, set, pno); return ar.ptr++; } # parse a regex by recursive descent to get a syntax tree re(s: ref ReStr, ar: ref Arena): refRex { left := cat(s, ar); if(left==NIL || s.peek()!='|') return left; s.next(); right := re(s, ar); if(right == NIL) return NIL; return newRe(ALT, left, right, nil, ar, 0); } cat(s: ref ReStr, ar: ref Arena): refRex { left := dup(s, ar); if(left == NIL) return left; right := cat(s, ar); if(right == NIL) return left; return newRe(CAT, left, right, nil, ar, 0); } dup(s: ref ReStr, ar: ref Arena): refRex { case s.peek() { BAD or ')' or ']' or '|' or '?' or '*' or '+' => return NIL; } prim: refRex; case kind:=s.next() { '(' => if(ar.pno < 0) { if(s.peek() == ')') { s.next(); prim = newRe(NUL, NONE, NONE, nil, ar, 0); } else { prim = re(s, ar); if(prim==NIL || s.next()!=')') s.n = -1; } } else { pno := ++ar.pno; lp := newRe(LPN, NONE, NONE, nil, ar, pno); rp := newRe(RPN, NONE, NONE, nil, ar, pno); if(s.peek() == ')') { s.next(); prim = newRe(CAT, lp, rp, nil, ar, 0); } else { prim = re(s, ar); if(prim==NIL || s.next()!=')') s.n = -1; else { prim = newRe(CAT, prim, rp, nil, ar, 0); prim = newRe(CAT, lp, prim, nil, ar, 0); } } } '[' => prim = newRe(SET, NONE, NONE, newSet(s), ar, 0); * => case kind { '.' => kind = DOT; '^' => kind = HAT; '$' => kind = DOL; } prim = newRe(esc(s, kind), NONE, NONE, nil, ar, 0); } case s.peek() { '*' => kind = CLO; '+' => kind = PCLO; '?' => kind = OPT; * => return prim; } s.next(); return newRe(kind, prim, NONE, nil, ar, 0); } esc(s: ref ReStr, char: int): int { if(char == '\\') { char = s.next(); case char { BAD => s.n = -1; 'n' => char = '\n'; } } return char; } # walk the tree adjusting pointers to refer to # next state of the finite state machine walk(r: refRex, succ: refRex, ar: ref Arena) { if(r==NONE) return; rex := ar.rex[r]; case rex.kind { ALT => walk(rex.left, succ, ar); walk(rex.right, succ, ar); return; CAT => walk(rex.left, rex.right, ar); walk(rex.right, succ, ar); ar.rex[r] = ar.rex[rex.left]; # optimization return; CLO or PCLO => end := newRe(OPT, r, succ, nil, ar, 0); # here's the circularity walk(rex.left, end, ar); OPT => walk(rex.left, succ, ar); } ar.rex[r].right = succ; } compile(e: string, flag: int): (Re, string) { if(e == nil) return (nil, "missing expression"); s := ref ReStr(e, 0, len e); ar := ref Arena(array[2*s.n] of Rex, 0, 0, (flag&1)-1); start := ar.start = re(s, ar); if(start==NIL || s.n!=0) return (nil, "invalid regular expression"); walk(start, NIL, ar); if(ar.pno < 0) ar.pno = 0; return (ar, nil); } # todo1, todo2: queues for epsilon and advancing transitions Gaz: adt { pno: int; beg: int; end: int; }; Trace: adt { cre: refRex; # cursor in Re beg: int; # where this trace began; gaz: list of Gaz; }; Queue: adt { ptr: int; q: array of Trace; }; execute(re: Re, s: string): array of (int, int) { return executese(re, s, (-1,-1), 1, 1); } executese(re: Re, s: string, range: (int, int), bol: int, eol: int): array of (int,int) { if(re==nil) return nil; (s0, s1) := range; if(s0 < 0) s0 = 0; if(s1 < 0) s1 = len s; gaz : list of Gaz; (beg, end) := (-1, -1); todo1 := ref Queue(0, array[re.ptr] of Trace); todo2 := ref Queue(0, array[re.ptr] of Trace); for(i:=s0; i<=s1; i++) { small2 := HUGE; # earliest possible match if advance if(beg == -1) # no leftmost match yet todo1.q[todo1.ptr++] = Trace(re.start, i, nil); for(k:=0; k next1 = rex.right; DOT => if(i if(i == s0 && bol) next1 = rex.right; DOL => if(i == s1 && eol) next1 = rex.right; SET => if(i next1 = rex.left; ALT or CLO or OPT => next1 = rex.right; k = insert(rex.left, q.beg, q.gaz, todo1, k); LPN => next1 = rex.right; q.gaz = Gaz(rex.pno,i,-1)::q.gaz; RPN => next1 = rex.right; for(r:=q.gaz; ; r=tl r) { (pno,beg1,end1) := hd r; if(rex.pno==pno && end1==-1) { q.gaz = Gaz(pno,beg1,i)::q.gaz; break; } } * => if(i (beg,end), * => (-1,-1) }; for( ; gaz!=nil; gaz=tl gaz) { (pno, beg1, end1) := hd gaz; (rbeg, nil) := result[pno]; if(rbeg==-1 && (beg1|end1)!=-1) result[pno] = (beg1,end1); } return result; } better(newbeg, newend, oldbeg, oldend: int): int { return oldbeg==-1 || newbegoldend; } insert(next: refRex, tbeg: int, tgaz: list of Gaz, todo: ref Queue, k: int): int { for(j:=0; j>char%WORD)&1)^set.neg; for(l:=set.unicode; l!=nil; l=tl l) { (beg, end) := hd l; if(char>=beg && char<=end) return !set.neg; } return set.neg; } newSet(s: ref ReStr): ref Set { set := ref Set(0, array[ASCII/WORD] of {* => 0}, nil); if(s.peek() == '^') { set.neg = 1; s.next(); } while(s.n > 0) { char1 := s.next(); if(char1 == ']') return set; char1 = esc(s, char1); char2 := char1; if(s.peek() == '-') { s.next(); char2 = s.next(); if(char2 == ']') break; char2 = esc(s, char2); if(char2 < char1) break; } for( ; char1<=char2; char1++) if(char1 < ASCII) set.ascii[char1/WORD] |= 1<