Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / extra / peg-lexer / peg-lexer.factor

diff --git a/extra/peg-lexer/peg-lexer.factor b/extra/peg-lexer/peg-lexer.factor
index 032e542bcb0590bc30235becb6e8c55d7d2fbd03..dcde55c91ada82f2a6c696b928ebb2d58549a219 100644 (file)
--- a/extra/peg-lexer/peg-lexer.factor
+++ b/extra/peg-lexer/peg-lexer.factor
@@ -1,6 +1,6 @@
 USING: hashtables assocs sequences locals math accessors multiline delegate strings
-delegate.protocols kernel peg peg.ebnf lexer namespaces combinators parser words
-tools.annotations prettyprint ;
+delegate.protocols kernel peg peg.ebnf peg.private lexer namespaces combinators parser
+words ;
 IN: peg-lexer
 
 TUPLE: lex-hash hash ;
@@ -10,39 +10,50 @@ CONSULT: assoc-protocol lex-hash hash>> ;
 : pos-or-0 ( neg? -- pos/0 ) dup 0 < [ drop 0 ] when ;
 
 :: prepare-pos ( v i -- c l )
- [let | n [ i v head-slice ] |
-      v CHAR: \n n last-index -1 or 1+ -
-      n [ CHAR: \n = ] count 1+ ] ;
+    [let | n [ i v head-slice ] |
+           v CHAR: \n n last-index -1 or 1 + -
+           n [ CHAR: \n = ] count 1 +
+    ] ;
       
-: store-pos ( v a -- ) input swap at prepare-pos
-   lexer get [ (>>line) ] keep (>>column) ;
+: store-pos ( v a -- )
+    input swap at prepare-pos
+    lexer get [ (>>line) ] keep (>>column) ;
 
-M: lex-hash set-at swap {
-   { pos [ store-pos ] }
-   [ swap hash>> set-at ] } case ;
+M: lex-hash set-at
+    swap {
+        { pos [ store-pos ] }
+        [ swap hash>> set-at ]
+    } case ;
 
-:: at-pos ( t l c -- p ) t l head-slice [ length ] map sum l 1- + c + ;
+:: at-pos ( t l c -- p ) t l head-slice [ length ] map sum l 1 - + c + ;
 
-M: lex-hash at* swap {
+M: lex-hash at*
+    swap {
       { input [ drop lexer get text>> "\n" join t ] }
-      { pos [ drop lexer get [ text>> ] [ line>> 1- ] [ column>> 1+ ] tri at-pos t ] }
-      [ swap hash>> at* ] } case ;
+      { pos [ drop lexer get [ text>> ] [ line>> 1 - ] [ column>> 1 + ] tri at-pos t ] }
+      [ swap hash>> at* ]
+    } case ;
 
 : with-global-lexer ( quot -- result )
-   [ f lrstack set
-        V{ } clone error-stack set H{ } clone \ heads set
-        H{ } clone \ packrat set ] f make-assoc <lex-hash>
+   [
+       f lrstack set
+       V{ } clone error-stack set H{ } clone \ heads set
+       H{ } clone \ packrat set
+   ] f make-assoc <lex-hash>
    swap bind ; inline
 
-: parse* ( parser -- ast ) compile
-   [ execute [ error-stack get first throw ] unless* ] with-global-lexer
-   ast>> ;
+: parse* ( parser -- ast )
+    compile
+    [ execute [ error-stack get first throw ] unless* ] with-global-lexer
+    ast>> ; inline
 
-: create-bnf ( name parser -- ) reset-tokenizer [ lexer get skip-blank parse* parsed ] curry
-    define word make-parsing ;
+: create-bnf ( name parser -- )
+    reset-tokenizer [ lexer get skip-blank parse* dup ignore? [ drop ] [ parsed ] if ] curry
+    define-syntax word make-inline ;
     
-: ON-BNF: CREATE-WORD reset-tokenizer ";ON-BNF" parse-multiline-string parse-ebnf
-    main swap at create-bnf ; parsing
+SYNTAX: ON-BNF:
+    CREATE-WORD reset-tokenizer ";ON-BNF" parse-multiline-string parse-ebnf
+    main swap at create-bnf ;
 
 ! Tokenizer like standard factor lexer
 EBNF: factor
@@ -50,4 +61,4 @@ space = " " | "\n" | "\t"
 spaces = space* => [[ drop ignore ]]
 chunk = (!(space) .)+ => [[ >string ]]
 expr = spaces chunk
-;EBNF
\ No newline at end of file
+;EBNF