diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -32,3 +32,8 @@ * Support for `parsley-core-2.0.0` and `parsley-core-1.7.1`. * Re-exports less from `parsley-core`, instead using (currently hidden) redefinition. + +## 1.0.1.0 -- 2021-11-13 + +* Added `line` and `col` combinators. +* Added `pos` combinator. diff --git a/benchmarks/NandlangBench/Bison/Nandlang.tab.c b/benchmarks/NandlangBench/Bison/Nandlang.tab.c --- a/benchmarks/NandlangBench/Bison/Nandlang.tab.c +++ b/benchmarks/NandlangBench/Bison/Nandlang.tab.c @@ -1587,7 +1587,7 @@ void set_input_string(const char* in); void end_lexical_scan(void); -bool parse(const char* in) +bool parse(const char* in) { set_input_string(in); int rv = yyparse(); @@ -1595,7 +1595,7 @@ return !rv; } -void yyerror(const char* msg) +void yyerror(const char* msg) { return; } diff --git a/benchmarks/NandlangBench/Bison/lex.yy.c b/benchmarks/NandlangBench/Bison/lex.yy.c --- a/benchmarks/NandlangBench/Bison/lex.yy.c +++ b/benchmarks/NandlangBench/Bison/lex.yy.c @@ -33,7 +33,7 @@ #if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L /* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, - * if you want the limit (max/min) macros for int types. + * if you want the limit (max/min) macros for int types. */ #ifndef __STDC_LIMIT_MACROS #define __STDC_LIMIT_MACROS 1 @@ -50,7 +50,7 @@ typedef signed char flex_int8_t; typedef short int flex_int16_t; typedef int flex_int32_t; -typedef unsigned char flex_uint8_t; +typedef unsigned char flex_uint8_t; typedef unsigned short int flex_uint16_t; typedef unsigned int flex_uint32_t; @@ -161,10 +161,10 @@ #define EOB_ACT_CONTINUE_SCAN 0 #define EOB_ACT_END_OF_FILE 1 #define EOB_ACT_LAST_MATCH 2 - + #define YY_LESS_LINENO(n) #define YY_LINENO_REWIND_TO(ptr) - + /* Return all but the first "n" matched characters back to the input stream. */ #define yyless(n) \ do \ @@ -593,9 +593,9 @@ #endif #ifndef YY_NO_UNPUT - + static void yyunput ( int c, char *buf_ptr ); - + #endif #ifndef yytext_ptr @@ -722,7 +722,7 @@ yy_state_type yy_current_state; char *yy_cp, *yy_bp; int yy_act; - + if ( !(yy_init) ) { (yy_init) = 1; @@ -1214,7 +1214,7 @@ { yy_state_type yy_current_state; char *yy_cp; - + yy_current_state = (yy_start); for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp ) @@ -1270,7 +1270,7 @@ static void yyunput (int c, char * yy_bp ) { char *yy_cp; - + yy_cp = (yy_c_buf_p); /* undo effects of setting up yytext */ @@ -1315,7 +1315,7 @@ { int c; - + *(yy_c_buf_p) = (yy_hold_char); if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR ) @@ -1382,12 +1382,12 @@ /** Immediately switch to a different input stream. * @param input_file A readable stream. - * + * * @note This function does not reset the start condition to @c INITIAL . */ void yyrestart (FILE * input_file ) { - + if ( ! YY_CURRENT_BUFFER ){ yyensure_buffer_stack (); YY_CURRENT_BUFFER_LVALUE = @@ -1400,11 +1400,11 @@ /** Switch to a different input buffer. * @param new_buffer The new input buffer. - * + * */ void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer ) { - + /* TODO. We should be able to replace this entire function body * with * yypop_buffer_state(); @@ -1444,13 +1444,13 @@ /** Allocate and initialize an input buffer state. * @param file A readable stream. * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE. - * + * * @return the allocated buffer state. */ YY_BUFFER_STATE yy_create_buffer (FILE * file, int size ) { YY_BUFFER_STATE b; - + b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) ); if ( ! b ) YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); @@ -1473,11 +1473,11 @@ /** Destroy the buffer. * @param b a buffer created with yy_create_buffer() - * + * */ void yy_delete_buffer (YY_BUFFER_STATE b ) { - + if ( ! b ) return; @@ -1498,7 +1498,7 @@ { int oerrno = errno; - + yy_flush_buffer( b ); b->yy_input_file = file; @@ -1514,13 +1514,13 @@ } b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0; - + errno = oerrno; } /** Discard all buffered characters. On the next scan, YY_INPUT will be called. * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER. - * + * */ void yy_flush_buffer (YY_BUFFER_STATE b ) { @@ -1549,7 +1549,7 @@ * the current state. This function will allocate the stack * if necessary. * @param new_buffer The new state. - * + * */ void yypush_buffer_state (YY_BUFFER_STATE new_buffer ) { @@ -1579,7 +1579,7 @@ /** Removes and deletes the top of the stack, if present. * The next element becomes the new top. - * + * */ void yypop_buffer_state (void) { @@ -1603,7 +1603,7 @@ static void yyensure_buffer_stack (void) { yy_size_t num_to_alloc; - + if (!(yy_buffer_stack)) { /* First allocation is just for 2 elements, since we don't know if this @@ -1646,13 +1646,13 @@ /** Setup the input buffer state to scan directly from a user-specified character buffer. * @param base the character buffer * @param size the size in bytes of the character buffer - * + * * @return the newly allocated buffer state object. */ YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size ) { YY_BUFFER_STATE b; - + if ( size < 2 || base[size-2] != YY_END_OF_BUFFER_CHAR || base[size-1] != YY_END_OF_BUFFER_CHAR ) @@ -1681,14 +1681,14 @@ /** Setup the input buffer state to scan a string. The next call to yylex() will * scan from a @e copy of @a str. * @param yystr a NUL-terminated string to scan - * + * * @return the newly allocated buffer state object. * @note If you want to scan bytes that may contain NUL values, then use * yy_scan_bytes() instead. */ YY_BUFFER_STATE yy_scan_string (const char * yystr ) { - + return yy_scan_bytes( yystr, (int) strlen(yystr) ); } @@ -1696,7 +1696,7 @@ * scan from a @e copy of @a bytes. * @param yybytes the byte buffer to scan * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes. - * + * * @return the newly allocated buffer state object. */ YY_BUFFER_STATE yy_scan_bytes (const char * yybytes, int _yybytes_len ) @@ -1705,7 +1705,7 @@ char *buf; yy_size_t n; int i; - + /* Get memory for full buffer, including space for trailing EOB's. */ n = (yy_size_t) (_yybytes_len + 2); buf = (char *) yyalloc( n ); @@ -1759,16 +1759,16 @@ /* Accessor methods (get/set functions) to struct members. */ /** Get the current line number. - * + * */ int yyget_lineno (void) { - + return yylineno; } /** Get the input stream. - * + * */ FILE *yyget_in (void) { @@ -1776,7 +1776,7 @@ } /** Get the output stream. - * + * */ FILE *yyget_out (void) { @@ -1784,7 +1784,7 @@ } /** Get the length of the current token. - * + * */ int yyget_leng (void) { @@ -1792,7 +1792,7 @@ } /** Get the current token. - * + * */ char *yyget_text (void) @@ -1802,18 +1802,18 @@ /** Set the current line number. * @param _line_number line number - * + * */ void yyset_lineno (int _line_number ) { - + yylineno = _line_number; } /** Set the input stream. This does not discard the current * input buffer. * @param _in_str A readable stream. - * + * * @see yy_switch_to_buffer */ void yyset_in (FILE * _in_str ) @@ -1867,7 +1867,7 @@ /* yylex_destroy is for both reentrant and non-reentrant scanners. */ int yylex_destroy (void) { - + /* Pop the buffer stack, destroying each element. */ while(YY_CURRENT_BUFFER){ yy_delete_buffer( YY_CURRENT_BUFFER ); @@ -1893,7 +1893,7 @@ #ifndef yytext_ptr static void yy_flex_strncpy (char* s1, const char * s2, int n ) { - + int i; for ( i = 0; i < n; ++i ) s1[i] = s2[i]; @@ -1918,7 +1918,7 @@ void *yyrealloc (void * ptr, yy_size_t size ) { - + /* The cast to (char *) in the following accommodates both * implementations that use char* generic pointers, and those * that use void* generic pointers. It works with the latter @@ -1946,4 +1946,3 @@ void end_lexical_scan(void) { yy_delete_buffer(YY_CURRENT_BUFFER); } - diff --git a/parsley.cabal b/parsley.cabal --- a/parsley.cabal +++ b/parsley.cabal @@ -5,7 +5,7 @@ -- | +------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 1.0.0.3 +version: 1.0.1.0 synopsis: A fast parser combinator library backed by Typed Template Haskell description: Parsley is a staged selective parser combinator library, which means it does not support monadic operations, and relies on Typed Template @@ -62,7 +62,7 @@ -- ghc >= 8.6 && < 9.2, build-depends: base >= 4.10 && < 4.16, - parsley-core >= 1 && < 3, + parsley-core >= 1.8 && < 3, template-haskell >= 2.14 && < 3, text >= 1.2.3 && < 1.3, hs-source-dirs: src/ghc @@ -108,9 +108,9 @@ build-depends: tasty-hunit, tasty-quickcheck, th-test-utils, deepseq main-is: Parsley/Tests.hs other-modules: Parsley.Alternative.Test, Parsley.Applicative.Test, Parsley.Combinator.Test, Parsley.Fold.Test, - Parsley.Precedence.Test, Parsley.Register.Test, Parsley.Selective.Test, Parsley.Primitive.Test, + Parsley.Precedence.Test, Parsley.Register.Test, Parsley.Selective.Test, Parsley.Alternative.Parsers, Parsley.Applicative.Parsers, Parsley.Combinator.Parsers, Parsley.Fold.Parsers, - Parsley.Precedence.Parsers, Parsley.Register.Parsers, Parsley.Selective.Parsers, Parsley.Primitive.Parsers + Parsley.Precedence.Parsers, Parsley.Register.Parsers, Parsley.Selective.Parsers test-suite regression-test import: test-common diff --git a/src/ghc/Parsley.hs b/src/ghc/Parsley.hs --- a/src/ghc/Parsley.hs +++ b/src/ghc/Parsley.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -Wno-orphans #-} -{-# LANGUAGE MultiParamTypeClasses, CPP #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-| Module : Parsley Description : Main functionality exports @@ -41,11 +41,7 @@ import Parsley.Debug as Primitives (debug) import Parsley.Selective as Selective -#if MIN_VERSION_parsley_core(1,7,1) import qualified Parsley.Internal as Internal (parse) -#else -import qualified Parsley.Internal as Internal (eval, compile, codeGen) -#endif {-| The standard way to compile a parser, it returns `Code`, which means @@ -75,11 +71,7 @@ runParser :: (Trace, Input input) => Parser a -- ^ The parser to be compiled -> Code (input -> Maybe a) -- ^ The generated parsing function -#if MIN_VERSION_parsley_core(1,7,1) runParser = Internal.parse -#else -runParser p = [||\input -> $$(Internal.eval [||input||] (Internal.compile (try p) Internal.codeGen))||] -#endif {-| This function generates a function that reads input from a file diff --git a/src/ghc/Parsley/Combinator.hs b/src/ghc/Parsley/Combinator.hs --- a/src/ghc/Parsley/Combinator.hs +++ b/src/ghc/Parsley/Combinator.hs @@ -19,18 +19,19 @@ eof, more, someTill, try, - lookAhead, notFollowedBy + lookAhead, notFollowedBy, + line, col, pos ) where import Prelude hiding (traverse, (*>)) import Data.List (sort) import Parsley.Alternative (manyTill) -import Parsley.Applicative (($>), void, traverse, (<:>), (*>)) +import Parsley.Applicative (($>), void, traverse, (<:>), (*>), (<~>)) import Parsley.Defunctionalized (Defunc(LIFTED, EQ_H, CONST, LAM_S), pattern APP_H, pattern COMPOSE_H) import Parsley.Internal (Code, Quapplicative(..), Parser) import Parsley.ParserOps (satisfy) -import qualified Parsley.Internal as Internal (try, lookAhead, notFollowedBy) +import qualified Parsley.Internal as Internal (try, lookAhead, notFollowedBy, line, col) {-| This combinator will attempt to parse a given parser. If it succeeds, the result is returned without @@ -174,3 +175,29 @@ -} someTill :: Parser a -> Parser b -> Parser [a] someTill p end = notFollowedBy end *> (p <:> manyTill p end) + +{-| +The `line` combinator returns the current line number at this point in the parse. Line numbers +start from 1. + +@since 1.0.1.0 +-} +line :: Parser Int +line = Internal.line + +{-| +The `col` combinator returns the current column number at this point in the parse. Column numbers +start from 1. + +@since 1.0.1.0 +-} +col :: Parser Int +col = Internal.col + +{-| +The `pos` combinator returns the current line and column number at this point in the parse. + +@since 1.0.1.0 +-} +pos :: Parser (Int, Int) +pos = line <~> col diff --git a/src/ghc/Parsley/Fold.hs b/src/ghc/Parsley/Fold.hs --- a/src/ghc/Parsley/Fold.hs +++ b/src/ghc/Parsley/Fold.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PatternSynonyms, CPP #-} +{-# LANGUAGE PatternSynonyms #-} {-| Module : Parsley.Fold Description : The "folding" combinators: chains and iterators @@ -27,19 +27,10 @@ import Parsley.Defunctionalized (Defunc(FLIP, ID, COMPOSE, EMPTY, CONS, CONST), pattern FLIP_H, pattern COMPOSE_H, pattern UNIT) import Parsley.Internal (Parser) import Parsley.ParserOps (ParserOps) -#if MIN_VERSION_parsley_core(1,7,1) import Parsley.Register (bind, get, put, modify, newRegister, newRegister_) -#else -import Parsley.Register (bind, get, modify, newRegister_) -#endif -#if MIN_VERSION_parsley_core(1,7,1) import qualified Parsley.Internal as Internal (loop) -#else -import qualified Parsley.Internal as Internal (chainPre, chainPost) -#endif -#if MIN_VERSION_parsley_core(1,7,1) {-| The combinator @loop body exit@ parses @body@ zero or more times until it fails. If the final @body@ failed having not consumed input, @exit@ is performed, otherwise the combinator fails: @@ -75,25 +66,6 @@ newRegister p $ \r -> loop (put r (op <*> get r)) (get r) -#else -{-| -This combinator parses repeated applications of an operator to a single final operand. This is -primarily used to parse prefix operators in expressions. - -@since 0.1.0.0 --} -chainPre :: Parser (a -> a) -> Parser a -> Parser a -chainPre = Internal.chainPre - -{-| -This combinator parses repeated applications of an operator to a single initial operand. This is -primarily used to parse postfix operators in expressions. - -@since 0.1.0.0 --} -chainPost :: Parser a -> Parser (a -> a) -> Parser a -chainPost = Internal.chainPost -#endif -- Parser Folds {-| diff --git a/src/ghc/Parsley/ParserOps.hs b/src/ghc/Parsley/ParserOps.hs --- a/src/ghc/Parsley/ParserOps.hs +++ b/src/ghc/Parsley/ParserOps.hs @@ -1,6 +1,7 @@ module Parsley.ParserOps (module Parsley.ParserOps) where import Prelude hiding (pure) +import Control.Arrow (first) import Parsley.Internal (Parser, WQ, Defunc(BLACK)) import qualified Parsley.Internal as Internal (pure, satisfy, conditional) @@ -50,7 +51,7 @@ instance ParserOps WQ where pure = pure . BLACK satisfy = satisfy . BLACK - conditional = conditional . map (\(f, t) -> (BLACK f, t)) + conditional = conditional . map (first BLACK) {-| This is used to allow defunctionalised versions of many standard Haskell functions to be used diff --git a/test/Parsley/Primitive/Parsers.hs b/test/Parsley/Primitive/Parsers.hs deleted file mode 100644 --- a/test/Parsley/Primitive/Parsers.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -module Parsley.Primitive.Parsers where - -import Prelude hiding (pure, (<*>), (*>), (<*)) -import Data.Char (isDigit) -import Parsley -import Parsley.Defunctionalized (Defunc(EMPTY)) ---import Parsley.Garnish - -pure7 :: Parser Int -pure7 = pure [|7|] - -digit :: Parser Char -digit = satisfy [|isDigit|] - -twoDigits :: Parser Char -twoDigits = digit *> digit - -abOrC :: Parser String -abOrC = string "ab" <|> string "c" - -abOrCThenD :: Parser String -abOrCThenD = abOrC <* char 'd' - -recursive :: Parser [Char] -recursive = - let r = item <:> r <|> pure EMPTY - in r - -lookAheadDigit :: Parser Char -lookAheadDigit = lookAhead digit *> digit diff --git a/test/Parsley/Primitive/Test.hs b/test/Parsley/Primitive/Test.hs deleted file mode 100644 --- a/test/Parsley/Primitive/Test.hs +++ /dev/null @@ -1,114 +0,0 @@ -{-# LANGUAGE TemplateHaskell, UnboxedTuples, ScopedTypeVariables, TypeApplications #-} -module Parsley.Primitive.Test where -import Test.Tasty -import Test.Tasty.HUnit -import TestUtils -import qualified Parsley.Primitive.Parsers as Parsers - -import Parsley (runParser, empty) - -tests :: TestTree -tests = testGroup "Primitive" [ pureTests - , apTests - , thenTests - , prevTests - , altTests - , emptyTests - , satisfyTests - , lookAheadTests - , notFollowedByTests - , tryTests - , branchTests - , conditionalTests - , recursionTests - ] - -pure7 :: String -> Maybe Int -pure7 = $$(runParserMocked Parsers.pure7 [||Parsers.pure7||]) - -pureTests :: TestTree -pureTests = testGroup "pure should" - [ testCase "not need to consume input" $ pure7 "" @?= Just 7 - , testCase "not fail if there is input" $ pure7 "a" @?= Just 7 - ] - -apTests :: TestTree -apTests = testGroup "<*> should" [] - -thenTests :: TestTree -thenTests = testGroup "*> should" [] - -prevTests :: TestTree -prevTests = testGroup "<* should" [] - -abOrC :: String -> Maybe String -abOrC = $$(runParserMocked Parsers.abOrC [||Parsers.abOrC||]) - -abOrCThenD :: String -> Maybe String -abOrCThenD = $$(runParserMocked Parsers.abOrCThenD [||Parsers.abOrCThenD||]) - -altTests :: TestTree -altTests = testGroup "<|> should" - [ testCase "take the left branch if it succeeds" $ do - abOrC "ab" @?= Just "ab" - abOrCThenD "abd" @?= Just "ab" - , testCase "take the right branch if left failed without consumption" $ do - abOrC "c" @?= Just "c" - abOrC "d" @?= Nothing - abOrCThenD "cd" @?= Just "c" - abOrCThenD "d" @?= Nothing - , testCase "fail if the left branch fails and consumes input" $ abOrC "a" @?= Nothing - ] - -constNothing :: String -> Maybe () -constNothing = $$(runParserMocked empty [||empty||]) - -emptyTests :: TestTree -emptyTests = testGroup "empty should" - [ testCase "fail the parser with no input" $ constNothing "" @?= Nothing - , testCase "fail the parser with input" $ constNothing "a" @?= Nothing - ] - -digit :: String -> Maybe Char -digit = $$(runParserMocked Parsers.digit [||Parsers.digit||]) - -twoDigits :: String -> Maybe Char -twoDigits = $$(runParserMocked Parsers.twoDigits [||Parsers.twoDigits||]) - -satisfyTests :: TestTree -satisfyTests = testGroup "satisfy should" - [ testCase "fail when given no input" $ digit "" @?= Nothing - , testCase "fail when given incorrect input" $ digit "a" @?= Nothing - , testCase "succeed when given correct input" $ digit "1" @?= Just '1' - , testCase "actually consume input" $ twoDigits "1" @?= Nothing - , testCase "consume more than 1 piece of input with two" $ twoDigits "12" @?= Just '2' - ] - -lookAheadDigit :: String -> Maybe Char -lookAheadDigit = $$(runParserMocked Parsers.lookAheadDigit [||Parsers.lookAheadDigit||]) - -lookAheadTests :: TestTree -lookAheadTests = testGroup "lookAhead should" - [ testCase "rollback consumed input" $ lookAheadDigit "9" @?= Just '9' - , testCase "fail when given no input when expected" $ lookAheadDigit "" @?= Nothing - ] - -notFollowedByTests :: TestTree -notFollowedByTests = testGroup "notFollowedBy should" [] - -tryTests :: TestTree -tryTests = testGroup "try should" [] - -branchTests :: TestTree -branchTests = testGroup "branch should" [] - -conditionalTests :: TestTree -conditionalTests = testGroup "conditional should" [] - -manyAny :: String -> Maybe String -manyAny = $$(runParserMocked Parsers.recursive [||Parsers.recursive||]) - -recursionTests :: TestTree -recursionTests = testGroup "recursion should" - [ testCase "work properly" $ manyAny "abc" @?= Just "abc" - ] diff --git a/test/Parsley/Tests.hs b/test/Parsley/Tests.hs --- a/test/Parsley/Tests.hs +++ b/test/Parsley/Tests.hs @@ -5,7 +5,6 @@ import qualified Parsley.Combinator.Test as Combinator import qualified Parsley.Fold.Test as Fold import qualified Parsley.Precedence.Test as Precedence -import qualified Parsley.Primitive.Test as Primitive import qualified Parsley.Register.Test as Register import qualified Parsley.Selective.Test as Selective @@ -13,8 +12,7 @@ main = defaultMain tests tests :: TestTree -tests = testGroup "Parsley Tests" [ Primitive.tests - , Alternative.tests +tests = testGroup "Parsley Tests" [ Alternative.tests , Applicative.tests , Combinator.tests , Fold.tests