jacinda 3.3.0.1 → 3.3.0.2
raw patch · 16 files changed
+86/−113 lines, 16 filesdep +dlistdep ~bytestring
Dependencies added: dlist
Dependency ranges changed: bytestring
Files
- CHANGELOG.md +4/−0
- bench/Bench.hs +7/−0
- examples/evenOdd.jac +0/−14
- examples/path.jac +0/−1
- examples/tagsex.jac +0/−12
- jacinda.cabal +3/−1
- lib/maybe.jac +3/−0
- man/ja.1 +2/−2
- src/A.hs +4/−41
- src/File.hs +1/−0
- src/Jacinda/Backend/T.hs +1/−1
- src/Jacinda/Regex.hs +57/−31
- src/Nm.hs +1/−7
- src/Parser/Rw.hs +1/−0
- src/R.hs +2/−2
- test/Spec.hs +0/−1
CHANGELOG.md view
@@ -1,3 +1,7 @@+# 3.3.0.2++ * Fix pathological performance using custom record separator on large inputs+ # 3.3.0.1 * Equality on optional values no longer crashes
bench/Bench.hs view
@@ -3,8 +3,10 @@ module Main (main) where import A+import qualified Data.ByteString.Lazy as BSL import Control.DeepSeq (NFData (..)) import Criterion.Main+import Jacinda.Regex import qualified Data.Text.IO as TIO import File import System.IO (IOMode (WriteMode), withFile)@@ -22,6 +24,11 @@ , bgroup "csv" [ bench "dedup" $ runs "~.{ix>1}{`8}" CSV "bench/data/food-prices.csv" , bench "succdiff" $ runs "(%)\\. {%/Apple/}{`3:}" CSV "bench/data/food-prices.csv"+ ]+ , let rp=tcompile "\n\n"+ in bgroup "rure"+ [ bench "RS" $ nfIO (do {contents <- BSL.readFile "bench/data/ghc"; pure (lazySplit rp contents)})+ , bench "header" $ nfIO (do {contents <- BSL.readFile "bench/data/ghc"; pure (lazySplitH rp contents)}) ] , bgroup "report" [ bench "ghc-filt" $ fruns "test/examples/ghc-filt.jac" awk "test/data/ghc" ]
− examples/evenOdd.jac
@@ -1,14 +0,0 @@-fn count(x) ≔- fold (+) 0 (([:1)"x);--fn isEven() :=- (~ /(0|2|4|6|8)$/);--fn isOdd() :=- (~ /(1|3|5|7|9)$/);--let- val even := count (isEven #. $0)- val odd := count (isOdd #. $0)- val total := odd + even-in (total . even . odd) end
examples/path.jac view
@@ -1,5 +1,4 @@ {. echo $PATH | ja run examples/path.jac-{. ja run examples/path.jac <(echo $PATH) fn path(x) := ([x+'\n'+y]) |> (splitc x ':');
− examples/tagsex.jac
@@ -1,12 +0,0 @@-fn mkEx(s) :=- '/^' + s + '$/;';--{. TODO: insert \zs at precise identifier! https://stackoverflow.com/a/31089753/11296354--fn processStr(s) :=- let- val line := split s /[ \(:]+/- val outLine := sprintf '%s\t%s\t%s' (line.3 . fp . mkEx s)- in outLine end;--processStr¨{%/fn +[[:lower:]][[:latin:]]*.*:=/}{`0}
jacinda.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: jacinda-version: 3.3.0.1+version: 3.3.0.2 license: AGPL-3.0-only license-file: COPYING maintainer: vamchale@gmail.com@@ -105,6 +105,7 @@ build-depends: base >=4.11.0.0 && <5, bytestring >=0.11.2.0,+ dlist, text, prettyprinter >=1.7.0, containers >=0.6.0.1,@@ -177,6 +178,7 @@ ghc-options: -rtsopts "-with-rtsopts=-A200k -k32k" build-depends: base,+ bytestring, criterion, jacinda-lib, deepseq,
lib/maybe.jac view
@@ -7,3 +7,6 @@ {. Haskell's (<|>) fn alternative(a, b) := option a Some b;++fn lift(f,x,y) :=+ option None (λz.f z"y) x;
man/ja.1 view
@@ -1,4 +1,4 @@-.\" Automatically generated by Pandoc 3.5+.\" Automatically generated by Pandoc 3.6.1 .\" .TH "ja (1)" "" "" "" .SH NAME@@ -154,7 +154,7 @@ Str \-> Int \-> Regex \-> Option Str .TP \f[B]captures\f[R] Return all aptures (nth capture group)-Str \-> Int \-> Regex \-> Str+Str \-> Int \-> Regex \-> List Str .TP \f[B]:?\f[R] mapMaybe Witherable f :=> (a \-> Option b) \-> f a \-> f b
src/A.hs view
@@ -35,7 +35,7 @@ data TB = TyI | TyFloat | TyStr | TyStream | TyVec | TyOption | TyR | TyBool | TyUnit- deriving (Eq, Ord)+ deriving Eq tupledByFunky :: Doc ann -> [Doc ann] -> Doc ann tupledByFunky sep = group . encloseSep (flatAlt "⟨ " "⟨") (flatAlt " ⟩" "⟩") sep@@ -100,7 +100,6 @@ | Negate | TallyList -- length of vector | Head | Tail | Init | Last- deriving (Eq) instance Pretty BUn where pretty Tally = "#"@@ -130,7 +129,6 @@ | Option | Captures | AllCaptures | Ixes | Bookend- deriving (Eq) instance Pretty BTer where pretty ZipW = ","@@ -162,7 +160,6 @@ | Report | Take | Drop | Rein | Nier- deriving (Eq) instance Pretty BBin where pretty Plus = "+"; pretty Times = "*"; pretty Div = "%"; pretty Minus = "-"@@ -176,14 +173,14 @@ pretty Take = "take#"; pretty Drop = "drop#"; pretty Rein = "reintercalate" pretty Nier = "@@" -data DfnVar = X | Y deriving (Eq)+data DfnVar = X | Y instance Pretty DfnVar where pretty X="x"; pretty Y="y" -- 0-ary-data N = Ix | Nf | None | Fp | MZ deriving (Eq)+data N = Ix | Nf | None | Fp | MZ -data L = ILit !Integer | FLit !Double | BLit !Bool | StrLit BS.ByteString deriving (Generic, NFData, Eq)+data L = ILit !Integer | FLit !Double | BLit !Bool | StrLit BS.ByteString deriving (Generic, NFData) class PS a where ps :: Int -> a -> Doc ann @@ -317,40 +314,6 @@ instance Pretty (E a) where pretty=ps 0 instance Show (E a) where show=show.pretty---- for tests-instance Eq (E a) where- (==) (Column _ i) (Column _ j) = i == j- (==) (IParseCol _ i) (IParseCol _ j) = i == j- (==) (FParseCol _ i) (FParseCol _ j) = i == j- (==) (Field _ i) (Field _ j) = i == j- (==) LastField{} LastField{} = True- (==) FieldList{} FieldList{} = True- (==) AllColumn{} AllColumn{} = True- (==) AllField{} AllField{} = True- (==) (EApp _ e0 e1) (EApp _ e0' e1') = e0 == e0' && e1 == e1'- (==) (Guarded _ p e) (Guarded _ p' e') = p == p' && e == e'- (==) (Implicit _ e) (Implicit _ e') = e == e'- (==) (Let _ (n, eϵ) e) (Let _ (n', eϵ') e') = eqName n n' && e == e' && eϵ == eϵ'- (==) (Var _ n) (Var _ n') = eqName n n'- (==) (Lam _ n e) (Lam _ n' e') = eqName n n' && e == e'- (==) (Lit _ l) (Lit _ l') = l == l'- (==) (RegexLit _ rr) (RegexLit _ rr') = rr == rr'- (==) (BB _ b) (BB _ b') = b == b'- (==) (TB _ b) (TB _ b') = b == b'- (==) (UB _ unOp) (UB _ unOp') = unOp == unOp'- (==) (NB _ x) (NB _ y) = x == y- (==) (Tup _ es) (Tup _ es') = es == es'- (==) (Rec _ es) (Rec _ es') = es == es'- (==) (ResVar _ x) (ResVar _ y) = x == y- (==) (Dfn _ f) (Dfn _ g) = f == g -- we're testing for lexical equivalence- (==) RC{} _ = error "Cannot compare compiled regex!"- (==) _ RC{} = error "Cannot compare compiled regex!"- (==) (Paren _ e) e' = e == e'- (==) e (Paren _ e') = e == e'- (==) (RwB _ b) (RwB _ b') = b == b'- (==) (RwT _ b) (RwT _ b') = b == b'- (==) _ _ = False data C = IsNum | IsEq | IsOrd | IsParse | IsPrintf
src/File.hs view
@@ -1,6 +1,7 @@ module File ( tcIO , runStdin, runOnFile , exprEval+ , tcompile ) where import A
src/Jacinda/Backend/T.hs view
@@ -405,7 +405,7 @@ x0e <- asM<$>(x0@>b); x1e <- asM<$>(x1@>b) case (x0e,x1e) of (Nothing, Nothing) -> pure (mkB True)- (Just e0b, Just e1b) -> (EApp tyB (EApp (t~>tyB) (BB (TyArr t (t~>t~>tyB)) Eq) e0b) e1b) @> b+ (Just e0b, Just e1b) -> EApp tyB (EApp (t~>tyB) (BB (TyArr t (t~>t~>tyB)) Eq) e0b) e1b @> b _ -> pure (mkB False) (EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) Plus) x0) x1) @> b = do x0e <- x0@>b; x1e <- x1@>b
src/Jacinda/Regex.hs view
@@ -17,9 +17,11 @@ import Control.Exception (Exception, throwIO) import Control.Monad ((<=<))+import Data.Bifunctor (bimap, first) import qualified Data.ByteString as BS import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Lazy as BSL+import qualified Data.DList as DL import qualified Data.Vector as V import Foreign.C.Types (CSize) import Foreign.ForeignPtr (plusForeignPtr)@@ -78,59 +80,83 @@ find' re str = unsafeDupablePerformIO $ find re str 0 lazySplitH :: RurePtr -> BSL.ByteString -> [BS.ByteString]-lazySplitH rp = go Nothing . BSL.toChunks where+lazySplitH rp = DL.toList . go Nothing . BSL.toChunks where go Nothing [] = [] go Nothing (c:cs) =- case unsnoc (splitH rp c) of- Just (iss,lss) -> iss++go (Just lss) cs+ case splitH rp c of+ Just (iss,lss) -> iss<>go (Just lss) cs Nothing -> go Nothing cs- go (Just c) [] = splitByA rp c+ -- FIXME: splitByL discards header?+ go (Just c) [] = splitByL rp c go (Just e) (c:cs) =- case unsnoc (splitByA rp (e<>c)) of- Just (iss,lss) -> iss++go (Just lss) cs+ case splitH rp (e<>c) of+ Just (iss,lss) -> iss<>go (Just lss) cs Nothing -> go Nothing cs lazySplit :: RurePtr -> BSL.ByteString -> [BS.ByteString]-lazySplit rp = go Nothing . BSL.toChunks where- go Nothing [] = []+lazySplit rp = DL.toList . go Nothing . BSL.toChunks where+ go Nothing [] = DL.empty go Nothing (c:cs) =- case unsnoc (splitByA rp c) of- Just (iss,lss) -> iss++go (Just lss) cs+ case splitByDL rp c of+ Just (iss,lss) -> iss<>go (Just lss) cs Nothing -> go Nothing cs- go (Just c) [] = splitByA rp c+ go (Just c) [] = splitByL rp c go (Just e) (c:cs) =- case unsnoc (splitByA rp (e<>c)) of- Just (iss,lss) -> iss++go (Just lss) cs+ case splitByDL rp (e<>c) of+ Just (iss,lss) -> iss<>go (Just lss) cs Nothing -> go Nothing cs -unsnoc :: [a] -> Maybe ([a], a)-unsnoc = foldr (\x acc -> Just $ case acc of {Nothing -> ([], x); Just ~(a, b) -> (x:a, b)}) Nothing--splitBy :: RurePtr -> BS.ByteString -> V.Vector BS.ByteString-splitBy = (V.fromList .) . splitByA--{-# NOINLINE splitByA #-}-splitByA :: RurePtr+{-# NOINLINE splitByL #-}+splitByL :: RurePtr -> BS.ByteString- -> [BS.ByteString]-splitByA _ "" = []-splitByA re haystack@(BS.BS fp l) =- [BS.BS (fp `plusForeignPtr` s) (e-s) | (s,e) <- slicePairs]+ -> DL.DList BS.ByteString+splitByL _ "" = DL.empty+splitByL re haystack@(BS.BS fp l) = pp<$>slicePairs where ixes = unsafeDupablePerformIO $ matches' re haystack slicePairs = case ixes of (RureMatch 0 i:rms) -> mkMiddle (fromIntegral i) rms rms -> mkMiddle 0 rms+ mkMiddle begin' [] = DL.singleton (begin', l)+ mkMiddle begin' (rm0:rms) = (begin', fromIntegral (start rm0)) `DL.cons` mkMiddle (fromIntegral $ end rm0) rms+ pp (s,e) = BS.BS (fp `plusForeignPtr` s) (e-s)++{-# NOINLINE splitBy #-}+splitBy :: RurePtr+ -> BS.ByteString+ -> V.Vector BS.ByteString+splitBy _ "" = []+splitBy re haystack@(BS.BS fp l) =+ V.fromList $ map (\(s,e) -> BS.BS (fp `plusForeignPtr` s) (e-s)) slicePairs+ where ixes = unsafeDupablePerformIO $ matches' re haystack+ slicePairs = case ixes of+ (RureMatch 0 i:rms) -> mkMiddle (fromIntegral i) rms+ rms -> mkMiddle 0 rms mkMiddle begin' [] = [(begin', l)] mkMiddle begin' (rm0:rms) = (begin', fromIntegral (start rm0)) : mkMiddle (fromIntegral $ end rm0) rms +{-# SCC splitByDL #-}+{-# NOINLINE splitByDL #-}+splitByDL :: RurePtr+ -> BS.ByteString+ -> Maybe (DL.DList (BS.ByteString), BS.ByteString)+splitByDL _ "" = Nothing+splitByDL re haystack@(BS.BS fp l) = bimap (fmap pp) pp <$> slicePairs+ where ixes = unsafeDupablePerformIO $ matches' re haystack+ slicePairs = case ixes of+ (RureMatch 0 i:rms) -> mkMiddle (fromIntegral i) rms+ rms -> mkMiddle 0 rms+ mkMiddle begin' [] = Just (DL.empty, (begin', l))+ mkMiddle begin' (rm0:rms) = first ((begin', fromIntegral (start rm0)) `DL.cons`) <$> mkMiddle (fromIntegral $ end rm0) rms+ pp (s,e) = BS.BS (fp `plusForeignPtr` s) (e-s)+ {-# NOINLINE splitH #-}-splitH :: RurePtr -> BS.ByteString -> [BS.ByteString]-splitH _ "" = []-splitH re haystack@(BS.BS fp l) =- [BS.BS (fp `plusForeignPtr` s) (e-s) | (s,e) <- chopAt 0 ixes]+splitH :: RurePtr -> BS.ByteString -> Maybe (DL.DList BS.ByteString, BS.ByteString)+splitH _ "" = Nothing+splitH re haystack@(BS.BS fp l) = bimap (fmap pp) pp <$> chopAt 0 ixes where ixes = unsafeDupablePerformIO $ matches' re haystack- chopAt begin [] = [(begin, l)]- chopAt begin (RureMatch b _:rms) = (begin, fromIntegral b) : chopAt (fromIntegral b) rms+ chopAt begin [] = Just (DL.empty, (begin, l))+ chopAt begin (RureMatch b _:rms) = first ((begin, fromIntegral b) `DL.cons`) <$> chopAt (fromIntegral b) rms+ pp (s,e) = BS.BS (fp `plusForeignPtr` s) (e-s) isMatch' :: RurePtr -> BS.ByteString
src/Nm.hs view
@@ -1,6 +1,4 @@-module Nm ( Nm (..), TyName- , eqName- ) where+module Nm ( Nm (..), TyName ) where import qualified Data.Text as T import Prettyprinter (Pretty (pretty))@@ -10,10 +8,6 @@ , unique :: !U , loc :: a } deriving (Functor)---- test-eqName :: Nm a -> Nm a -> Bool-eqName (Nm n _ _) (Nm n' _ _) = n == n' instance Eq (Nm a) where (==) (Nm _ u _) (Nm _ u' _) = u == u'
src/Parser/Rw.hs view
@@ -109,3 +109,4 @@ rwE (Cond l p e e') = Cond l (rwE p) (rwE e) (rwE e') rwE (RwB l b) = BB l b rwE (RwT l b) = TB l b+rwE (Anchor l es) = Anchor l (rwE<$>es)
src/R.hs view
@@ -22,10 +22,10 @@ instance HasRenames Renames where rename=id boundLens :: Lens' Renames (IM.IntMap Int)-boundLens f s = fmap (\x -> s { bound = x }) (f (bound s))+boundLens f (Rs m b) = Rs m <$> f b maxLens :: Lens' Renames Int-maxLens f s = fmap (\x -> s { max_ = x }) (f (max_ s))+maxLens f (Rs m b) = (\x -> Rs x b) <$> f m type RenameM = State Renames
test/Spec.hs view
@@ -54,7 +54,6 @@ , harness "examples/pubmed2tex.jac" awk "test/data/3221331.nbib" "test/golden/holland1988.bib" , harness "examples/pubmed2tex.jac" awk "test/data/22078126.nbib" "test/golden/gonadalsex.bib" , harness "test/examples/ghc-filt.jac" awk "test/data/ghc" "test/golden/ghc.out"- , harness "examples/cargoLockVersion.jac" awk "test/data/Cargo.lock" "test/golden/cargo.out" , ep "[x ~* 1 /(\\d+(\\.\\d+)*)/]:?{%/Versions available:/}{[y]|>`$}" (AWK (Just "\\s*,\\s*") (Just "\\n[^:\\n]*:") True) "test/data/cabal-info"