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

basis/locals/locals-tests.factor

@@ -2,7 +2,7 @@ USING: locals math sequences tools.test hashtables words kernel
 namespaces arrays strings prettyprint io.streams.string parser
 accessors generic eval combinators combinators.short-circuit
 combinators.short-circuit.smart math.order math.functions
-definitions compiler.units fry ;
+definitions compiler.units fry lexer ;
 IN: locals.tests
 
 :: foo ( a b -- a a ) a a ;
@@ -412,6 +412,12 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 [ t ] [ 3 funny-macro-test ] unit-test
 [ f ] [ 2 funny-macro-test ] unit-test
 
+! Some odd parser corner cases
+[ "USE: locals [let" eval ] [ error>> unexpected-eof? ] must-fail-with
+[ "USE: locals [let |" eval ] [ error>> unexpected-eof? ] must-fail-with
+[ "USE: locals [let | a" eval ] [ error>> unexpected-eof? ] must-fail-with
+[ "USE: locals [|" eval ] [ error>> unexpected-eof? ] must-fail-with
+
 ! :: wlet-&&-test ( a -- ? )
 !     [wlet | is-integer? [ a integer? ]
 !             is-even? [ a even? ]

basis/locals/locals.factor

@@ -290,21 +290,15 @@ SYMBOL: in-lambda?
 
 : parse-binding ( -- pair/f )
     scan {
+        { [ dup not ] [ unexpected-eof ] }
         { [ dup "|" = ] [ drop f ] }
-        { [ dup "!" = ] [ drop lexer get next-line parse-binding ] }
-        { [ t ]
-          [
-              scan {
-                  { "["  [ \ ] parse-until >quotation ] }
-                  { "[|" [ parse-lambda ] }
-              } case 2array
-          ]
-        }
+        { [ dup "!" = ] [ drop POSTPONE: ! parse-binding ] }
+        [ scan-object 2array ]
     } cond ;
 
 : (parse-bindings) ( -- )
     parse-binding [
-        first2 >r make-local r> 2array ,
+        first2 [ make-local ] dip 2array ,
         (parse-bindings)
     ] when* ;
 
@@ -357,7 +351,7 @@ M: wlet local-rewrite*
     in>> [ dup pair? [ first ] when ] map make-locals dup push-locals ;
 
 : parse-locals-definition ( word -- word quot )
-    scan "(" assert= parse-locals \ ; (parse-lambda) <lambda>
+    "(" expect parse-locals \ ; (parse-lambda) <lambda>
     2dup "lambda" set-word-prop
     lambda-rewrite first ;
 
@@ -375,15 +369,15 @@ PRIVATE>
 : [| parse-lambda parsed-lambda ; parsing
 
 : [let
-    scan "|" assert= parse-bindings
+    "|" expect parse-bindings
     \ ] (parse-lambda) <let> parsed-lambda ; parsing
 
 : [let*
-    scan "|" assert= parse-bindings*
+    "|" expect parse-bindings*
     \ ] (parse-lambda) <let*> parsed-lambda ; parsing
 
 : [wlet
-    scan "|" assert= parse-wbindings
+    "|" expect parse-wbindings
     \ ] (parse-lambda) <wlet> parsed-lambda ; parsing
 
 : :: (::) define ; parsing

basis/qualified/qualified.factor

@@ -17,15 +17,13 @@ IN: qualified
     #! Syntax: QUALIFIED-WITH: vocab prefix
     scan scan define-qualified ; parsing
 
-: expect=> ( -- ) scan "=>" assert= ;
-
 : partial-vocab ( words vocab -- assoc )
     '[ dup _ lookup [ no-word-error ] unless* ]
     { } map>assoc ;
 
 : FROM:
     #! Syntax: FROM: vocab => words... ;
-    scan dup load-vocab drop expect=>
+    scan dup load-vocab drop "=>" expect
     ";" parse-tokens swap partial-vocab use get push ; parsing
 
 : partial-vocab-excluding ( words vocab -- assoc )
@@ -33,13 +31,13 @@ IN: qualified
 
 : EXCLUDE:
     #! Syntax: EXCLUDE: vocab => words ... ;
-    scan expect=>
+    scan "=>" expect
     ";" parse-tokens swap partial-vocab-excluding use get push ; parsing
 
 : RENAME:
     #! Syntax: RENAME: word vocab => newname
     scan scan dup load-vocab drop
     dupd lookup [ ] [ no-word-error ] ?if
-    expect=>
+    "=>" expect
     scan associate use get push ; parsing
 

core/lexer/lexer.factor

@@ -74,6 +74,12 @@ PREDICATE: unexpected-eof < unexpected
 
 : unexpected-eof ( word -- * ) f unexpected ;
 
+: expect ( token -- )
+    scan
+    [ 2dup = [ 2drop ] [ unexpected ] if ]
+    [ unexpected-eof ]
+    if* ;
+
 : (parse-tokens) ( accum end -- accum )
     scan 2dup = [
         2drop