jacinda 3.3.0.3 → 3.3.0.4
raw patch · 19 files changed
+354/−144 lines, 19 filesdep ~text
Dependency ranges changed: text
Files
- CHANGELOG.md +4/−0
- examples/evenOdd.jac +14/−0
- examples/path.jac +1/−0
- examples/pubmed2tex.jac +5/−4
- examples/tagsex.jac +12/−0
- examples/tastyStackTrace.jac +5/−0
- jacinda.cabal +27/−27
- src/A.hs +32/−16
- src/Include.hs +20/−21
- src/Jacinda/Backend/T.hs +76/−55
- src/Jacinda/Regex.hs +1/−1
- src/L.x +9/−14
- src/Nm.hs +3/−0
- src/Nm/Map.hs +4/−1
- src/Ty.hs +6/−4
- src/U.hs +1/−1
- test/Spec.hs +1/−0
- test/data/12492297.nbib +65/−0
- test/data/3282489.nbib +68/−0
CHANGELOG.md view
@@ -1,3 +1,7 @@+# 3.3.0.4++ * Don't crash when deduplicating tuples, arrays, optional values+ # 3.3.0.3 * Fix splitting with `--header` on large inputs
+ examples/evenOdd.jac view
@@ -0,0 +1,14 @@+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,4 +1,5 @@ {. echo $PATH | ja run examples/path.jac+{. ja run examples/path.jac <(echo $PATH) fn path(x) := ([x+'\n'+y]) |> (splitc x ':');
examples/pubmed2tex.jac view
@@ -1,5 +1,6 @@ {. ja run pubmed2tex.jac -i citation.nbib-:set rs:=/\r\n/;+:set header;+:set rs:=/\r\n[A-Z]{2,4}/; {. 10.1016/j.tig.2011.10.004 [doi] fn doi(record) :=@@ -12,7 +13,7 @@ ' ' + label + '={' + r + '},'; fn collateAu(r) :=- r ~* 1 /^FAU - (.*)$/;+ r ~* 1 /FAU - (.*)$/; fn bind(f,x) := option None f x;@@ -21,8 +22,8 @@ fn field(r) := let - val key := r ~* 1 /^([A-Z ]{4})-/- val value := r ~* 2 /^([A-Z ]{4})-\s*(.*)/+ val key := r ~* 1 /([A-Z ]{4})-/+ val value := r ~* 2 /([A-Z ]{4})-\s*(.*)/ in ?key=Some 'TI ';(pfield 'title')¨value ;?key=Some 'AID ';(pfield 'doi')¨bind doi value
+ examples/tagsex.jac view
@@ -0,0 +1,12 @@+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}
+ examples/tastyStackTrace.jac view
@@ -0,0 +1,5 @@+{. ja run examples/tastyStackTrace.jac -Dm='/Ty/' -i test/data/tasty-prof+:set rs:=/\*\*\* Exception \(reporting due to \+RTS \-xc\): \(THUNK(_\d)*\), stack trace:/;+:set fs:=/\n/;++{%m}{[x+'\n'+y]|>[x !~ /Test\.Tasty/] #. `$}
jacinda.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: jacinda-version: 3.3.0.3+version: 3.3.0.4 license: AGPL-3.0-only license-file: COPYING maintainer: vamchale@gmail.com@@ -18,9 +18,7 @@ lib/fs/*.jac prelude/*.jac -extra-doc-files:- CHANGELOG.md-+extra-doc-files: CHANGELOG.md extra-source-files: README.md man/ja.1@@ -63,14 +61,14 @@ common warnings ghc-options:- -Wall- -Wincomplete-uni-patterns -Wincomplete-record-updates+ -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wredundant-constraints -Widentities -Wcpp-undef -Wmissing-export-lists -Wunused-packages -Wno-x-partial -Wno-missing-signatures -Wredundant-bang-patterns+ -Wno-operator-whitespace-ext-conflict library jacinda-lib- import: warnings+ import: warnings exposed-modules: File A@@ -78,7 +76,7 @@ Parser Jacinda.Regex - hs-source-dirs: src+ hs-source-dirs: src other-modules: A.I A.E@@ -99,20 +97,20 @@ C Paths_jacinda - autogen-modules: Paths_jacinda- default-language: Haskell2010- ghc-options: -O2+ autogen-modules: Paths_jacinda+ default-language: Haskell2010+ ghc-options: -O2 build-depends: base >=4.11.0.0 && <5, bytestring >=0.11.2.0, dlist,- text,+ text >=2.0.1, prettyprinter >=1.7.0, containers >=0.6.0.1, array, mtl, transformers,- regex-rure >=0.1.2.0,+ regex-rure >=0.1.2.0 && <1.0.0.0, microlens, directory, filepath,@@ -135,7 +133,9 @@ OverloadedLists if !flag(cross)- build-tool-depends: alex:alex >=3.5.0.0, happy:happy >=2.1+ build-tool-depends:+ , alex:alex >=3.5.0.0+ , happy:happy >=2.1 executable ja import: warnings@@ -146,11 +146,11 @@ default-language: Haskell2010 ghc-options: -rtsopts "-with-rtsopts=-A200k -k32k" build-depends:- base,- directory,- jacinda-lib,- optparse-applicative >=0.14.1.0,- text+ , base+ , directory+ , jacinda-lib+ , optparse-applicative >=0.14.1.0+ , text test-suite jacinda-test import: warnings@@ -160,14 +160,14 @@ default-language: Haskell2010 ghc-options: -threaded -rtsopts "-with-rtsopts=-N -K1K" build-depends:- base,- jacinda-lib,- bytestring,- tasty,- tasty-golden,- tasty-hunit,- temporary,- text+ , base+ , bytestring+ , jacinda-lib+ , tasty+ , tasty-golden+ , tasty-hunit+ , temporary+ , text benchmark jacinda-bench import: warnings
src/A.hs view
@@ -55,14 +55,14 @@ infixr 0 :$ -data T = TyB { tyBuiltin :: TB }+data T = TyB { tyBuiltin :: !TB } | (:$) { tyApp0, tyApp1 :: T } | TyArr { tyArr0, tyArr1 :: T }- | TyVar { tyVar :: Nm () }+ | TyVar { tyVar :: !(Nm ()) } | TyTup { tyTups :: [T] } | TyRec { tyres :: NmMap T }- | Rho { tyRho :: Nm (), tyArms :: IM.IntMap T }- | Ρ { tyΡ :: Nm (), tyρs :: NmMap T }+ | Rho { tyRho :: !(Nm ()), tyArms :: IM.IntMap T }+ | Ρ { tyΡ :: !(Nm ()), tyρs :: NmMap T } deriving Eq instance Pretty TB where@@ -180,14 +180,30 @@ -- 0-ary data N = Ix | Nf | None | Fp | MZ -data L = ILit !Integer | FLit !Double | BLit !Bool | StrLit BS.ByteString deriving (Generic, NFData)+data L = ILit !Integer | FLit !Double | BLit !Bool | StrLit BS.ByteString deriving (Generic, Eq, Ord, NFData) class PS a where ps :: Int -> a -> Doc ann +instance Eq (E a) where+ (==) (Lit _ l₀) (Lit _ l₁) = l₀==l₁+ (==) (Tup _ es₀) (Tup _ es₁) = es₀==es₁+ (==) (Rec _ a₀) (Rec _ a₁) = a₀==a₁+ (==) (OptionVal _ e₀) (OptionVal _ e₁) = e₀==e₁+ (==) (Arr _ e₀) (Arr _ e₁) = e₀==e₁+ (==) _ _ = undefined++instance Ord (E a) where+ compare (Lit _ l₀) (Lit _ l₁) = compare l₀ l₁+ compare (Tup _ es₀) (Tup _ es₁) = compare es₀ es₁+ compare (Rec _ a₀) (Rec _ a₁) = compare a₀ a₁+ compare (OptionVal _ e₀) (OptionVal _ e₁) = compare e₀ e₁+ compare (Arr _ e₀) (Arr _ e₁) = compare e₀ e₁+ compare _ _ = undefined+ -- expression-data E a = Column { eLoc :: a, col :: Int }- | IParseCol { eLoc :: a, col :: Int } | FParseCol { eLoc :: a, col :: Int } | ParseCol { eLoc :: a, col :: Int }- | Field { eLoc :: a, eField :: Int } | LastField { eLoc :: a } | FieldList { eLoc :: a }+data E a = Column { eLoc :: a, col :: !Int }+ | IParseCol { eLoc :: a, col :: !Int } | FParseCol { eLoc :: a, col :: !Int } | ParseCol { eLoc :: a, col :: Int }+ | Field { eLoc :: a, eField :: !Int } | LastField { eLoc :: a } | FieldList { eLoc :: a } | AllField { eLoc :: a } -- ^ Think @$0@ in awk. | AllColumn { eLoc :: a } -- ^ Think @$0@ in awk. | IParseAllCol { eLoc :: a } -- ^ @$0@, parsed as an integer@@ -203,18 +219,18 @@ | RegexLit { eLoc :: a, eRr :: BS.ByteString } | Lam { eLoc :: a, eBound :: Nm a, lamE :: E a } | Dfn { eLoc :: a, eDfn :: E a }- | BB { eLoc :: a, eBin :: BBin } | TB { eLoc :: a, eTer :: BTer } | UB { eLoc :: a, eUn :: BUn }- | NB { eLoc :: a, eNil :: N }+ | BB { eLoc :: a, eBin :: !BBin } | TB { eLoc :: a, eTer :: !BTer } | UB { eLoc :: a, eUn :: !BUn }+ | NB { eLoc :: a, eNil :: !N } | Tup { eLoc :: a, esTup :: [E a] } | Rec { eLoc :: a, esR :: [(Nm a, E a)] }- | ResVar { eLoc :: a, dfnVar :: DfnVar }+ | ResVar { eLoc :: a, dfnVar :: !DfnVar } | RC RurePtr -- compiled regex after normalization | Arr { eLoc :: a, elems :: !(V.Vector (E a)) } | Anchor { eLoc :: a, eAnchored :: [E a] }- | Paren { eLoc :: a, eExpr :: E a }+ | Paren { eLoc :: a, eExpr :: !(E a) } | OptionVal { eLoc :: a, eMaybe :: Maybe (E a) } | Cond { eLoc :: a, eIf, eThen, eElse :: E a }- | RwB { eLoc :: a, eBin :: BBin } | RwT { eLoc :: a, eTer :: BTer }+ | RwB { eLoc :: a, eBin :: !BBin } | RwT { eLoc :: a, eTer :: !BTer } deriving (Functor) instance Pretty N where@@ -332,11 +348,11 @@ instance Show C where show=show.pretty -- decl-data D a = SetFS T.Text | SetRS T.Text+data D a = SetFS !T.Text | SetRS !T.Text | FunDecl (Nm a) [Nm a] (E a) | FlushDecl | SetH | SetAsv | SetUsv | SetCsv- | SetOFS T.Text | SetORS T.Text+ | SetOFS !T.Text | SetORS !T.Text deriving (Functor) instance Pretty (D a) where@@ -363,7 +379,7 @@ awk = AWK Nothing Nothing False -data Mode = CSV | AWK (Maybe T.Text) (Maybe T.Text) Bool -- field, record, include header in record split+data Mode = CSV | AWK !(Maybe T.Text) !(Maybe T.Text) !Bool -- field, record, include header in record split getS :: Program a -> Mode getS (Program ds _) = foldl' go awk ds where
src/Include.hs view
@@ -1,18 +1,18 @@-module Include ( defaultIncludes- , resolveImport- ) where+{-# LANGUAGE LambdaCase #-} -import Control.Exception (Exception, throwIO)-import Control.Monad (filterM)-import Data.List.Split (splitWhen)-import Data.Maybe (listToMaybe)-import Paths_jacinda (getDataDir)-import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory)-import System.Environment (lookupEnv)-import System.FilePath ((</>))+module Include ( defaultIncludes, resolveImport ) where -data ImportError = FileNotFound !FilePath ![FilePath] deriving (Show)+import Control.Exception (Exception, throwIO)+import Control.Monad (filterM, (<=<))+import Data.Containers.ListUtils (nubOrd)+import Data.List.Split (splitWhen)+import Paths_jacinda (getDataDir)+import System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist, getCurrentDirectory)+import System.Environment (lookupEnv)+import System.FilePath ((</>)) +data ImportError = FileNotFound !FilePath ![FilePath] | AmbiguousInclude ![FilePath] deriving (Show)+ instance Exception ImportError where defaultIncludes :: IO ([FilePath] -> [FilePath])@@ -27,13 +27,12 @@ jacPath :: IO [FilePath] jacPath = maybe [] splitEnv <$> lookupEnv "JAC_PATH"--splitEnv :: String -> [FilePath]-splitEnv = splitWhen (== ':')+ where+ splitEnv = splitWhen (== ':') -resolveImport :: [FilePath] -- ^ Places to look- -> FilePath- -> IO FilePath-resolveImport incl fp =- maybe (throwIO $ FileNotFound fp incl) pure . listToMaybe- =<< (filterM doesFileExist . fmap (</> fp) $ incl)+resolveImport :: [FilePath] -> FilePath -> IO FilePath+resolveImport incl fp = ($incl) $+ (\case [] -> throwIO $ FileNotFound fp incl; [src] -> pure (src</>fp); fs -> throwIO $ AmbiguousInclude fs)+ . nubOrd+ <=< traverse canonicalizePath+ <=< (filterM (doesFileExist . (</> fp)))
src/Jacinda/Backend/T.hs view
@@ -55,13 +55,13 @@ instance Exception StreamError where type Env = IM.IntMap (Maybe (E T)); type I=Int-data Σ = Σ !I !Env (IM.IntMap (S.Set BS.ByteString)) (IM.IntMap IS.IntSet) (IM.IntMap (S.Set Double)) IS.IntSet+data Σ = Σ !I !Env (IM.IntMap (S.Set BS.ByteString)) (IM.IntMap IS.IntSet) (IM.IntMap (S.Set Double)) IS.IntSet (IM.IntMap (S.Set (E T))) type Tmp = Int type Β = IM.IntMap (E T) mE :: (Env -> Env) -> Σ -> Σ-mE f (Σ i e d di df b) = Σ i (f e) d di df b-gE (Σ _ e _ _ _ _) = e+mE f (Σ i e d di df b de) = Σ i (f e) d di df b de+gE (Σ _ e _ _ _ _ _) = e at :: V.Vector a -> Int -> a v `at` ix = case v V.!? (ix-1) of {Just x -> x; Nothing -> throw $ IndexOutOfBounds ix}@@ -102,19 +102,19 @@ run h flush j e ctxs | TyB TyUnit <- eLoc e = (\(s, f, env) -> pSF h flush (s,f) env) $ uStream j $ do (res, tt, iEnv, μ) <- unit e u <- nI- let outs=μ<$>ctxs; es'=scanl' (&) (Σ u iEnv IM.empty IM.empty IM.empty IS.empty) outs+ let outs=μ<$>ctxs; es'=scanl' (&) (Σ u iEnv IM.empty IM.empty IM.empty IS.empty IM.empty) outs pure (res, tt, gE<$>es') run h flush j e ctxs | TyB TyStream:$_ <- eLoc e = traverse_ (traverse_ (pS h flush)).uStream j $ do t <- nI (iEnv, μ) <- ctx e t u <- nI- let outs=μ<$>ctxs; es={-# SCC "scanMain" #-} scanl' (&) (Σ u iEnv IM.empty IM.empty IM.empty IS.empty) outs+ let outs=μ<$>ctxs; es={-# SCC "scanMain" #-} scanl' (&) (Σ u iEnv IM.empty IM.empty IM.empty IS.empty IM.empty) outs pure ((! t).gE<$>es) run h _ j e ctxs = pDocLn h $ uStream j $ do (iEnv, g, e0) <- collect e u <- nI let updates=g<$>ctxs- finEnv=foldl' (&) (Σ u iEnv IM.empty IM.empty IM.empty IS.empty) updates+ finEnv=foldl' (&) (Σ u iEnv IM.empty IM.empty IM.empty IS.empty IM.empty) updates e0@>(fromMaybe (throw EmptyFold)<$>gE finEnv) unit :: E T -> UM (Maybe Tmp, [Tmp], Env, LineCtx -> Σ -> Σ)@@ -276,6 +276,7 @@ ctx (EApp _ (EApp _ (EApp _ (TB _ ZipW) op) xs) ys) o = do {t0 <- nI; t1 <- nI; (env0, sb0) <- ctx xs t0; (env1, sb1) <- ctx ys t1; pure (na o (env0<>env1), \l->wZ op t0 t1 o.sb0 l.sb1 l)} ctx (EApp _ (EApp _ (BB _ Prior) op) xs) o = do {t <- nI; (env, sb) <- ctx xs t; pt <- nI; pure (na o (pt\~env), \l -> wΠ op pt t o.sb l)} ctx (EApp (_:$TyB ty) (UB _ Dedup) xs) o = do {k <- nI; t <- nI; (env, sb) <- ctx xs t; pure (na o env, \l->wD ty k t o.sb l)}+ctx (EApp _ (UB _ Dedup) xs) o = do {k <- nI; t <- nI; (env, sb) <- ctx xs t; pure (na o env, \l->wDE k t o.sb l)} ctx (EApp _ (EApp _ (BB _ DedupOn) f) xs) o = do {k <- nI; t <- nI; (env, sb) <- ctx xs t; pure (na o env, \l->wDOp f k t o.sb l)} ctx (EApp _ (EApp _ (EApp _ (TB _ Bookend) e0) e1) xs) o = do {k <- nI; t <- nI; (env, sb) <- ctx xs t; r0 <- e0@>mempty; r1<- e1@>mempty; pure (na o env, \l->wB (r0,r1) k t o.sb l)} ctx e _ | TyB TyStream:$_ <- eLoc e = error ("?? uh-oh. " ++ show e)@@ -558,70 +559,71 @@ ms (Nm _ (U i) _) = IM.singleton i wCM :: Tmp -> Tmp -> Σ -> Σ-wCM src tgt (Σ u env d di df b) =+wCM src tgt (Σ u env d di df b de) = Σ u (case env!src of Just y -> case asM y of {Nothing -> tgt\~env; Just yϵ -> env&tgt~!yϵ}- Nothing -> tgt\~env) d di df b+ Nothing -> tgt\~env) d di df b de {-# SCC wMM #-} wMM :: E T -> Tmp -> Tmp -> Σ -> Σ-wMM (Lam _ n e) src tgt (Σ j env d di df b) =+wMM (Lam _ n e) src tgt (Σ j env d di df b de) = case env!src of Just x -> let be=ms n x; (y,k)=e@!(j,be) in Σ k (case asM y of Just yϵ -> env&tgt~!yϵ- Nothing -> tgt\~env) d di df b- Nothing -> Σ j (tgt\~env) d di df b+ Nothing -> tgt\~env) d di df b de+ Nothing -> Σ j (tgt\~env) d di df b de wMM e _ _ _ = throw$InternalArityOrEta 1 e wZ :: E T -> Tmp -> Tmp -> Tmp -> Σ -> Σ-wZ (Lam _ n0 (Lam _ n1 e)) src0 src1 tgt (Σ j env d di df b) =+wZ (Lam _ n0 (Lam _ n1 e)) src0 src1 tgt (Σ j env d di df b de) = (case (env!src0, env!src1) of (Just x, Just y) -> let be=me [(n0, x), (n1, y)]; (z,k)=e@!(j,be) in Σ k (env&tgt~!z)- (Nothing, Nothing) -> Σ j (tgt\~env)) d di df b+ (Nothing, Nothing) -> Σ j (tgt\~env)) d di df b de wZ e _ _ _ _ = throw$InternalArityOrEta 2 e wM :: E T -> Tmp -> Tmp -> Σ -> Σ-wM (Lam _ n e) src tgt (Σ j env d di df b) =+wM (Lam _ n e) src tgt (Σ j env d di df b de) = case env!src of Just x -> let be=ms n x; (y,k)=e@!(j,be)- in Σ k (env&tgt~!y) d di df b- Nothing -> Σ j (tgt\~env) d di df b+ in Σ k (env&tgt~!y) d di df b de+ Nothing -> Σ j (tgt\~env) d di df b de wM e _ _ _ = throw$InternalArityOrEta 1 e wI :: E T -> Tmp -> LineCtx -> Σ -> Σ-wI e tgt line (Σ j env d di df b) =- let e'=e `κ` line; (e'',k)=e'$@j in Σ k (env&tgt~!e'') d di df b+wI e tgt line (Σ j env d di df b de) =+ let e'=e `κ` line; (e'',k)=e'$@j in Σ k (env&tgt~!e'') d di df b de wG :: (E T, E T) -> Tmp -> LineCtx -> Σ -> Σ-wG (p, e) tgt line (Σ j env d di df b) =+wG (p, e) tgt line (Σ j env d di df b de) = let p'=p `κ` line; (p'',k)=p'$@j in (if asB p'' then let e'=e `κ` line; (e'',u) =e'$@k in Σ u (env&tgt~!e'')- else Σ k (tgt\~env)) d di df b+ else Σ k (tgt\~env)) d di df b de +-- TODO: TyBool wDOp :: E T -> Int -> Tmp -> Tmp -> Σ -> Σ-wDOp (Lam (TyArr _ (TyB TyStr)) n e) key src tgt (Σ i env d di df b) =+wDOp (Lam (TyArr _ (TyB TyStr)) n e) key src tgt (Σ i env d di df b de) = case env!src of- Nothing -> Σ i (tgt\~env) d di df b+ Nothing -> Σ i (tgt\~env) d di df b de Just xϵ -> case IM.lookup key d of- Nothing -> Σ k (env&tgt~!y) (IM.insert key (S.singleton e') d) di df b- Just ss -> (if e' `S.member` ss then Σ k (tgt\~env) d else Σ k (env&tgt~!y) (key!:e'$d)) di df b+ Nothing -> Σ k (env&tgt~!y) (IM.insert key (S.singleton e') d) di df b de+ Just ss -> (if e' `S.member` ss then Σ k (tgt\~env) d else Σ k (env&tgt~!y) (key!:e'$d)) di df b de where (y,k)=e@!(i,be); be=ms n xϵ e'=asS y-wDOp (Lam (TyArr _ (TyB TyI)) n e) key src tgt (Σ i env d di df b) =+wDOp (Lam (TyArr _ (TyB TyI)) n e) key src tgt (Σ i env d di df b de) = case env!src of- Nothing -> Σ i (tgt\~env) d di df b+ Nothing -> Σ i (tgt\~env) d di df b de Just xϵ -> case IM.lookup key di of- Nothing -> Σ k (env&tgt~!y) d (IM.insert key (IS.singleton e') di) df b- Just ds -> (if e' `IS.member` ds then Σ k (tgt\~env) d di else Σ k (env&tgt~!y) d (IM.alter go key di)) df b+ Nothing -> Σ k (env&tgt~!y) d (IM.insert key (IS.singleton e') di) df b de+ Just ds -> (if e' `IS.member` ds then Σ k (tgt\~env) d di else Σ k (env&tgt~!y) d (IM.alter go key di)) df b de where (y,k)=e@!(i,be); be=ms n xϵ@@ -629,16 +631,25 @@ go Nothing = Just$!IS.singleton e' go (Just s) = Just$!IS.insert e' s-wDOp (Lam (TyArr _ (TyB TyFloat)) n e) key src tgt (Σ i env d di df b) =+wDOp (Lam (TyArr _ (TyB TyFloat)) n e) key src tgt (Σ i env d di df b de) = case env!src of- Nothing -> Σ i (tgt\~env) d di df b+ Nothing -> Σ i (tgt\~env) d di df b de Just xϵ -> case IM.lookup key df of- Nothing -> Σ k (env&tgt~!y) d di (IM.insert key (S.singleton e') df) b- Just ds -> if e' `S.member` ds then Σ k (tgt\~env) d di df b else Σ k (env&tgt~!y) d di (key!:e'$df) b+ Nothing -> Σ k (env&tgt~!y) d di (IM.insert key (S.singleton e') df) b de+ Just ds -> (if e' `S.member` ds then Σ k (tgt\~env) d di df else Σ k (env&tgt~!y) d di (key!:e'$df)) b de where (y,k)=e@!(i,be); be=ms n xϵ e'=asF y+wDOp (Lam _ n e) key src tgt (Σ i env d di df b de) =+ case env!src of+ Nothing -> Σ i (tgt\~env) d di df b de+ Just xϵ ->+ case IM.lookup key de of+ Nothing -> Σ k (env&tgt~!y) d di df b (IM.insert key (S.singleton y) de)+ Just ds -> (if y `S.member` ds then Σ k (tgt\~env) d di df b de else Σ k (env&tgt~!y) d di df b (key!:y$de))+ where+ (y,k)=e@!(i,be); be=ms n xϵ wDOp e _ _ _ _ = throw $ InternalArityOrEta 1 e (\~) k = IM.insert k Nothing@@ -647,60 +658,70 @@ (!:) k e = IM.alter (\x -> Just$!case x of Nothing -> S.singleton e; Just s -> S.insert e s) k wB :: (E T, E T) -> Int -> Tmp -> Tmp -> Σ -> Σ-wB (e0, e1) key src tgt (Σ i env d di df b) =- case env!src of+wB (e0, e1) key src tgt (Σ i env d di df b de) =+ (case env!src of Nothing -> Σ i (tgt\~env) d di df b Just xϵ -> let xS=asS xϵ in if key `IS.member` b- then if isMatch' r1 xS then Σ i (env&tgt~!xϵ) d di df (IS.delete key b) else Σ i (env&tgt~!xϵ) d di df b- else if isMatch' r0 xS then Σ i (env&tgt~!xϵ) d di df (IS.insert key b) else Σ i (tgt\~env) d di df b+ then (if isMatch' r1 xS then Σ i (env&tgt~!xϵ) d di df (IS.delete key b) else Σ i (env&tgt~!xϵ) d di df b)+ else (if isMatch' r0 xS then Σ i (env&tgt~!xϵ) d di df (IS.insert key b) else Σ i (tgt\~env) d di df b)) de where r0=asR e0; r1=asR e1 +wDE :: Int -> Tmp -> Tmp -> Σ -> Σ+wDE key src tgt (Σ i env d di df b de) =+ case env!src of+ Nothing -> Σ i (tgt\~env) d di df b de+ Just e ->+ case IM.lookup key de of+ Nothing -> Σ i (env&tgt~!e) d di df b (IM.insert key (S.singleton e) de)+ Just ds -> if e `S.member` ds then Σ i (tgt\~env) d di df b de else Σ i (env&tgt~!e) d di df b (key!:e$de)++-- TODO: TyB lol {-# SCC wD #-} wD :: TB -> Int -> Tmp -> Tmp -> Σ -> Σ-wD TyStr key src tgt (Σ i env d di df b) =+wD TyStr key src tgt (Σ i env d di df b de) = case env!src of- Nothing -> Σ i (tgt\~env) d di df b+ Nothing -> Σ i (tgt\~env) d di df b de Just e -> case IM.lookup key d of- Nothing -> Σ i (env&tgt~!e) (IM.insert key (S.singleton e') d) di df b- Just ds -> (if e' `S.member` ds then Σ i (tgt\~env) d else Σ i (env&tgt~!e) (key!:e'$d)) di df b+ Nothing -> Σ i (env&tgt~!e) (IM.insert key (S.singleton e') d) di df b de+ Just ds -> (if e' `S.member` ds then Σ i (tgt\~env) d else Σ i (env&tgt~!e) (key!:e'$d)) di df b de where e'=asS e-wD TyI key src tgt (Σ i env d di df b) =+wD TyI key src tgt (Σ i env d di df b de) = case env!src of- Nothing -> Σ i (tgt\~env) d di df b+ Nothing -> Σ i (tgt\~env) d di df b de Just e -> case IM.lookup key di of- Nothing -> Σ i (env&tgt~!e) d (IM.insert key (IS.singleton e') di) df b- Just ds -> (if e' `IS.member` ds then Σ i (tgt\~env) d di else Σ i (env&tgt~!e) d (IM.alter go key di)) df b+ Nothing -> Σ i (env&tgt~!e) d (IM.insert key (IS.singleton e') di) df b de+ Just ds -> (if e' `IS.member` ds then Σ i (tgt\~env) d di else Σ i (env&tgt~!e) d (IM.alter go key di)) df b de where e'=fromIntegral$asI e go Nothing = Just$!IS.singleton e' go (Just s) = Just$!IS.insert e' s-wD TyFloat key src tgt (Σ i env d di df b) =+wD TyFloat key src tgt (Σ i env d di df b de) = case env!src of- Nothing -> Σ i (tgt\~env) d di df b+ Nothing -> Σ i (tgt\~env) d di df b de Just e -> case IM.lookup key df of- Nothing -> Σ i (env&tgt~!e) d di (IM.insert key (S.singleton e') df) b- Just ds -> (if e' `S.member` ds then Σ i (tgt\~env) d di df else Σ i (env&tgt~!e) d di (key!:e'$df)) b+ Nothing -> Σ i (env&tgt~!e) d di (IM.insert key (S.singleton e') df) b de+ Just ds -> (if e' `S.member` ds then Σ i (tgt\~env) d di df else Σ i (env&tgt~!e) d di (key!:e'$df)) b de where e'=asF e wP :: E T -> Tmp -> Tmp -> Σ -> Σ-wP (Lam _ n e) src tgt (Σ j env d di df b) =+wP (Lam _ n e) src tgt (Σ j env d di df b de) = case env!src of Just x -> let be=ms n x; (p,k)=e@!(j,be)- in Σ k (IM.insert tgt (if asB p then Just$!x else Nothing) env) d di df b- Nothing -> Σ j (tgt\~env) d di df b+ in Σ k (IM.insert tgt (if asB p then Just$!x else Nothing) env) d di df b de+ Nothing -> Σ j (tgt\~env) d di df b de wP e _ _ _ = throw $ InternalArityOrEta 1 e wΠ :: E T -> Tmp -> Tmp -> Tmp -> Σ -> Σ-wΠ (Lam _ nn (Lam _ nprev e)) pt src tgt (Σ j env d di df b) =+wΠ (Lam _ nn (Lam _ nprev e)) pt src tgt (Σ j env d di df b de) = (case (env!pt, env!src) of (Just prev, Just x) -> let be=me [(nprev, prev), (nn, x)]@@ -708,12 +729,12 @@ in Σ u (IM.insert pt (Just$!x) (IM.insert tgt (Just$!res) env)) (Nothing, Nothing) -> Σ j (tgt\~env) (Nothing, Just x) -> Σ j (pt~!x$tgt\~env)- (Just{}, Nothing) -> Σ j (tgt\~env)) d di df b+ (Just{}, Nothing) -> Σ j (tgt\~env)) d di df b de wΠ e _ _ _ _ = throw $ InternalArityOrEta 2 e {-# SCC wF #-} wF :: E T -> Tmp -> Tmp -> Σ -> Σ-wF (Lam _ nacc (Lam _ nn e)) src tgt (Σ j env d di df b) =+wF (Lam _ nacc (Lam _ nn e)) src tgt (Σ j env d di df b de) = (case (env!tgt, env!src) of (Just acc, Just x) -> let be=me [(nacc, acc), (nn, x)]@@ -721,7 +742,7 @@ in Σ u (env&tgt~!res) (Just acc, Nothing) -> Σ j (env&tgt~!acc) (Nothing, Nothing) -> Σ j (tgt\~env)- (Nothing, Just x) -> Σ j (env&tgt~!x)) d di df b+ (Nothing, Just x) -> Σ j (env&tgt~!x)) d di df b de wF e _ _ _ = throw $ InternalArityOrEta 2 e badctx e = error ("Internal error: κ called on" ++ show e)
src/Jacinda/Regex.hs view
@@ -123,7 +123,7 @@ {-# SCC splitByDL #-} {-# NOINLINE splitByDL #-} splitByDL :: RurePtr -> BS.ByteString- -> Maybe (DL.DList (BS.ByteString), 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
src/L.x view
@@ -228,22 +228,18 @@ constructor c t = tok (\p _ -> alex $ c p t) -res = constructor TokResVar--mkKw = constructor TokKeyword--sym = constructor TokSym+res = constructor TokResVar; mkKw = constructor TokKeyword+sym = constructor TokSym; mkBuiltin = constructor TokBuiltin -mkBuiltin = constructor TokBuiltin+data R = Z | B --- this is inefficient but w/e escReplace :: T.Text -> T.Text-escReplace =- T.replace "\\\'" "\'"- . T.replace "\\\\" "\\"- . T.replace "\\ESC" "\ESC"- . T.replace "\\n" "\n"- . T.replace "\\t" "\t"+escReplace = fst . T.foldl' g (T.empty, Z) where+ g (accum, _) '\\' = (accum, B)+ 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)+ g (accum, _) c = (accum `T.snoc` c, Z) escRr :: T.Text -> T.Text escRr = T.replace "\\/" "/"@@ -251,7 +247,6 @@ instance Pretty AlexPosn where pretty (AlexPn _ line col) = pretty line <> colon <> pretty col --- functional bimap? type AlexUserState = (Int, M.Map T.Text Int, IM.IntMap (Nm AlexPosn)) alexInitUserState :: AlexUserState
src/Nm.hs view
@@ -12,6 +12,9 @@ instance Eq (Nm a) where (==) (Nm _ u _) (Nm _ u' _) = u == u' +instance Ord (Nm a) where+ compare (Nm _ u _) (Nm _ u' _) = compare u u'+ instance Pretty (Nm a) where pretty (Nm t _ _) = pretty t
src/Nm/Map.hs view
@@ -21,7 +21,10 @@ infixl 9 ! data NmMap a = NmMap { xx :: !(IM.IntMap a), context :: IM.IntMap T.Text }- deriving (Eq, Functor, Foldable, Traversable)+ deriving (Functor, Foldable, Traversable)++instance Eq a => Eq (NmMap a) where+ (==) (NmMap xx₀ _) (NmMap xx₁ _) = xx₀==xx₁ instance Semigroup (NmMap a) where (<>) (NmMap x y) (NmMap x' y') = NmMap (x<>x') (y<>y')
src/Ty.hs view
@@ -129,13 +129,15 @@ occ (Rho (Nm _ (U i) _) rs) = IS.insert i (foldMap occ (IM.elems rs)) occ (Ρ (Nm _ (U i) _) rs) = IS.insert i (foldMap occ (Nm.elems rs)) +bc :: a -> U -> T -> T -> Subst -> Either (Err a) Subst+bc x (U u) t t' s | u `IS.member` occ t = Left $ Occ x t t'+ | otherwise = Right $ IM.insert u t s+ mgu :: l -> Subst -> T -> T -> Either (Err l) Subst mgu _ s (TyB b) (TyB b') | b == b' = Right s mgu _ s (TyVar n) (TyVar n') | n == n' = Right s-mgu l s t t'@(TyVar (Nm _ (U k) _)) | k `IS.notMember` occ t = Right $ IM.insert k t s- | otherwise = Left $ Occ l t' t-mgu l s t@(TyVar (Nm _ (U k) _)) t' | k `IS.notMember` occ t' = Right $ IM.insert k t' s- | otherwise = Left $ Occ l t t'+mgu l s t t'@(TyVar (Nm _ u _)) = bc l u t t' s+mgu l s t@(TyVar (Nm _ u _)) t' = bc l u t' t s mgu l s (TyArr t0 t1) (TyArr t0' t1') = do {s0 <- mgu l s t0 t0'; mguPrep l s0 t1 t1'} mgu l s (t0:$t1) (t0':$t1') = do {s0 <- mgu l s t0 t0'; mguPrep l s0 t1 t1'} mgu l s (TyTup ts) (TyTup ts') | length ts == length ts' = zS (mguPrep l) s ts ts'
src/U.hs view
@@ -1,3 +1,3 @@ module U ( U (..) ) where -newtype U = U { unU :: Int } deriving (Eq)+newtype U = U { unU :: Int } deriving (Eq, Ord)
test/Spec.hs view
@@ -63,6 +63,7 @@ awk "test/data/python-site" "-L/Users/vanessa/Library/Python/3.13/lib/python/site-packages -L/Library/Frameworks/Python.framework/Versions/3.13/lib/python3.13/site-packages"+ , ep "[x]~.*{ix>1}{(`4 . `5)}" CSV "test/data/food-prices.csv" "(FINAL . Dollars)" , harnessF "{%/hs-source-dirs/}{`2}" (AWK (Just "\\s*:\\s*") Nothing False) "jacinda.cabal" "test/golden/src-dirs.out" , harnessF ".?{|`0 ~* 1 /^\\s*hs-source-dirs:\\s*(.*)/}" awk "jacinda.cabal" "test/golden/src-dirs.out" -- , harnessF "[x+' '+y]|>$0" (AWK Nothing (Just "\\n\\s*") False) "vscode/syntaxes/jacinda.tmLanguage.json" "test/golden/minify.out"
+ test/data/12492297.nbib view
@@ -0,0 +1,65 @@+PMID- 12492297 +OWN - NLM +STAT- MEDLINE +DCOM- 20030114 +LR - 20190910 +IS - 0735-7044 (Print) +IS - 0735-7044 (Linking) +VI - 116 +IP - 6 +DP - 2002 Dec +TI - Organizing and activating effects of sex hormones in homosexual transsexuals. +PG - 982-8 +AB - The cause of transsexualism remains unclear. The hypothesis that atypical + prenatal hormone exposure could be a factor in the development of transsexualism + was examined by establishing whether an atypical pattern of cognitive functioning + was present in homosexual transsexuals. Possible activating effects of sex + hormones as a result of cross-sex hormone treatment were also studied. + Female-to-male and male-to-female transsexuals were compared with female and male + controls with respect to spatial ability before and after treatment. The data + were consistent with an organizing effect, but there was no evidence of an + activating effect. Homosexual transsexuals, who prior to hormone treatment scored + in the direction of the opposite sex, may have reached a ceiling in performance + and therefore do not benefit from activating hormonal effects. +FAU - van Goozen, Stephanie H M +AU - van Goozen SH +AD - Department of Child and Adolescent Psychiatry, University Medical Center Utrecht, + The Netherlands. shmv2@cam.ac.uk +FAU - Slabbekoorn, Ditte +AU - Slabbekoorn D +FAU - Gooren, Louis J G +AU - Gooren LJ +FAU - Sanders, Geoff +AU - Sanders G +FAU - Cohen-Kettenis, Peggy T +AU - Cohen-Kettenis PT +LA - eng +PT - Journal Article +PT - Research Support, Non-U.S. Gov't +PL - United States +TA - Behav Neurosci +JT - Behavioral neuroscience +JID - 8302411 +RN - 0 (Gonadal Steroid Hormones) +SB - IM +MH - Adolescent +MH - Adult +MH - Cognition/*physiology +MH - Female +MH - Gonadal Steroid Hormones/*pharmacology +MH - Homosexuality/*psychology +MH - Humans +MH - Male +MH - Middle Aged +MH - Pregnancy +MH - *Prenatal Exposure Delayed Effects +MH - Transsexualism/*physiopathology +EDAT- 2002/12/21 04:00 +MHDA- 2003/01/15 04:00 +CRDT- 2002/12/21 04:00 +PHST- 2002/12/21 04:00 [pubmed] +PHST- 2003/01/15 04:00 [medline] +PHST- 2002/12/21 04:00 [entrez] +AID - 10.1037//0735-7044.116.6.982 [doi] +PST - ppublish +SO - Behav Neurosci. 2002 Dec;116(6):982-8. doi: 10.1037//0735-7044.116.6.982.
+ test/data/3282489.nbib view
@@ -0,0 +1,68 @@+PMID- 3282489 +OWN - NLM +STAT- MEDLINE +DCOM- 19880526 +LR - 20190919 +IS - 0004-0002 (Print) +IS - 0004-0002 (Linking) +VI - 17 +IP - 1 +DP - 1988 Feb +TI - Neuroendocrine response to estrogen and brain differentiation in heterosexuals, + homosexuals, and transsexuals. +PG - 57-75 +AB - Since 1964, we have found positive estrogen feedback to be a relatively + sex-specific reaction of the hypothalamo-hypophyseal system in rats as well as in + human beings. It is dependent on the estrogen-convertible androgen level during + sexual brain differentiation and also on estrogen priming in adulthood. The lower + the estrogen-convertible androgen or primary estrogen level during brain + differentiation, the higher the evocability of a positive estrogen action on LH + secretion in later life. In clinical studies, we induced a positive estrogen + feedback luteinizing hormone secretion in most intact homosexual men, in + clear-cut contrast to intact heterosexual or bisexual men. In addition, the + evocability of a positive estrogen feedback was also demonstrable in most + homosexual male-to-female transsexuals in significant contrast to hetero-or + bisexual male-to-female transsexuals. The following relations have been found + between sex hormone levels during brain differentiation and sex-specific + responses in adulthood: (i) Estrogens, which are mostly converted from androgens, + are responsible for the sex-specific organization of gonadotropin secretion and + hence the evocability of a positive estrogen feedback in later life; (ii) both + estrogens and androgens, occurring during brain differentiation, predetermine + sexual orientation, and (iii) androgens, without conversion to estrogens, are + responsible for the sex-specific organization of gender role behavior. + Furthermore, the organization periods for sex-specific gonadotropin secretion, + sexual orientation, and gender role behavior are not identical but overlapping. + Thus, combinations as well as dissociations between deviation of the + neuroendocrine organization of sex-specific gonadotropin secretion, sexual + orientation, and gender role behavior may occur. +FAU - Dörner, G +AU - Dörner G +LA - eng +PT - Journal Article +PT - Review +PL - United States +TA - Arch Sex Behav +JT - Archives of sexual behavior +JID - 1273516 +RN - 0 (Estrogens) +RN - 9002-67-9 (Luteinizing Hormone) +SB - IM +MH - Brain/*embryology +MH - Estrogens/*physiology +MH - Feedback +MH - *Homosexuality +MH - Humans +MH - Luteinizing Hormone/blood +MH - Male +MH - *Sex Differentiation +MH - Transsexualism/*blood +RF - 64 +EDAT- 1988/02/01 00:00 +MHDA- 1988/02/01 00:01 +CRDT- 1988/02/01 00:00 +PHST- 1988/02/01 00:00 [pubmed] +PHST- 1988/02/01 00:01 [medline] +PHST- 1988/02/01 00:00 [entrez] +AID - 10.1007/BF01542052 [doi] +PST - ppublish +SO - Arch Sex Behav. 1988 Feb;17(1):57-75. doi: 10.1007/BF01542052.