steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

parser-combinators: make lazy where needed and fix tests

darcs
chris.double 2006-10-08 11:03:07 +00:00
parent 7a45882be2
commit 611c409d63
3 changed files with 73 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
contrib/parser-combinators/load.factor
View File

@ -1,4 +1,4 @@
REQUIRES: contrib/lazy-lists ; REQUIRES: contrib/lazy-lists contrib/sequences ;
PROVIDE: contrib/parser-combinators { PROVIDE: contrib/parser-combinators {
"parser-combinators.factor" "parser-combinators.factor"
} { } {

63
contrib/parser-combinators/parser-combinators.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2004 Chris Double. ! Copyright (C) 2004 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! !
USING: lazy-lists kernel sequences strings math io arrays errors namespaces ; USING: lazy-lists kernel sequences sequences-contrib strings math io arrays errors namespaces ;
IN: parser-combinators IN: parser-combinators
! Parser combinator protocol ! Parser combinator protocol
@ -10,24 +10,13 @@ GENERIC: (parse) ( input parser -- list )
M: promise (parse) ( input parser -- list ) M: promise (parse) ( input parser -- list )
force (parse) ; force (parse) ;
: parse ( input parser -- promise ) LAZY: parse ( input parser -- promise )
[ (parse) ] promise-with2 ; (parse) ;
TUPLE: parse-result parsed unparsed ; TUPLE: parse-result parsed unparsed ;
: ?head-slice ( seq begin -- newseq ? )
2dup head? [ length tail-slice t ] [ drop f ] if ;
: unclip-slice ( seq -- rest first )
dup 1 tail-slice swap first ;
: h:t ( object -- head tail )
#! Return the head and tail of the object.
dup empty? [ dup first swap 1 tail ] unless ;
TUPLE: token-parser string ; TUPLE: token-parser string ;
: token ( string -- parser ) LAZY: token ( string -- parser )
<token-parser> ; <token-parser> ;
M: token-parser (parse) ( input parser -- list ) M: token-parser (parse) ( input parser -- list )
@ -39,7 +28,7 @@ M: token-parser (parse) ( input parser -- list )
TUPLE: satisfy-parser quot ; TUPLE: satisfy-parser quot ;
: satisfy ( quot -- parser ) LAZY: satisfy ( quot -- parser )
<satisfy-parser> ; <satisfy-parser> ;
M: satisfy-parser (parse) ( input parser -- list ) M: satisfy-parser (parse) ( input parser -- list )
@ -54,7 +43,7 @@ M: satisfy-parser (parse) ( input parser -- list )
TUPLE: epsilon-parser ; TUPLE: epsilon-parser ;
: epsilon ( -- list ) LAZY: epsilon ( -- parser )
<epsilon-parser> ; <epsilon-parser> ;
M: epsilon-parser (parse) ( input parser -- list ) M: epsilon-parser (parse) ( input parser -- list )
@ -66,7 +55,7 @@ M: epsilon-parser (parse) ( input parser -- list )
TUPLE: succeed-parser result ; TUPLE: succeed-parser result ;
: succeed ( result -- parser ) LAZY: succeed ( result -- parser )
<succeed-parser> ; <succeed-parser> ;
M: succeed-parser (parse) ( input parser -- list ) M: succeed-parser (parse) ( input parser -- list )
@ -76,7 +65,7 @@ M: succeed-parser (parse) ( input parser -- list )
TUPLE: fail-parser ; TUPLE: fail-parser ;
: fail ( -- parser ) LAZY: fail ( -- parser )
<fail-parser> ; <fail-parser> ;
M: fail-parser (parse) ( input parser -- list ) M: fail-parser (parse) ( input parser -- list )
@ -86,7 +75,7 @@ M: fail-parser (parse) ( input parser -- list )
TUPLE: and-parser p1 p2 ; TUPLE: and-parser p1 p2 ;
: <&> ( parser1 parser2 -- parser ) LAZY: <&> ( parser1 parser2 -- parser )
<and-parser> ; <and-parser> ;
M: and-parser (parse) ( input parser -- list ) M: and-parser (parse) ( input parser -- list )
@ -105,7 +94,7 @@ M: and-parser (parse) ( input parser -- list )
TUPLE: or-parser p1 p2 ; TUPLE: or-parser p1 p2 ;
: <|> ( parser1 parser2 -- parser ) LAZY: <|> ( parser1 parser2 -- parser )
<or-parser> ; <or-parser> ;
M: or-parser (parse) ( input parser1 -- list ) M: or-parser (parse) ( input parser1 -- list )
@ -114,14 +103,14 @@ M: or-parser (parse) ( input parser1 -- list )
#! input. This implements the choice parsing operator. #! input. This implements the choice parsing operator.
[ or-parser-p1 ] keep or-parser-p2 >r dupd parse swap r> parse lappend ; [ or-parser-p1 ] keep or-parser-p2 >r dupd parse swap r> parse lappend ;
: string-ltrim ( string -- string ) : ltrim-slice ( string -- string )
#! Return a new string without any leading whitespace #! Return a new string without any leading whitespace
#! from the original string. #! from the original string.
dup first blank? [ 1 tail-slice string-ltrim ] when ; dup first blank? [ 1 tail-slice ltrim-slice ] when ;
TUPLE: sp-parser p1 ; TUPLE: sp-parser p1 ;
: sp ( p1 -- parser ) LAZY: sp ( p1 -- parser )
#! Return a parser that first skips all whitespace before #! Return a parser that first skips all whitespace before
#! calling the original parser. #! calling the original parser.
<sp-parser> ; <sp-parser> ;
@ -129,11 +118,11 @@ TUPLE: sp-parser p1 ;
M: sp-parser (parse) ( input parser -- list ) M: sp-parser (parse) ( input parser -- list )
#! Skip all leading whitespace from the input then call #! Skip all leading whitespace from the input then call
#! the parser on the remaining input. #! the parser on the remaining input.
>r string-ltrim r> sp-parser-p1 parse ; >r ltrim-slice r> sp-parser-p1 parse ;
TUPLE: just-parser p1 ; TUPLE: just-parser p1 ;
: just ( p1 -- parser ) LAZY: just ( p1 -- parser )
<just-parser> ; <just-parser> ;
M: just-parser (parse) ( input parser -- result ) M: just-parser (parse) ( input parser -- result )
@ -145,7 +134,7 @@ M: just-parser (parse) ( input parser -- result )
TUPLE: apply-parser p1 quot ; TUPLE: apply-parser p1 quot ;
: <@ ( parser quot -- parser ) LAZY: <@ ( parser quot -- parser )
<apply-parser> ; <apply-parser> ;
M: apply-parser (parse) ( input parser -- result ) M: apply-parser (parse) ( input parser -- result )
@ -162,7 +151,7 @@ M: apply-parser (parse) ( input parser -- result )
TUPLE: some-parser p1 ; TUPLE: some-parser p1 ;
: some ( p1 -- parser ) LAZY: some ( p1 -- parser )
<some-parser> ; <some-parser> ;
M: some-parser (parse) ( input parser -- result ) M: some-parser (parse) ( input parser -- result )
@ -173,31 +162,31 @@ M: some-parser (parse) ( input parser -- result )
some-parser-p1 just parse car parse-result-parsed ; some-parser-p1 just parse car parse-result-parsed ;
: <& ( parser1 parser2 -- parser ) LAZY: <& ( parser1 parser2 -- parser )
#! Same as <&> except discard the results of the second parser. #! Same as <&> except discard the results of the second parser.
<&> [ first ] <@ ; <&> [ first ] <@ ;
: &> ( parser1 parser2 -- parser ) LAZY: &> ( parser1 parser2 -- parser )
#! Same as <&> except discard the results of the first parser. #! Same as <&> except discard the results of the first parser.
<&> [ second ] <@ ; <&> [ second ] <@ ;
: <:&> ( parser1 parser2 -- result ) LAZY: <:&> ( parser1 parser2 -- result )
#! Same as <&> except flatten the result. #! Same as <&> except flatten the result.
<&> [ dup second swap first [ % , ] { } make ] <@ ; <&> [ dup second swap first [ % , ] { } make ] <@ ;
: <&:> ( parser1 parser2 -- result ) LAZY: <&:> ( parser1 parser2 -- result )
#! Same as <&> except flatten the result. #! Same as <&> except flatten the result.
<&> [ dup second swap first [ , % ] { } make ] <@ ; <&> [ dup second swap first [ , % ] { } make ] <@ ;
: <*> ( parser -- parser ) LAZY: <*> ( parser -- parser )
[ dup <*> <&:> { } succeed <|> ] promise-with ; dup <*> <&:> { } succeed <|> ;
: <+> ( parser -- parser ) LAZY: <+> ( parser -- parser )
#! Return a parser that accepts one or more occurences of the original #! Return a parser that accepts one or more occurences of the original
#! parser. #! parser.
dup <*> <&:> ; dup <*> <&:> ;
: <?> ( parser -- parser ) LAZY: <?> ( parser -- parser )
#! Return a parser that optionally uses the parser #! Return a parser that optionally uses the parser
#! if that parser would be successfull. #! if that parser would be successfull.
[ 1array ] <@ f succeed <|> ; [ 1array ] <@ f succeed <|> ;

92
contrib/parser-combinators/tests.factor
View File

@ -5,147 +5,147 @@ USING: kernel lazy-lists test errors strings parser math sequences parser-combin
IN: scratchpad IN: scratchpad
! Testing <&> ! Testing <&>
[ { T{ parse-result f { "a" "b" } T{ slice f "abcd" 2 4 } } } ] [ { { T{ parse-result f { "a" "b" } T{ slice f "abcd" 2 4 } } } } [
"abcd" "a" token "b" token <&> parse list>array "abcd" "a" token "b" token <&> parse list>array
] unit-test ] unit-test
[ { T{ parse-result f { { "a" "b" } "c" } T{ slice f "abcd" 3 4 } } } ] [ { { T{ parse-result f { { "a" "b" } "c" } T{ slice f "abcd" 3 4 } } } } [
"abcd" "a" token "b" token <&> "c" token <&> parse list>array "abcd" "a" token "b" token <&> "c" token <&> parse list>array
] unit-test ] unit-test
[ { T{ parse-result f { "a" { "b" "c" } } T{ slice f "abcd" 3 4 } } } ] [ { { T{ parse-result f { "a" { "b" "c" } } T{ slice f "abcd" 3 4 } } } } [
"abcd" "a" token "b" token "c" token <&> <&> parse list>array "abcd" "a" token "b" token "c" token <&> <&> parse list>array
] unit-test ] unit-test
[ { } ] [ { { } } [
"decd" "a" token "b" token <&> parse list>array "decd" "a" token "b" token <&> parse list>array
] unit-test ] unit-test
[ { } ] [ { { } } [
"dbcd" "a" token "b" token <&> parse list>array "dbcd" "a" token "b" token <&> parse list>array
] unit-test ] unit-test
[ { } ] [ { { } } [
"adcd" "a" token "b" token <&> parse list>array "adcd" "a" token "b" token <&> parse list>array
] unit-test ] unit-test
! Testing <|> ! Testing <|>
[ { T{ parse-result f "a" T{ slice f "abcd" 1 4 } } } ] [ { { T{ parse-result f "a" T{ slice f "abcd" 1 4 } } } } [
"abcd" "a" token "b" token <|> parse list>array "abcd" "a" token "b" token <|> parse list>array
] unit-test ] unit-test
[ { T{ parse-result f "b" T{ slice f "bbcd" 1 4 } } } ] [ { { T{ parse-result f "b" T{ slice f "bbcd" 1 4 } } } } [
"bbcd" "a" token "b" token <|> parse list>array "bbcd" "a" token "b" token <|> parse list>array
] unit-test ] unit-test
[ { } ] [ { { } } [
"cbcd" "a" token "b" token <|> parse list>array "cbcd" "a" token "b" token <|> parse list>array
] unit-test ] unit-test
! Testing sp ! Testing sp
[ { } ] [ { { } } [
" abcd" "a" token parse list>array " abcd" "a" token parse list>array
] unit-test ] unit-test
[ { T{ parse-result f "a" T{ slice f " abcd" 3 6 } } } ] [ { { T{ parse-result f "a" T{ slice f " abcd" 3 6 } } } } [
" abcd" "a" token sp parse list>array " abcd" "a" token sp parse list>array
] unit-test ] unit-test
! Testing just ! Testing just
[ { T{ parse-result f "abcd" T{ slice f "abcd" 4 4 } } T{ parse-result f "abc" T{ slice f "abcd" 3 4 } } } ] [ { { T{ parse-result f "abcd" T{ slice f "abcd" 4 4 } } T{ parse-result f "abc" T{ slice f "abcd" 3 4 } } } } [
"abcd" "abcd" token "abc" token <|> parse list>array "abcd" "abcd" token "abc" token <|> parse list>array
] unit-test ] unit-test
[ { T{ parse-result f "abcd" T{ slice f "abcd" 4 4 } } } ] [ { { T{ parse-result f "abcd" T{ slice f "abcd" 4 4 } } } } [
"abcd" "abcd" token "abc" token <|> just parse list>array "abcd" "abcd" token "abc" token <|> just parse list>array
] unit-test ] unit-test
! Testing <@ ! Testing <@
[ { T{ parse-result f 48 T{ slice f "01234" 1 5 } } } ] [ { { T{ parse-result f 48 T{ slice f "01234" 1 5 } } } } [
"01234" [ digit? ] satisfy parse list>array "01234" [ digit? ] satisfy parse list>array
] unit-test ] unit-test
[ { T{ parse-result f 0 T{ slice f "01234" 1 5 } } } ] [ { { T{ parse-result f 0 T{ slice f "01234" 1 5 } } } } [
"01234" [ digit? ] satisfy [ digit> ] <@ parse list>array "01234" [ digit? ] satisfy [ digit> ] <@ parse list>array
] unit-test ] unit-test
! Testing some ! Testing some
[ { T{ parse-result f "begin" T{ slice f "begin1" 5 6 } } } ] [ { { T{ parse-result f "begin" T{ slice f "begin1" 5 6 } } } } [
"begin1" "begin" token parse list>array "begin1" "begin" token parse list>array
] unit-test ] unit-test
[ [
"begin1" "begin" token some parse "begin1" "begin" token some parse force
] unit-test-fails ] unit-test-fails
[ "begin" ] [ { "begin" } [
"begin" "begin" token some parse "begin" "begin" token some parse force
] unit-test ] unit-test
! <& parser and &> parser ! <& parser and &> parser
[ { T{ parse-result f { "a" "b" } T{ slice f "abcd" 2 4 } } } ] [ { { T{ parse-result f { "a" "b" } T{ slice f "abcd" 2 4 } } } } [
"abcd" "a" token "b" token <&> parse list>array "abcd" "a" token "b" token <&> parse list>array
] unit-test ] unit-test
[ { T{ parse-result f "a" T{ slice f "abcd" 2 4 } } } ] [ { { T{ parse-result f "a" T{ slice f "abcd" 2 4 } } } } [
"abcd" "a" token "b" token <& parse list>array "abcd" "a" token "b" token <& parse list>array
] unit-test ] unit-test
[ { T{ parse-result f "b" T{ slice f "abcd" 2 4 } } } ] [ { { T{ parse-result f "b" T{ slice f "abcd" 2 4 } } } } [
"abcd" "a" token "b" token &> parse list>array "abcd" "a" token "b" token &> parse list>array
] unit-test ] unit-test
! Testing <*> and <:&> ! Testing <*> and <:&>
[ { T{ parse-result f { "1" } T{ slice f "1234" 1 4 } } T{ parse-result f [ ] "1234" } } } ] [ { { T{ parse-result f { "1" } T{ slice f "1234" 1 4 } } T{ parse-result f { } "1234" } } } [
"1234" "1" token <*> parse list>array "1234" "1" token <*> parse list>array
] unit-test ] unit-test
[ {
{ {
T{ parse-result f { "1" "1" "1" "1" } "234" } T{ parse-result f { "1" "1" "1" "1" } T{ slice f "1111234" 4 7 } }
T{ parse-result f { "1" "1" "1" } "1234" } T{ parse-result f { "1" "1" "1" } T{ slice f "1111234" 3 7 } }
T{ parse-result f { "1" "1" } "11234" } T{ parse-result f { "1" "1" } T{ slice f "1111234" 2 7 } }
T{ parse-result f { "1" } "111234" } T{ parse-result f { "1" } T{ slice f "1111234" 1 7 } }
T{ parse-result f [ ] "1111234" } T{ parse-result f { } "1111234" }
} }
] [ } [
"1111234" "1" token <*> parse list>array "1111234" "1" token <*> parse list>array
] unit-test ] unit-test
[ {
{ {
T{ parse-result f { "1111" } "234" } T{ parse-result f { "1111" } T{ slice f "1111234" 4 7 } }
T{ parse-result f { "111" } "1234" } T{ parse-result f { "111" } T{ slice f "1111234" 3 7 } }
T{ parse-result f { "11" } "11234" } T{ parse-result f { "11" } T{ slice f "1111234" 2 7 } }
T{ parse-result f { "1" } "111234" } T{ parse-result f { "1" } T{ slice f "1111234" 1 7 } }
T{ parse-result f { [ ] } "1111234" } T{ parse-result f { { } } "1111234" }
} }
] [ } [
"1111234" "1" token <*> [ concat 1array ] <@ parse list>array "1111234" "1" token <*> [ concat 1array ] <@ parse list>array
] unit-test ] unit-test
[ { T{ parse-result f [ ] "234" } } ] [ { { T{ parse-result f { } "234" } } } [
"234" "1" token <*> parse list>array "234" "1" token <*> parse list>array
] unit-test ] unit-test
! Testing <+> ! Testing <+>
[ { T{ parse-result f { "1" } "234" } } ] [ { { T{ parse-result f { "1" } T{ slice f "1234" 1 4 } } } } [
"1234" "1" token <+> parse list>array "1234" "1" token <+> parse list>array
] unit-test ] unit-test
[ {
{ {
T{ parse-result f { "1" "1" "1" "1" } "234" } T{ parse-result f { "1" "1" "1" "1" } T{ slice f "1111234" 4 7 } }
T{ parse-result f { "1" "1" "1" } "1234" } T{ parse-result f { "1" "1" "1" } T{ slice f "1111234" 3 7 } }
T{ parse-result f { "1" "1" } "11234" } T{ parse-result f { "1" "1" } T{ slice f "1111234" 2 7 } }
T{ parse-result f { "1" } "111234" } T{ parse-result f { "1" } T{ slice f "1111234" 1 7 } }
} }
] [ } [
"1111234" "1" token <+> parse list>array "1111234" "1" token <+> parse list>array
] unit-test ] unit-test
[ { } ] [ { { } } [
"234" "1" token <+> parse list>array "234" "1" token <+> parse list>array
] unit-test ] unit-test