From 611c409d6301d5ab693d26d93023cc32e396ae7b Mon Sep 17 00:00:00 2001 From: "chris.double" Date: Sun, 8 Oct 2006 11:03:07 +0000 Subject: [PATCH] parser-combinators: make lazy where needed and fix tests --- contrib/parser-combinators/load.factor | 2 +- .../parser-combinators.factor | 63 ++++++------- contrib/parser-combinators/tests.factor | 92 +++++++++---------- 3 files changed, 73 insertions(+), 84 deletions(-) diff --git a/contrib/parser-combinators/load.factor b/contrib/parser-combinators/load.factor index ffd019198a..6da9730809 100644 --- a/contrib/parser-combinators/load.factor +++ b/contrib/parser-combinators/load.factor @@ -1,4 +1,4 @@ -REQUIRES: contrib/lazy-lists ; +REQUIRES: contrib/lazy-lists contrib/sequences ; PROVIDE: contrib/parser-combinators { "parser-combinators.factor" } { diff --git a/contrib/parser-combinators/parser-combinators.factor b/contrib/parser-combinators/parser-combinators.factor index 916c1f3fa2..67523b094c 100644 --- a/contrib/parser-combinators/parser-combinators.factor +++ b/contrib/parser-combinators/parser-combinators.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2004 Chris Double. ! 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 ! Parser combinator protocol @@ -10,24 +10,13 @@ GENERIC: (parse) ( input parser -- list ) M: promise (parse) ( input parser -- list ) force (parse) ; -: parse ( input parser -- promise ) - [ (parse) ] promise-with2 ; +LAZY: parse ( input parser -- promise ) + (parse) ; 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 ; -: token ( string -- parser ) +LAZY: token ( string -- parser ) ; M: token-parser (parse) ( input parser -- list ) @@ -39,7 +28,7 @@ M: token-parser (parse) ( input parser -- list ) TUPLE: satisfy-parser quot ; -: satisfy ( quot -- parser ) +LAZY: satisfy ( quot -- parser ) ; M: satisfy-parser (parse) ( input parser -- list ) @@ -54,7 +43,7 @@ M: satisfy-parser (parse) ( input parser -- list ) TUPLE: epsilon-parser ; -: epsilon ( -- list ) +LAZY: epsilon ( -- parser ) ; M: epsilon-parser (parse) ( input parser -- list ) @@ -66,7 +55,7 @@ M: epsilon-parser (parse) ( input parser -- list ) TUPLE: succeed-parser result ; -: succeed ( result -- parser ) +LAZY: succeed ( result -- parser ) ; M: succeed-parser (parse) ( input parser -- list ) @@ -76,7 +65,7 @@ M: succeed-parser (parse) ( input parser -- list ) TUPLE: fail-parser ; -: fail ( -- parser ) +LAZY: fail ( -- parser ) ; M: fail-parser (parse) ( input parser -- list ) @@ -86,7 +75,7 @@ M: fail-parser (parse) ( input parser -- list ) TUPLE: and-parser p1 p2 ; -: <&> ( parser1 parser2 -- parser ) +LAZY: <&> ( parser1 parser2 -- parser ) ; M: and-parser (parse) ( input parser -- list ) @@ -105,7 +94,7 @@ M: and-parser (parse) ( input parser -- list ) TUPLE: or-parser p1 p2 ; -: <|> ( parser1 parser2 -- parser ) +LAZY: <|> ( parser1 parser2 -- parser ) ; 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. [ 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 #! 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 ; -: sp ( p1 -- parser ) +LAZY: sp ( p1 -- parser ) #! Return a parser that first skips all whitespace before #! calling the original parser. ; @@ -129,11 +118,11 @@ TUPLE: sp-parser p1 ; M: sp-parser (parse) ( input parser -- list ) #! Skip all leading whitespace from the input then call #! 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 ; -: just ( p1 -- parser ) +LAZY: just ( p1 -- parser ) ; M: just-parser (parse) ( input parser -- result ) @@ -145,7 +134,7 @@ M: just-parser (parse) ( input parser -- result ) TUPLE: apply-parser p1 quot ; -: <@ ( parser quot -- parser ) +LAZY: <@ ( parser quot -- parser ) ; M: apply-parser (parse) ( input parser -- result ) @@ -162,7 +151,7 @@ M: apply-parser (parse) ( input parser -- result ) TUPLE: some-parser p1 ; -: some ( p1 -- parser ) +LAZY: some ( p1 -- parser ) ; 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 ; -: <& ( parser1 parser2 -- parser ) +LAZY: <& ( parser1 parser2 -- parser ) #! Same as <&> except discard the results of the second parser. <&> [ first ] <@ ; -: &> ( parser1 parser2 -- parser ) +LAZY: &> ( parser1 parser2 -- parser ) #! Same as <&> except discard the results of the first parser. <&> [ second ] <@ ; -: <:&> ( parser1 parser2 -- result ) +LAZY: <:&> ( parser1 parser2 -- result ) #! Same as <&> except flatten the result. <&> [ dup second swap first [ % , ] { } make ] <@ ; -: <&:> ( parser1 parser2 -- result ) +LAZY: <&:> ( parser1 parser2 -- result ) #! Same as <&> except flatten the result. <&> [ dup second swap first [ , % ] { } make ] <@ ; -: <*> ( parser -- parser ) - [ dup <*> <&:> { } succeed <|> ] promise-with ; +LAZY: <*> ( parser -- parser ) + dup <*> <&:> { } succeed <|> ; -: <+> ( parser -- parser ) +LAZY: <+> ( parser -- parser ) #! Return a parser that accepts one or more occurences of the original #! parser. dup <*> <&:> ; -: ( parser -- parser ) +LAZY: ( parser -- parser ) #! Return a parser that optionally uses the parser #! if that parser would be successfull. - [ 1array ] <@ f succeed <|> ; + [ 1array ] <@ f succeed <|> ; \ No newline at end of file diff --git a/contrib/parser-combinators/tests.factor b/contrib/parser-combinators/tests.factor index 9bb7db994e..74b67370ec 100644 --- a/contrib/parser-combinators/tests.factor +++ b/contrib/parser-combinators/tests.factor @@ -5,147 +5,147 @@ USING: kernel lazy-lists test errors strings parser math sequences parser-combin IN: scratchpad ! 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 ] 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 ] 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 ] unit-test -[ { } ] [ +{ { } } [ "decd" "a" token "b" token <&> parse list>array ] unit-test -[ { } ] [ +{ { } } [ "dbcd" "a" token "b" token <&> parse list>array ] unit-test -[ { } ] [ +{ { } } [ "adcd" "a" token "b" token <&> parse list>array ] unit-test ! 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 ] 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 ] unit-test -[ { } ] [ +{ { } } [ "cbcd" "a" token "b" token <|> parse list>array ] unit-test ! Testing sp -[ { } ] [ +{ { } } [ " abcd" "a" token parse list>array ] 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 ] unit-test ! 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 ] 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 ] unit-test ! 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 ] 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 ] unit-test ! 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 ] unit-test [ - "begin1" "begin" token some parse + "begin1" "begin" token some parse force ] unit-test-fails -[ "begin" ] [ - "begin" "begin" token some parse +{ "begin" } [ + "begin" "begin" token some parse force ] unit-test ! <& 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 ] 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 ] 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 ] unit-test ! 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 ] unit-test -[ +{ { - T{ parse-result f { "1" "1" "1" "1" } "234" } - T{ parse-result f { "1" "1" "1" } "1234" } - T{ parse-result f { "1" "1" } "11234" } - T{ parse-result f { "1" } "111234" } - T{ parse-result f [ ] "1111234" } + T{ parse-result f { "1" "1" "1" "1" } T{ slice f "1111234" 4 7 } } + T{ parse-result f { "1" "1" "1" } T{ slice f "1111234" 3 7 } } + T{ parse-result f { "1" "1" } T{ slice f "1111234" 2 7 } } + T{ parse-result f { "1" } T{ slice f "1111234" 1 7 } } + T{ parse-result f { } "1111234" } } -] [ +} [ "1111234" "1" token <*> parse list>array ] unit-test -[ +{ { - T{ parse-result f { "1111" } "234" } - T{ parse-result f { "111" } "1234" } - T{ parse-result f { "11" } "11234" } - T{ parse-result f { "1" } "111234" } - T{ parse-result f { [ ] } "1111234" } + T{ parse-result f { "1111" } T{ slice f "1111234" 4 7 } } + T{ parse-result f { "111" } T{ slice f "1111234" 3 7 } } + T{ parse-result f { "11" } T{ slice f "1111234" 2 7 } } + T{ parse-result f { "1" } T{ slice f "1111234" 1 7 } } + T{ parse-result f { { } } "1111234" } } -] [ +} [ "1111234" "1" token <*> [ concat 1array ] <@ parse list>array ] unit-test -[ { T{ parse-result f [ ] "234" } } ] [ +{ { T{ parse-result f { } "234" } } } [ "234" "1" token <*> parse list>array ] unit-test ! Testing <+> -[ { T{ parse-result f { "1" } "234" } } ] [ +{ { T{ parse-result f { "1" } T{ slice f "1234" 1 4 } } } } [ "1234" "1" token <+> parse list>array ] unit-test -[ +{ { - T{ parse-result f { "1" "1" "1" "1" } "234" } - T{ parse-result f { "1" "1" "1" } "1234" } - T{ parse-result f { "1" "1" } "11234" } - T{ parse-result f { "1" } "111234" } + T{ parse-result f { "1" "1" "1" "1" } T{ slice f "1111234" 4 7 } } + T{ parse-result f { "1" "1" "1" } T{ slice f "1111234" 3 7 } } + T{ parse-result f { "1" "1" } T{ slice f "1111234" 2 7 } } + T{ parse-result f { "1" } T{ slice f "1111234" 1 7 } } } -] [ +} [ "1111234" "1" token <+> parse list>array ] unit-test -[ { } ] [ +{ { } } [ "234" "1" token <+> parse list>array ] unit-test