smith (empty) → 0.1.0.0

raw patch · 6 files changed

+353/−0 lines, 6 filesdep +basedep +bytesmithdep +primitivesetup-changed

Dependencies added: base, bytesmith, primitive

Files

CHANGELOG.md +5/−0
LICENSE +30/−0
Setup.hs +2/−0
smith.cabal +30/−0
src/Data/Parser.hs +194/−0
src/Data/Parser/Unsafe.hs +92/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for smith++## 0.1.0.0 -- 2019-09-30++* First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2019, Andrew Martin++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Andrew Martin nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ smith.cabal view

@@ -0,0 +1,30 @@+cabal-version: 2.2+name: smith+version: 0.1.0.0+synopsis: Parse arrays of tokens+description:+  This library is similar in spirit to `bytesmith`. While `bytesmith`+  parses byte sequences, `smith` parses token sequences. The most+  common way to use them together is to lex with `bytesmith` and+  then parse the token sequence with `smith`.+homepage: https://github.com/andrewthad/smith+bug-reports: https://github.com/andrewthad/smith/issues+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin+maintainer: andrew.thaddeus@gmail.com+copyright: 2019 Andrew Martin+category: Data+extra-source-files: CHANGELOG.md++library+  exposed-modules:+    Data.Parser+    Data.Parser.Unsafe+  build-depends:+    , base >=4.12.0.0 && <5+    , bytesmith >=0.3 && <0.4+    , primitive >=0.6.4 && <0.8+  hs-source-dirs: src+  default-language: Haskell2010+  ghc-options: -Wall -O2

+ src/Data/Parser.hs view

