Merge branch 'lexer-parsing-word-errors'

diff --combined core/lexer/lexer.factor
index 7ad454c67ce6866386c19e05d9a2c1836485999d,3b0348aa1016a868e2138799ecf24376d1913cac..e03cae74db80444f77ee4ae5b1d9398eb43d56f6
--- 1/core/lexer/lexer.factor
--- 2/core/lexer/lexer.factor
+++ b/core/lexer/lexer.factor
@@@ -5,7 -5,9 +5,9 @@@ io vectors arrays math.parser combinato
  source-files.errors ;
  IN: lexer
  
- TUPLE: lexer text line line-text line-length column ;
+ TUPLE: lexer text line line-text line-length column parsing-words ;
+ 
+ TUPLE: lexer-parsing-word word line line-text column ;
  
  : next-line ( lexer -- )
      dup [ line>> ] [ text>> ] bi ?nth >>line-text
@@@ -14,10 -16,23 +16,23 @@@
      0 >>column
      drop ;
  
+ : push-parsing-word ( word -- )
+     lexer-parsing-word new
+         swap >>word
+         lexer get [
+             [ line>>      >>line      ]
+             [ line-text>> >>line-text ]
+             [ column>>    >>column    ] tri
+         ] [ parsing-words>> push ] bi ;
+ 
+ : pop-parsing-word ( -- )
+     lexer get parsing-words>> pop drop ;
+ 
  : new-lexer ( text class -- lexer )
      new
          0 >>line
          swap >>text
+         V{ } clone >>parsing-words
      dup next-line ; inline
  
  : <lexer> ( text -- lexer )
@@@ -82,39 -97,56 +97,58 @@@ PREDICATE: unexpected-eof < unexpecte
      [ unexpected-eof ]
      if* ;
  
 -: (parse-tokens) ( accum end -- accum )
 -    scan 2dup = [
 -        2drop
 -    ] [
 -        [ pick push (parse-tokens) ] [ unexpected-eof ] if*
 -    ] if ;
 +: (each-token) ( end quot -- pred quot )
 +    [ [ [ scan dup ] ] dip [ = not ] curry [ [ f ] if* ] curry compose ] dip ; inline
 +
 +: each-token ( end quot -- )
 +    (each-token) while drop ; inline
 +
 +: map-tokens ( end quot -- seq )
 +    (each-token) produce nip ; inline
  
  : parse-tokens ( end -- seq )
 -    100 <vector> swap (parse-tokens) >array ;
 +    [ ] map-tokens ;
  
- TUPLE: lexer-error line column line-text error ;
+ TUPLE: lexer-error line column line-text parsing-words error ;
  
  M: lexer-error error-file error>> error-file ;
  M: lexer-error error-line [ error>> error-line ] [ line>> ] bi or ;
  
  : <lexer-error> ( msg -- error )
      \ lexer-error new
-         lexer get
-         [ line>> >>line ]
-         [ column>> >>column ]
-         [ line-text>> >>line-text ]
-         tri
+         lexer get [
+             [ line>> >>line ]
+             [ column>> >>column ] bi
+         ] [ 
+             [ line-text>> >>line-text ]
+             [ parsing-words>> clone >>parsing-words ] bi
+         ] bi
          swap >>error ;
  
- : lexer-dump ( error -- )
+ : simple-lexer-dump ( error -- )
      [ line>> number>string ": " append ]
      [ line-text>> dup string? [ drop "" ] unless ]
      [ column>> 0 or ] tri
      pick length + CHAR: \s <string>
      [ write ] [ print ] [ write "^" print ] tri* ;
  
+ : (parsing-word-lexer-dump) ( error parsing-word -- )
+     [
+         line>> number>string
+         over line>> number>string length
+         CHAR: \s pad-head
+         ": " append write
+     ] [ line-text>> dup string? [ drop "" ] unless print ] bi
+     simple-lexer-dump ;
+ 
+ : parsing-word-lexer-dump ( error parsing-word -- )
+     2dup [ line>> ] bi@ =
+     [ drop simple-lexer-dump ]
+     [ (parsing-word-lexer-dump) ] if ;
+ 
+ : lexer-dump ( error -- )
+     dup parsing-words>> [ simple-lexer-dump ] [ last parsing-word-lexer-dump ] if-empty ;
+ 
  : with-lexer ( lexer quot -- newquot )
      [ lexer set ] dip [ <lexer-error> rethrow ] recover ; inline