 ! Copyright (C) 2007, 2008 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences strings fry namespaces math assocs shuffle debugger io
-       vectors arrays math.parser math.order
-       unicode.categories compiler.units parser
+       vectors arrays math.parser math.order vectors combinators combinators.lib
+       sets unicode.categories compiler.units parser
        words quotations effects memoize accessors locals effects splitting ;
 IN: peg
 
 USE: prettyprint
 
 TUPLE: parse-result remaining ast ;
-TUPLE: parse-error details ; 
-TUPLE: error-details remaining message ;
+TUPLE: parse-error position messages ; 
 TUPLE: parser id compiled ;
 M: parser equal? [ id>> ] bi@ = ;
 
 M: parser hashcode* id>> hashcode* ;
 
 C: <parse-result>  parse-result
-C: <error-details> error-details
+C: <parse-error> parse-error
 C: <parser>        parser
 
-SYMBOL: errors
-
-: <parse-error> ( -- parse-error )
-  V{ } clone parse-error boa ;
+SYMBOL: error-stack
+
+: (merge-errors) ( a b -- c )
+  {
+    { [ over position>> not ] [ nip ] } 
+    { [ dup  position>> not ] [ drop ] } 
+    [ 2dup [ position>> ] bi@ <=> {
+        { +lt+ [ nip ] }
+        { +gt+ [ drop ] }
+        { +eq+ [ messages>> over messages>> union [ position>> ] dip <parse-error> ] }
+      } case 
+    ]
+  } cond ;
+
+: merge-errors ( -- )
+  error-stack get dup length 1 >  [
+    dup pop over pop swap (merge-errors) swap push
+  ] [
+    drop
+  ] if ;
 
 : add-error ( remaining message -- )
-  errors get [  
-    [ <error-details> ] [ details>> ] bi* push 
-  ] [
-    2drop
-  ] if* ;
+  <parse-error> error-stack get push ;
   
 SYMBOL: ignore 
 

  ] with-compilation-unit ;

: compiled-parse ( state word -- result )
  swap [ execute [ errors get throw ] unless* ] with-packrat ; inline 

: parse ( input parser -- result )
  dup word? [ compile ] unless compiled-parse ;

M: seq-parser (compile) ( parser -- quot )
  [
    [ input-slice V{ } clone <parse-result> ] %
    parsers>> unclip compiled-parser 1quotation , \ parse-seq-element , [ 
      compiled-parser 1quotation [ merge-errors ] compose , \ parse-seq-element , ] each 
  ] [ ] make ;

TUPLE: choice-parser parsers ;