@@ -0,0 +1,194 @@+{-# language BangPatterns #-}+{-# language BinaryLiterals #-}+{-# language DataKinds #-}+{-# language DeriveFunctor #-}+{-# language DerivingStrategies #-}+{-# language GADTSyntax #-}+{-# language KindSignatures #-}+{-# language LambdaCase #-}+{-# language MagicHash #-}+{-# language MultiWayIf #-}+{-# language PolyKinds #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language StandaloneDeriving #-}+{-# language TypeApplications #-}+{-# language UnboxedSums #-}+{-# language UnboxedTuples #-}++-- | Parse token sequences.+module Data.Parser+  ( Parser+  , Result(..)+  , Slice(..)+  , parseSmallArray+  , parseSmallArrayEffectfully+    -- * Primitives+  , any+  , opt+  , peek+  , token+  , effect+  , fail+    -- * Control Flow+  , foldSepBy1+  , sepBy1+  , skipWhile+  ) where++import Prelude hiding (length,any,fail)++import Data.Bool (bool)+import Data.Primitive (SmallArray(..))+import Data.Bytes.Parser (Result(..),Slice(..))+import Data.Parser.Unsafe (Parser(..))+import GHC.Exts (TYPE,Int(I#),Int#)+import GHC.ST (ST(ST),runST)++import qualified Data.Primitive as PM+import qualified GHC.Exts as Exts++type Result# e (a :: TYPE r) =+  (# e+  | (# a, Int#, Int# #) #) -- ints are offset and length++-- | Consumes and returns the next token from the input.+-- Fails if no tokens are left.+any :: e -> Parser a e s a+{-# inline any #-}+any e = uneffectful $ \array off len -> case len of+  0 -> Failure e+  _ ->+    let w = PM.indexSmallArray array off+     in Success (Slice (off + 1) (len - 1) w)++-- | Consume a character from the input or return @Nothing@ if+-- end of the stream has been reached. This parser never fails.+opt :: Parser a e s (Maybe a)+{-# inline opt #-}+opt = uneffectful $ \array off len -> case len of+  0 -> Success (Slice off 0 Nothing)+  _ -> +    let w = PM.indexSmallArray array off+     in Success (Slice (off + 1) (len - 1) (Just w))++-- | Lift an effect into a parser.+effect :: ST s b -> Parser a e s b+{-# inline effect #-}+effect (ST f) = Parser+  (\(# _, off, len #) s0 -> case f s0 of+    (# s1, b #) -> (# s1, (# | (# b, off, len #) #) #)+  )++-- | Consumes and returns the next token from the input.+-- Fails if no tokens are left.+fail :: e -> Parser a e s b+{-# inline fail #-}+fail e = Parser (\_ s0 -> (# s0, (# e | #) #) )++-- | Consumes the next token from the input. Fails if it+-- is not equal to the expected value.+token :: Eq a+  => e -- ^ Error message+  -> a -- ^ Expected value of next token+  -> Parser a e s ()+{-# inline token #-}+token e a = do+  b <- any e+  bool (fail e) (pure ()) (a == b)++-- | Returns the next token from the input without consuming+-- it. Fails if no tokens are left.+peek :: e -> Parser a e s a+{-# inline peek #-}+peek e = uneffectful $ \array off len -> if len > 0+  then+    let w = PM.indexSmallArray array off+     in Success (Slice off len w)+  else Failure e++-- | Fold over the tokens, repeatedly running @step@ followed+-- by @separator@ until @separator@ returns 'False'. This is+-- strict in the accumulator and always runs @step@ at least+-- once. There is no backtracking; any failure causes the whole+-- combinator to fail. +foldSepBy1 ::+     Parser a e s Bool -- ^ Separator+  -> (b -> Parser a e s b) -- ^ Step+  -> b -- ^ Initial value+  -> Parser a e s b+{-# inline foldSepBy1 #-}+foldSepBy1 sep f b0 = f b0 >>= go+  where+  go !b = sep >>= \case+    True -> f b >>= go+    False -> pure b++-- | Skip tokens for which the predicate is true.+skipWhile ::+     (a -> Bool) -- ^ Predicate+  -> Parser a e s ()+{-# inline skipWhile #-}+skipWhile f = go where+  go = opt >>= \case+    Nothing -> pure ()+    Just t -> case f t of+      True -> go+      False -> internalUnconsume 1++-- | Fold over the tokens, repeatedly running @step@ followed+-- by @separator@ until @separator@ returns 'False'. The results+-- of @step@ are discarded, but in conjunction with @effect@,+-- this can be used to populate an array or a builder. This+-- always runs @step@ at least once.+--+-- > sepBy1 sep step === step *> (sep >>= bool (pure ()) (step *> (sep >>= bool (pure ()) (...))))+sepBy1 ::+     Parser a e s Bool -- ^ Separator+  -> Parser a e s b -- ^ Step+  -> Parser a e s ()+{-# inline sepBy1 #-}+sepBy1 sep f = f *> go where+  go = sep >>= \case+    True -> f *> go+    False -> pure ()+    +uneffectful :: (SmallArray a -> Int -> Int -> Result e b) -> Parser a e s b+{-# inline uneffectful #-}+uneffectful f = Parser+  ( \(# arr,off,len #) s0 -> (# s0, unboxResult (f (SmallArray arr) (I# off) (I# len)) #) )++unboxResult :: Result e a -> Result# e a+unboxResult (Success (Slice (I# b) (I# c) a)) = (# | (# a, b, c #) #)+unboxResult (Failure e) = (# e | #)++parseSmallArray ::+     forall a e b. (forall s. Parser a e s b)+  -> SmallArray a+  -> Result e b+parseSmallArray p (SmallArray arr) = runST action+  where+  action :: forall s. ST s (Result e b)+  action = case p @s of+    Parser f -> ST+      (\s0 -> case f (# arr, 0#, (Exts.sizeofSmallArray# arr) #) s0 of+        (# s1, r #) -> (# s1, boxResult r #)+      )++parseSmallArrayEffectfully :: Parser a e s b -> SmallArray a -> ST s (Result e b)+parseSmallArrayEffectfully (Parser f) (SmallArray arr) = ST+  (\s0 -> case f (# arr, 0#, (Exts.sizeofSmallArray# arr) #) s0 of+    (# s1, r #) -> (# s1, boxResult r #)+  )++boxResult :: Result# e a -> Result e a+boxResult (# | (# a, b, c #) #) = Success (Slice (I# b) (I# c) a)+boxResult (# e | #) = Failure e++-- A copy of unconsume so that the modules do not need to+-- be restructured.+internalUnconsume :: Int -> Parser a e s ()+{-# inline internalUnconsume #-}+internalUnconsume n = uneffectful $ \_ off len ->+  Success (Slice (off - n) (len + n) ())+

+ src/Data/Parser/Unsafe.hs view

@@ -0,0 +1,92 @@+{-# language BangPatterns #-}+{-# language BinaryLiterals #-}+{-# language DataKinds #-}+{-# language DeriveFunctor #-}+{-# language DerivingStrategies #-}+{-# language GADTSyntax #-}+{-# language KindSignatures #-}+{-# language LambdaCase #-}+{-# language MagicHash #-}+{-# language MultiWayIf #-}+{-# language PolyKinds #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language StandaloneDeriving #-}+{-# language TypeApplications #-}+{-# language UnboxedSums #-}+{-# language UnboxedTuples #-}++-- | Everything in this module is unsafe and can lead to+-- nondeterministic output or segfaults if used incorrectly.+module Data.Parser.Unsafe+  ( -- * Types+    Parser(..)+    -- * Functions+  , unconsume+  ) where++import GHC.Exts (Int(I#),Int#)+import Data.Bytes.Parser (Result(..),Slice(..))+import Data.Kind (Type)+import Data.Primitive.SmallArray (SmallArray(SmallArray))+import GHC.Exts (TYPE,State#,SmallArray#)++import qualified Control.Monad++type SmallVector# a = (# SmallArray# a, Int#, Int# #)+type ST# s (a :: TYPE r) = State# s -> (# State# s, a #)+type Result# e (a :: TYPE r) =+  (# e+  | (# a, Int#, Int# #) #) -- ints are offset and length++-- | A non-resumable toke parser.+newtype Parser :: Type -> Type -> Type -> Type -> Type where+  Parser :: { runParser :: SmallVector# a -> ST# s (Result# e b) }+         -> Parser a e s b++instance Functor (Parser a e s) where+  {-# inline fmap #-}+  fmap f (Parser g) = Parser+    (\x s0 -> case g x s0 of+      (# s1, r #) -> case r of+        (# e | #) -> (# s1, (# e | #) #)+        (# | (# a, b, c #) #) -> (# s1, (# | (# f a, b, c #) #) #)+    )++instance Applicative (Parser a e s) where+  pure = pureParser+  (<*>) = Control.Monad.ap++instance Monad (Parser a e s) where+  {-# inline return #-}+  {-# inline (>>=) #-}+  return = pureParser+  Parser f >>= g = Parser+    (\x@(# arr, _, _ #) s0 -> case f x s0 of+      (# s1, r0 #) -> case r0 of+        (# e | #) -> (# s1, (# e | #) #)+        (# | (# y, b, c #) #) ->+          runParser (g y) (# arr, b, c #) s1+    )++pureParser :: b -> Parser a e s b+pureParser a = Parser+  (\(# _, b, c #) s -> (# s, (# | (# a, b, c #) #) #))++-- | Move the cursor back by @n@ tokens. Precondition: you+-- must have previously consumed at least @n@ tokens.+unconsume :: Int -> Parser a e s ()+unconsume n = uneffectful $ \_ off len ->+  Success (Slice (off - n) (len + n) ())++uneffectful ::+     (SmallArray a -> Int -> Int -> Result e b)+  -> Parser a e s b+{-# inline uneffectful #-}+uneffectful f = Parser+  ( \(# arr,off,len #) s0 -> (# s0, unboxResult (f (SmallArray arr) (I# off) (I# len)) #) )++unboxResult :: Result e a -> (# e | (# a, Int#, Int# #) #) +unboxResult (Success (Slice (I# b) (I# c) a)) = (# | (# a, b, c #) #)+unboxResult (Failure e) = (# e | #)+