Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / regexp / compiler / compiler.factor

diff --git a/basis/regexp/compiler/compiler.factor b/basis/regexp/compiler/compiler.factor
index c837df0f0f2e887586ea77d396c2cf84d26b95a2..d8940bb829a3afc70848194901b8a795d36d8999 100644 (file)
--- a/basis/regexp/compiler/compiler.factor
+++ b/basis/regexp/compiler/compiler.factor
@@ -3,7 +3,7 @@
 USING: regexp.classes kernel sequences regexp.negation
 quotations assocs fry math locals combinators
 accessors words compiler.units kernel.private strings
-sequences.private arrays call namespaces unicode.breaks
+sequences.private arrays namespaces unicode.breaks
 regexp.transition-tables combinators.short-circuit ;
 IN: regexp.compiler
 
@@ -17,9 +17,6 @@ SYMBOL: backwards?
 M: t question>quot drop [ 2drop t ] ;
 M: f question>quot drop [ 2drop f ] ;
 
-M: not-class question>quot
-    class>> question>quot [ not ] compose ;
-
 M: beginning-of-input question>quot
     drop [ drop zero? ] ;
 
@@ -38,7 +35,13 @@ M: $ question>quot
     drop [ { [ length = ] [ ?nth "\r\n" member? ] } 2|| ] ;
 
 M: ^ question>quot
-    drop [ { [ drop zero? ] [ [ 1- ] dip ?nth "\r\n" member? ] } 2|| ] ;
+    drop [ { [ drop zero? ] [ [ 1 - ] dip ?nth "\r\n" member? ] } 2|| ] ;
+
+M: $unix question>quot
+    drop [ { [ length = ] [ ?nth CHAR: \n = ] } 2|| ] ;
+
+M: ^unix question>quot
+    drop [ { [ drop zero? ] [ [ 1 - ] dip ?nth CHAR: \n = ] } 2|| ] ;
 
 M: word-break question>quot
     drop [ word-break-at? ] ;
@@ -77,34 +80,28 @@ C: <box> box
 : literals>cases ( literal-transitions -- case-body )
     [ execution-quot ] assoc-map ;
 
-: expand-one-or ( or-class transition -- alist )
-    [ seq>> ] dip '[ _ 2array ] map ;
-
-: expand-or ( alist -- new-alist )
-    [
-        first2 over or-class?
-        [ expand-one-or ] [ 2array 1array ] if
-    ] map concat ;
-
 : split-literals ( transitions -- case default )
-    >alist expand-or [ first integer? ] partition
+    { } assoc-like [ first integer? ] partition
     [ [ literals>cases ] keep ] dip non-literals>dispatch ;
 
-:: step ( last-match index str quot final? direction -- last-index/f )
+: advance ( index backwards? -- index+/-1 )
+    -1 1 ? + >fixnum ; inline
+
+: check ( index string backwards? -- in-bounds? )
+    [ drop -1 eq? not ] [ length < ] if ; inline
+
+:: step ( last-match index str quot final? backwards? -- last-index/f )
     final? index last-match ?
-    index str bounds-check? [
-        index direction + str
+    index str backwards? check [
+        index backwards? advance str
         index str nth-unsafe
         quot call
     ] when ; inline
 
-: direction ( -- n )
-    backwards? get -1 1 ? ;
-
 : transitions>quot ( transitions final-state? -- quot )
     dup shortest? get and [ 2drop [ drop nip ] ] [
-        [ split-literals swap case>quot ] dip direction
-        '[ { array-capacity string } declare _ _ _ step ]
+        [ split-literals swap case>quot ] dip backwards? get
+        '[ { fixnum string } declare _ _ _ step ]
     ] if ;
 
 : word>quot ( word dfa -- quot )
@@ -113,15 +110,11 @@ C: <box> box
     transitions>quot ;
 
 : states>code ( words dfa -- )
-    [ ! with-compilation-unit doesn't compile, so we need call( -- )
-        [
-            '[
-                dup _ word>quot
-                (( last-match index string -- ? ))
-                define-declared
-            ] each
-        ] with-compilation-unit
-    ] call( words dfa -- ) ;
+    '[
+        dup _ word>quot
+        (( last-match index string -- ? ))
+        define-declared
+    ] each ;
 
 : states>words ( dfa -- words dfa )
     dup transitions>> keys [ gensym ] H{ } map>assoc
@@ -132,14 +125,14 @@ C: <box> box
 : dfa>main-word ( dfa -- word )
     states>words [ states>code ] keep start-state>> ;
 
-PRIVATE>
+: word-template ( quot -- quot' )
+    '[ drop [ f ] 2dip over array-capacity? _ [ 2drop ] if ] ;
 
-: simple-define-temp ( quot effect -- word )
-    [ [ define-temp ] with-compilation-unit ] call( quot effect -- word ) ;
+PRIVATE>
 
 : dfa>word ( dfa -- quot )
-    dfa>main-word execution-quot '[ drop [ f ] 2dip @ ]
-    (( start-index string regexp -- i/f )) simple-define-temp ;
+    dfa>main-word execution-quot word-template
+    (( start-index string regexp -- i/f )) define-temp ;
 
 : dfa>shortest-word ( dfa -- word )
     t shortest? [ dfa>word ] with-variable ;