From 9628bcd646366cba4a793a5bde1ed09c9cd29a03 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 22 Nov 2008 17:27:40 -0600
Subject: [PATCH] New 'expect' word, which is a more correct version of the
 'scan assert=' idiom

---
 basis/locals/locals-tests.factor |  8 +++++++-
 basis/locals/locals.factor       | 22 ++++++++--------------
 basis/qualified/qualified.factor |  8 +++-----
 core/lexer/lexer.factor          |  6 ++++++
 4 files changed, 24 insertions(+), 20 deletions(-)

diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor
index 60e40b9629..44c04da1a1 100644
--- a/basis/locals/locals-tests.factor
+++ b/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? ]
diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor
index 6e7f660a66..e66b1531d2 100644
--- a/basis/locals/locals.factor
+++ b/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
diff --git a/basis/qualified/qualified.factor b/basis/qualified/qualified.factor
index d387ef4b0e..25d04ed929 100644
--- a/basis/qualified/qualified.factor
+++ b/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
 
diff --git a/core/lexer/lexer.factor b/core/lexer/lexer.factor
index d284be00c9..0d6f566d36 100644
--- a/core/lexer/lexer.factor
+++ b/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