Merge branch 'master' of git://factorcode.org/git/factor

basis/regexp/parser/parser.factor

@@ -233,15 +233,22 @@ ERROR: invalid-range a b ;
 SINGLETON: beginning-of-input
 SINGLETON: end-of-input
 
-! : beginning-of-input ( -- obj ) 
-: handle-front-anchor ( -- ) front-anchor push-stack ;
-: end-of-line ( -- obj )
-    end-of-input
+: newlines ( -- obj1 obj2 obj3 )
     CHAR: \r <constant>
     CHAR: \n <constant>
-    2dup 2array <concatenation> 4array <alternation> lookahead boa ;
+    2dup 2array <concatenation> ;
 
-: handle-back-anchor ( -- ) end-of-line push-stack ;
+: beginning-of-line ( -- obj )
+    beginning-of-input newlines 4array <alternation> lookbehind boa ;
+
+: end-of-line ( -- obj )
+    end-of-input newlines 4array <alternation> lookahead boa ;
+
+: handle-front-anchor ( -- )
+    get-multiline beginning-of-line beginning-of-input ? push-stack ;
+
+: handle-back-anchor ( -- )
+    get-multiline end-of-line end-of-input ? push-stack ;
 
 ERROR: bad-character-class obj ;
 ERROR: expected-posix-class ;
@@ -412,16 +419,11 @@ DEFER: handle-left-bracket
     [ [ push ] keep current-regexp get (>>stack) ]
     [ finish-regexp-parse push-stack ] bi* ;
 
-
 : parse-regexp-token ( token -- ? )
     {
-! todo: only match these at beginning/end of regexp
-        { CHAR: ^ [ handle-front-anchor t ] }
-        { CHAR: $ [ handle-back-anchor t ] }
-
-        { CHAR: . [ handle-dot t ] }
-        { CHAR: ( [ handle-left-parenthesis t ] }
+        { CHAR: ( [ handle-left-parenthesis t ] } ! handle (?..) at beginning?
         { CHAR: ) [ handle-right-parenthesis f ] }
+        { CHAR: . [ handle-dot t ] }
         { CHAR: | [ handle-pipe t ] }
         { CHAR: ? [ handle-question t ] }
         { CHAR: * [ handle-star t ] }
@@ -429,16 +431,28 @@ DEFER: handle-left-bracket
         { CHAR: { [ handle-left-brace t ] }
         { CHAR: [ [ handle-left-bracket t ] }
         { CHAR: \ [ handle-escape t ] }
-        [ <constant> push-stack t ]
+        [
+            dup CHAR: $ = peek1 f = and [
+                drop
+                handle-back-anchor f
+            ] [
+                <constant> push-stack t
+            ] if
+        ]
     } case ;
 
 : (parse-regexp) ( -- )
     read1 [ parse-regexp-token [ (parse-regexp) ] when ] when* ;
 
+: parse-regexp-beginning ( -- )
+    peek1 CHAR: ^ = [ drop1 handle-front-anchor ] when ;
+
 : parse-regexp ( regexp -- )
     dup current-regexp [
         raw>> [
-            <string-reader> [ (parse-regexp) ] with-input-stream
+            <string-reader> [
+                parse-regexp-beginning (parse-regexp)
+            ] with-input-stream
         ] unless-empty
         current-regexp get
         stack finish-regexp-parse

basis/regexp/regexp-tests.factor

@@ -331,4 +331,3 @@ IN: regexp-tests
 [ { 0 3 } ] [ "abc" "(ab|a)(bc)?" <regexp> first-match ] unit-test
 
 [ { 23 24 } ] [ "aaaaaaaaaaaaaaaaaaaaaaab" "((a*)*b)*b" <regexp> first-match ] unit-test
-

basis/regexp/regexp.factor

@@ -92,7 +92,6 @@ IN: regexp
     reversed-regexp initial-option
     construct-regexp ;
 
-
 : parsing-regexp ( accum end -- accum )
     lexer get dup skip-blank
     [ [ index-from dup 1+ swap ] 2keep swapd subseq swap ] change-lexer-column
@@ -112,7 +111,6 @@ IN: regexp
 : R{ CHAR: } parsing-regexp ; parsing
 : R| CHAR: | parsing-regexp ; parsing
 
-
 : find-regexp-syntax ( string -- prefix suffix )
     {
         { "R/ "  "/"  }

basis/regexp/traversal/traversal.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs combinators kernel math math.ranges
 quotations sequences regexp.parser regexp.classes fry arrays
-combinators.short-circuit regexp.utils prettyprint regexp.nfa ;
+combinators.short-circuit regexp.utils prettyprint regexp.nfa
+shuffle ;
 IN: regexp.traversal
 
 TUPLE: dfa-traverser
@@ -23,8 +24,7 @@ TUPLE: dfa-traverser
     [ dfa-table>> ] [ dfa-traversal-flags>> ] bi
     dfa-traverser new
         swap >>traversal-flags
-        swap [ start-state>> >>current-state ] keep
-        >>dfa-table
+        swap [ start-state>> >>current-state ] [ >>dfa-table ] bi
         swap >>text
         t >>traverse-forward
         0 >>start-index
@@ -116,7 +116,7 @@ M: capture-group-off flag-action ( dfa-traverser flag -- )
     V{ } clone >>matches ;
 
 : match-literal ( transition from-state table -- to-state/f )
-    transitions>> at* [ at ] [ 2drop f ] if ;
+    transitions>> at at ;
 
 : match-class ( transition from-state table -- to-state/f )
     transitions>> at* [
@@ -124,8 +124,7 @@ M: capture-group-off flag-action ( dfa-traverser flag -- )
     ] [ drop ] if ;
 
 : match-default ( transition from-state table -- to-state/f )
-    [ nip ] dip transitions>> at*
-    [ t swap at* [ ] [ drop f ] if ] [ drop f ] if ;
+    nipd transitions>> at t swap at ;
 
 : match-transition ( obj from-state dfa -- to-state/f )
     { [ match-literal ] [ match-class ] [ match-default ] } 3|| ;

extra/project-euler/project-euler.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2007, 2008 Aaron Schaefer, Samuel Tardieu.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: definitions io io.files kernel math math.parser project-euler.ave-time
-    sequences vocabs vocabs.loader
+    sequences vocabs vocabs.loader prettyprint
     project-euler.001 project-euler.002 project-euler.003 project-euler.004
     project-euler.005 project-euler.006 project-euler.007 project-euler.008
     project-euler.009 project-euler.010 project-euler.011 project-euler.012
@@ -33,7 +33,7 @@ IN: project-euler
 
 : solution-path ( n -- str/f )
     number>euler "project-euler." prepend
-    vocab where dup [ first ] when ;
+    vocab where dup [ first <pathname> ] when ;
 
 PRIVATE>
 
@@ -43,8 +43,8 @@ PRIVATE>
 : run-project-euler ( -- )
     problem-prompt dup problem-solved? [
         dup number>euler "project-euler." prepend run
-        "Answer: " swap dup number? [ number>string ] when append print
-        "Source: " swap solution-path append print
+        "Answer: " write dup number? [ number>string ] when print
+        "Source: " write solution-path .
     ] [
         drop "That problem has not been solved yet..." print
     ] if ;