jacinda 3.3.0.4 → 3.3.0.5
raw patch · 12 files changed
+76/−72 lines, 12 filesdep −dlist
Dependencies removed: dlist
Files
- CHANGELOG.md +7/−0
- bench/Bench.hs +5/−5
- doc/guide.pdf binary
- jacinda.cabal +2/−2
- src/A.hs +4/−3
- src/DL.hs +22/−0
- src/Include.hs +1/−1
- src/Jacinda/Backend/T.hs +9/−33
- src/Jacinda/Regex.hs +6/−6
- src/L.x +6/−1
- src/Ty.hs +13/−21
- test/Spec.hs +1/−0
CHANGELOG.md view
@@ -1,3 +1,10 @@+# 3.3.0.5++ * Add `Ord` instance for tuples, etc.+ * Fix `\ESC` escaping++ * Remove dependency on `dlist`+ # 3.3.0.4 * Don't crash when deduplicating tuples, arrays, optional values
bench/Bench.hs view
@@ -3,13 +3,13 @@ module Main (main) where import A-import qualified Data.ByteString.Lazy as BSL-import Control.DeepSeq (NFData (..))+import Control.DeepSeq (NFData (..)) import Criterion.Main-import Jacinda.Regex-import qualified Data.Text.IO as TIO+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Text.IO as TIO import File-import System.IO (IOMode (WriteMode), withFile)+import Jacinda.Regex+import System.IO (IOMode (WriteMode), withFile) hrun ifp e m fp = withFile "/dev/null" WriteMode $ \h -> runOnFile [] Nothing e [] m fp h runs e m fp = nfIO $ hrun "(bench)" e m fp
doc/guide.pdf view
binary file changed (94792 → 101190 bytes)
jacinda.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: jacinda-version: 3.3.0.4+version: 3.3.0.5 license: AGPL-3.0-only license-file: COPYING maintainer: vamchale@gmail.com@@ -84,6 +84,7 @@ Nm U R+ DL Parser.Rw Ty.Const Jacinda.Check.Field@@ -103,7 +104,6 @@ build-depends: base >=4.11.0.0 && <5, bytestring >=0.11.2.0,- dlist, text >=2.0.1, prettyprinter >=1.7.0, containers >=0.6.0.1,
src/A.hs view
@@ -128,7 +128,7 @@ | Substr | Sub1 | Subs | Option | Captures | AllCaptures | Ixes- | Bookend+ | Bookend | BookendG instance Pretty BTer where pretty ZipW = ","@@ -291,6 +291,7 @@ ps _ (EApp _ (UB _ FParse) e') = pretty e' <> ":f" ps _ (EApp _ (UB _ Parse) e') = pretty e' <> ":" ps d (EApp _ (EApp _ (EApp _ (TB _ Bookend) e) e') e'') = parensp (d>3) (ps 4 e <> ",," <> ps 4 e' <+> ps 5 e'')+ ps d (EApp _ (EApp _ (EApp _ (TB _ BookendG) e) e') e'') = parensp (d>3) (ps 4 e <> "|," <> ps 4 e' <+> ps 5 e'') ps d (EApp _ (EApp _ (EApp _ (TB _ Fold) e) e') e'') = parensp (d>5) (ps 6 e <> "|" <> ps 6 e' <+> ps 7 e'') ps d (EApp _ (EApp _ (EApp _ (TB _ Scan) e) e') e'') = parensp (d>5) (ps 6 e <> "^" <> ps 6 e' <+> ps 7 e'') ps d (EApp _ (EApp _ (EApp _ (TB _ ScanList) e) e') e'') = parensp (d>5) (ps 6 e <> "^" <> ps 6 e' <+> ps 7 e'')@@ -331,7 +332,7 @@ instance Show (E a) where show=show.pretty -data C = IsNum | IsEq | IsOrd+data C = IsNum | IsOrd | IsParse | IsPrintf | IsSemigroup | IsMonoid | Functor -- ^ For map (@"@)@@ -339,7 +340,7 @@ deriving (Eq, Ord) instance Pretty C where- pretty IsNum = "Num"; pretty IsEq = "Eq"; pretty IsOrd = "Ord"+ pretty IsNum = "Num"; pretty IsOrd = "Ord" pretty IsParse = "Parseable"; pretty IsSemigroup = "Semigroup" pretty Functor = "Functor"; pretty Foldable = "Foldable" pretty IsPrintf = "Printf"; pretty Witherable = "Witherable"
+ src/DL.hs view
@@ -0,0 +1,22 @@+-- difference lists+module DL ( DL+ , cons, snoc+ , toList, empty+ ) where++infixr 9 `cons`+infixl 9 `snoc`++newtype DL a = DL ([a] -> [a])++toList = ($[]) . (\(DL x) -> x)++cons x (DL xs) = DL ((x:).xs)+snoc (DL xs) x = DL (xs.(x:))++empty = DL id++instance Functor DL where fmap f = foldr (cons.f) empty . toList++instance Semigroup (DL a) where+ (<>) (DL xs) (DL ys) = DL (xs.ys)
src/Include.hs view
@@ -35,4 +35,4 @@ (\case [] -> throwIO $ FileNotFound fp incl; [src] -> pure (src</>fp); fs -> throwIO $ AmbiguousInclude fs) . nubOrd <=< traverse canonicalizePath- <=< (filterM (doesFileExist . (</> fp)))+ <=< filterM (doesFileExist . (</> fp))
src/Jacinda/Backend/T.hs view
@@ -366,24 +366,12 @@ e@RC{} @> _ = pure e (F n) @> b = pure $ b!>n e@(Var _ n) @> b = pure $ case IM.lookup (unU$unique n) b of {Just y -> y; Nothing -> e}-(EApp _ (EApp _ (BB (TyArr (TyB TyI) _) Max) x0) x1) @> b = do- x0' <- asI<$>(x0@>b); x1' <- asI<$>(x1@>b)- pure $ mkI (max x0' x1')-(EApp _ (EApp _ (BB (TyArr (TyB TyI) _) Min) x0) x1) @> b = do- x0' <- asI <$> (x0@>b); x1' <- asI <$> (x1@>b)- pure $ mkI (min x0' x1')-(EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) Max) x0) x1) @> b = do- x0' <- asF<$>(x0@>b); x1' <- asF<$>(x1@>b)- pure $ mkF (max x0' x1')-(EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) Min) x0) x1) @> b = do- x0' <- asF<$>(x0@>b); x1' <- asF<$>(x1@>b)- pure $ mkF (min x0' x1')-(EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) Max) x0) x1) @> b = do- x0' <- asS<$>(x0@>b); x1' <- asS<$>(x1@>b)- pure $ mkStr (max x0' x1')-(EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) Min) x0) x1) @> b = do- x0' <- asS<$>(x0@>b); x1'<-asS<$>(x1@>b)- pure $ mkStr (min x0' x1')+(EApp _ (EApp _ (BB _ Max) x0) x1) @> b = do+ x0' <- x0@>b; x1' <- x1@>b+ pure $ max x0' x1'+(EApp _ (EApp _ (BB _ Min) x0) x1) @> b = do+ x0' <- x0@>b; x1' <- x1@>b+ pure $ min x0' x1' (EApp _ (EApp _ (BB (TyArr (TyB TyI) _) op) x0) x1) @> b | Just op' <- num op = do x0e <- asI<$>(x0@>b); x1e <- asI<$>(x1@>b) pure $ mkI (op' x0e x1e)@@ -393,21 +381,9 @@ (EApp _ (EApp _ (BB _ Div) x0) x1) @> b = do x0e <- x0@>b; x1e <- x1@>b pure (mkF (asF x0e/asF x1e))-(EApp _ (EApp _ (BB (TyArr (TyB TyI) _) op) x0) x1) @> b | Just rel <- binRel op = do- x0e<-asI<$>(x0@>b); x1e<-asI<$>(x1@>b)- pure (mkB (rel x0e x1e))-(EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) op) x0) x1) @> b | Just rel <- binRel op = do- x0e <- asF<$>(x0@>b); x1e <- asF<$>(x1@>b)- pure (mkB (rel x0e x1e))-(EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) op) x0) x1) @> b | Just rel <- binRel op = do- x0e <- asS<$>(x0@>b); x1e <- asS<$>(x1@>b)- pure (mkB (rel x0e x1e))-(EApp _ (EApp _ (BB (TyArr (TyB TyOption:$t@(TyB TyStr)) _) Eq) x0) x1) @> b = do- 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- _ -> pure (mkB False)+(EApp _ (EApp _ (BB _ op) x0) x1) @> b | Just rel <- binRel op = do+ x0' <- x0@>b; x1' <- x1@>b+ pure (mkB (rel x0' x1')) (EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) Plus) x0) x1) @> b = do x0e <- x0@>b; x1e <- x1@>b pure (mkStr (asS x0e<>asS x1e))
src/Jacinda/Regex.hs view
@@ -21,8 +21,8 @@ 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 qualified DL import Foreign.C.Types (CSize) import Foreign.ForeignPtr (plusForeignPtr) import Regex.Rure (RureFlags, RureMatch (..), RurePtr, captures, compile, find, findCaptures, isMatch, matches', rureDefaultFlags, rureFlagDotNL)@@ -80,7 +80,7 @@ lazySplitH :: RurePtr -> BSL.ByteString -> [BS.ByteString] lazySplitH rp = DL.toList . go Nothing . BSL.toChunks where- go Nothing [] = []+ go Nothing [] = DL.empty go Nothing (c:cs) = case splitH rp c of Just (iss,lss) -> iss<>go (Just lss) cs@@ -105,7 +105,7 @@ Nothing -> go Nothing cs {-# NOINLINE splitByL #-}-splitByL :: RurePtr -> BS.ByteString -> DL.DList BS.ByteString+splitByL :: RurePtr -> BS.ByteString -> DL.DL BS.ByteString splitByL rp b = case splitByDL rp b of {Nothing -> DL.empty; Just (as,a) -> as `DL.snoc` a} {-# NOINLINE splitBy #-}@@ -123,7 +123,7 @@ {-# SCC splitByDL #-} {-# NOINLINE splitByDL #-} splitByDL :: RurePtr -> BS.ByteString- -> Maybe (DL.DList BS.ByteString, BS.ByteString)+ -> Maybe (DL.DL BS.ByteString, BS.ByteString) splitByDL _ "" = Nothing splitByDL re haystack@(BS.BS fp l) = bimap (fmap pp) pp <$> slicePairs where ixes = unsafeDupablePerformIO $ matches' re haystack@@ -135,11 +135,11 @@ pp (s,e) = BS.BS (fp `plusForeignPtr` s) (e-s) {-# NOINLINE splitHLast #-}-splitHLast :: RurePtr -> BS.ByteString -> DL.DList BS.ByteString+splitHLast :: RurePtr -> BS.ByteString -> DL.DL BS.ByteString splitHLast rp b = case splitH rp b of {Nothing -> DL.empty; Just (as,a) -> as `DL.snoc` a} {-# NOINLINE splitH #-}-splitH :: RurePtr -> BS.ByteString -> Maybe (DL.DList BS.ByteString, BS.ByteString)+splitH :: RurePtr -> BS.ByteString -> Maybe (DL.DL 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
src/L.x view
@@ -231,11 +231,16 @@ res = constructor TokResVar; mkKw = constructor TokKeyword sym = constructor TokSym; mkBuiltin = constructor TokBuiltin -data R = Z | B+data R = Z | B | EE | ES escReplace :: T.Text -> T.Text escReplace = fst . T.foldl' g (T.empty, Z) where g (accum, _) '\\' = (accum, B)+ g (accum, B) 'E' = (accum, EE)+ g (accum, EE) 'S' = (accum, ES)+ g (accum, ES) 'C' = (accum `T.snoc` '\27', Z)+ g (accum, EE) c = (accum <> "\\E" `T.snoc` c, Z)+ g (accum, ES) c = (accum <> "\\ES" `T.snoc` c, Z) g (accum, B) '\'' = (accum `T.snoc` '\'', Z) g (accum, B) 'n' = (accum `T.snoc` '\n', Z) g (accum, B) 't' = (accum `T.snoc` '\t', Z)
src/Ty.hs view
@@ -226,16 +226,12 @@ checkType (TyB TyFloat) (IsSemigroup, _) = pure () checkType (TyB TyI) (IsNum, _) = pure () checkType (TyB TyFloat) (IsNum, _) = pure ()-checkType (TyB TyI) (IsEq, _) = pure ()-checkType (TyB TyFloat) (IsEq, _) = pure ()-checkType (TyB TyBool) (IsEq, _) = pure ()-checkType (TyB TyStr) (IsEq, _) = pure ()-checkType (TyTup tys) (c@IsEq, l) = traverse_ (`checkType` (c, l)) tys-checkType (TyRec tys) (c@IsEq, l) = traverse_ (`checkType` (c, l)) tys-checkType (Rho _ rs) (c@IsEq, l) = traverse_ (`checkType` (c, l)) (IM.elems rs)-checkType (Ρ _ rs) (c@IsEq, l) = traverse_ (`checkType` (c, l)) (Nm.elems rs)-checkType (TyB TyVec:$ty) (c@IsEq, l) = checkType ty (c, l)-checkType (TyB TyOption:$ty) (c@IsEq, l) = checkType ty (c, l)+checkType (TyRec tys) (c@IsOrd, l) = traverse_ (`checkType` (c, l)) tys+checkType (Rho _ rs) (c@IsOrd, l) = traverse_ (`checkType` (c, l)) (IM.elems rs)+checkType (Ρ _ rs) (c@IsOrd, l) = traverse_ (`checkType` (c, l)) (Nm.elems rs)+checkType (TyB TyVec:$ty) (c@IsOrd, l) = checkType ty (c, l)+checkType (TyB TyOption:$ty) (c@IsOrd, l) = checkType ty (c, l)+checkType (TyTup tys) (c@IsOrd, l) = traverse_ (`checkType` (c, l)) tys checkType (TyB TyI) (IsParse, _) = pure () checkType (TyB TyFloat) (IsParse, _) = pure () checkType (TyB TyFloat) (IsOrd, _) = pure ()@@ -355,13 +351,6 @@ let a' = var a pure $ a' ~> a' ~> tyB -tyEq :: Ord a => a -> TyM a T-tyEq l = do- a <- freshN "a"- addCM a (IsEq, l)- let a' = var a- pure $ a' ~> a' ~> tyB- -- min/max tyM :: Ord a => a -> TyM a T tyM l = do@@ -403,8 +392,8 @@ tyES s (BB l Lt) = do {t <- tyOrd l; pure (BB t Lt, s)} tyES s (BB l Geq) = do {t <- tyOrd l; pure (BB t Geq, s)} tyES s (BB l Leq) = do {t <- tyOrd l; pure (BB t Leq, s)}-tyES s (BB l Eq) = do {t <- tyEq l; pure (BB t Eq, s)}-tyES s (BB l Neq) = do {t <- tyEq l; pure (BB t Neq, s)}+tyES s (BB l Eq) = do {t <- tyOrd l; pure (BB t Eq, s)}+tyES s (BB l Neq) = do {t <- tyOrd l; pure (BB t Neq, s)} tyES s (BB l Min) = do {t <- tyM l; pure (BB t Min, s)} tyES s (BB l Max) = do {t <- tyM l; pure (BB t Max, s)} tyES s (BB _ Split) = pure (BB (tyStr ~> tyR ~> tyV tyStr) Split, s)@@ -441,9 +430,9 @@ tyES s (BB l Sprintf) = do {a <- freshN "a"; addCM a (IsPrintf, l); pure (BB (tyStr ~> var a ~> tyStr) Sprintf, s)} tyES s (BB l Rein) = do {f <- freshN "f"; addCM f (Foldable, l); pure (BB (tyStr ~> (var f:$tyStr) ~> tyStr) Rein, s)} tyES s (BB l Nier) = do {f <- freshN "f"; addCM f (Foldable, l); pure (BB ((var f:$tyStr) ~> tyStr ~> tyStr) Nier, s)}-tyES s (BB l DedupOn) = do {a <- freshTV "a"; b <- freshN "b"; addCM b (IsEq, l); let b'=var b in pure (BB (tyArr (a ~> b') (tyArr (tyStream a) (tyStream b'))) DedupOn, s)}+tyES s (BB l DedupOn) = do {a <- freshTV "a"; b <- freshN "b"; addCM b (IsOrd, l); let b'=var b in pure (BB (tyArr (a ~> b') (tyArr (tyStream a) (tyStream b'))) DedupOn, s)} tyES s (UB _ (At i)) = do {a <- freshTV "a"; pure (UB (tyV a ~> a) (At i), s)}-tyES s (UB l Dedup) = do {a <- freshN "a"; addCM a (IsEq, l); let sA=tyStream (var a) in pure (UB (sA ~> sA) Dedup, s)}+tyES s (UB l Dedup) = do {a <- freshN "a"; addCM a (IsOrd, l); let sA=tyStream (var a) in pure (UB (sA ~> sA) Dedup, s)} tyES s (UB _ Const) = do {a <- freshTV "a"; b <- freshTV "b"; pure (UB (a ~> b ~> a) Const, s)} tyES s (UB l CatMaybes) = do {a <- freshN "a"; f <- freshN "f"; addCM f (Witherable, l); let a'=var a; f'=var f in pure (UB (tyArr (f':$tyOpt a') (f':$a')) CatMaybes, s)} tyES s (BB l Filter) = do {a <- freshN "a"; f <- freshN "f"; addCM f (Witherable, l); let a'=var a; f'=var f; w=f':$a' in pure (BB ((a' ~> tyB) ~> w ~> w) Filter, s)}@@ -478,6 +467,9 @@ addCM f (Foldable, l) pure (BB ((a ~> a ~> a) ~> ((f':$a) ~> a)) Fold1, s) tyES s (TB _ Bookend) = pure (TB (tyR ~> tyR ~> tyStream tyStr ~> tyStream tyStr) Bookend, s)+tyES s (TB _ BookendG) = do+ a <- freshTV "a"+ pure (TB ((a~>tyB) ~> (a~>tyB) ~> tyStream a ~> tyStream a) BookendG, s) tyES s (TB _ Captures) = pure (TB (tyStr ~> tyI ~> tyR ~> tyOpt tyStr) Captures, s) tyES s (BB _ Prior) = do a <- freshTV "a"; b <- freshTV "b"
test/Spec.hs view
@@ -54,6 +54,7 @@ , 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"