jacinda 1.0.0.0 → 1.1.0.0
raw patch · 20 files changed
+239/−189 lines, 20 files
Files
- CHANGELOG.md +8/−0
- README.md +2/−0
- app/Main.hs +1/−0
- doc/guide.pdf binary
- examples/avg.jac +1/−1
- examples/mtlCtx.jac +15/−0
- examples/nmCtx.jac +1/−1
- jacinda.cabal +1/−1
- man/ja.1 +3/−1
- src/Jacinda/AST.hs +13/−4
- src/Jacinda/Backend/Normalize.hs +9/−20
- src/Jacinda/Backend/TreeWalk.hs +133/−155
- src/Jacinda/File.hs +22/−2
- src/Jacinda/Lexer.x +6/−0
- src/Jacinda/Parser.y +8/−0
- src/Jacinda/Regex.hs +1/−1
- src/Jacinda/Rename.hs +1/−0
- src/Jacinda/Ty.hs +10/−0
- test/Spec.hs +3/−1
- test/examples/awkBook1.jac +1/−2
CHANGELOG.md view
@@ -1,3 +1,11 @@+# 1.1.0.0++ * Add builtin for last field+ * Performance improvements+ * Fix bug in how fields were split+ * `:` works on column literals+ * Add `#*` (list length) builtin+ # 1.0.0.0 * Generalize type of `\.` (prior)
README.md view
@@ -7,6 +7,8 @@ There are binaries for some platforms on the [releases page](https://github.com/vmchale/jacinda/releases/). +If you are on Mac, you will need to install `*-librure.dylib` as well.+ ## From Source First, install [Rust's regex library](https://github.com/rust-lang/regex/tree/master/regex-capi#c-api-for-rusts-regex-engine). You'll need to put `librure.so` or `librure.dylib` etc. in the appropriate place.
app/Main.hs view
@@ -26,6 +26,7 @@ <> metavar "REGEXP" <> help "Field separator") +-- FIXME: this seems to mishandle iota on the command-line.. jacExpr :: Parser BSL.ByteString jacExpr = argument str (metavar "EXPR"
doc/guide.pdf view
binary file changed (197938 → 197934 bytes)
examples/avg.jac view
@@ -1,4 +1,4 @@ let- val tot := (+)|0.0 $1:f+ val tot := (+)|0.0 $1: val n := (+)|0.0 [:1.0"$0 in tot%n end
+ examples/mtlCtx.jac view
@@ -0,0 +1,15 @@+{. finds any line matching /MonadState/ or /MonadError/ without+{. an INLINABLE pragma on the preceding line++@include'lib/maybe.jac'++fn step(ctx, line) :=+ let+ val fpCtx ≔ line ~ /\{-#.*INLINABLE.*#-\}/+ val mLine ≔+ if (ctx->1) || line !~ /:.*Monad(State|Error)/+ then None+ else Some line+ in (fpCtx.mLine) end;++(->2):?step^(#f.None)$0
examples/nmCtx.jac view
@@ -9,7 +9,7 @@ else None; fn step(ctx, line) :=- let + let val fpCtx := line ~* 1 /(.*\.o):$/ val mSym := line ~* 1 /^[0-0a-f]{16}.{3}(.*)/ in (alternative (ctx->1) fpCtx.mSym) end;
jacinda.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: jacinda-version: 1.0.0.0+version: 1.1.0.0 license: AGPL-3 license-file: COPYING maintainer: vamchale@gmail.com
man/ja.1 view
@@ -1,4 +1,4 @@-.\" Automatically generated by Pandoc 2.17.1.1+.\" Automatically generated by Pandoc 2.18 .\" .\" Define V font for inline verbatim, using C font in formats .\" that render this, and otherwise B font.@@ -151,6 +151,8 @@ .SS SYNTAX .PP \f[B]\[ga]n\f[R] nth field+.PP+\f[B]\[ga]*\f[R] last field .PP \f[B]$n\f[R] nth column .PP
src/Jacinda/AST.hs view
@@ -122,6 +122,7 @@ | Dedup | CatMaybes | Negate+ | TallyList -- length of vector deriving (Eq) instance Pretty BUn where@@ -139,6 +140,7 @@ pretty Dedup = "~." pretty CatMaybes = ".?" pretty Negate = "-."+ pretty TallyList = "#*" -- ternary data BTer = ZipW@@ -232,7 +234,9 @@ data E a = Column { eLoc :: a, col :: Int } | IParseCol { eLoc :: a, col :: Int } -- always a column | FParseCol { eLoc :: a, col :: Int }+ | ParseCol { eLoc :: a, col :: Int } | Field { eLoc :: a, eField :: Int }+ | LastField { eLoc :: a } | AllField { eLoc :: a } -- ^ Think @$0@ in awk. | AllColumn { eLoc :: a } -- ^ Think @$0@ in awk. | EApp { eLoc :: a, eApp0 :: E a, eApp1 :: E a }@@ -241,11 +245,11 @@ | Let { eLoc :: a, eBind :: (Name a, E a), eE :: E a } -- TODO: literals type (make pattern matching easier down the road) | Var { eLoc :: a, eVar :: Name a }- | IntLit { eLoc :: a, eInt :: Integer }- | BoolLit { eLoc :: a, eBool :: Bool }+ | IntLit { eLoc :: a, eInt :: !Integer }+ | BoolLit { eLoc :: a, eBool :: !Bool } | StrLit { eLoc :: a, eStr :: BS.ByteString } | RegexLit { eLoc :: a, eRr :: BS.ByteString }- | FloatLit { eLoc :: a, eFloat :: Double }+ | FloatLit { eLoc :: a, eFloat :: !Double } | Lam { eLoc :: a, eBound :: Name a, lamE :: E a } | Dfn { eLoc :: a, eDfn :: E a } -- to be rewritten as a lambda... -- TODO: builtin sum type ? (makes pattern matching easier down the road)@@ -272,7 +276,9 @@ data EF a x = ColumnF a Int | IParseColF a Int | FParseColF a Int+ | ParseColF a Int | FieldF a Int+ | LastFieldF a | AllFieldF a | AllColumnF a | EAppF a x x@@ -314,8 +320,10 @@ pretty AllColumn{} = "$0" pretty (IParseCol _ i) = "$" <> pretty i <> ":i" pretty (FParseCol _ i) = "$" <> pretty i <> ":f"+ pretty (ParseCol _ i) = "$" <> pretty i <> ":" pretty AllField{} = "`0" pretty (Field _ i) = "`" <> pretty i+ pretty LastField{} = "`*" pretty (EApp _ (EApp _ (BBuiltin _ Prior) e) e') = pretty e <> "\\." <+> pretty e' pretty (EApp _ (EApp _ (BBuiltin _ Max) e) e') = "max" <+> pretty e <+> pretty e' pretty (EApp _ (EApp _ (BBuiltin _ Min) e) e') = "min" <+> pretty e <+> pretty e'@@ -356,7 +364,7 @@ pretty (Guarded _ p e) = braces (pretty p) <> braces (pretty e) pretty (Implicit _ e) = braces ("|" <+> pretty e) pretty (NBuiltin _ n) = pretty n- pretty RegexCompiled{} = error "Nonsense."+ pretty RegexCompiled{} = "(compiled regex)" pretty (Let _ (n, b) e) = "let" <+> "val" <+> pretty n <+> ":=" <+> pretty b <+> "in" <+> pretty e <+> "end" pretty (Paren _ e) = parens (pretty e) pretty (Arr _ es) = tupledByFunky "," (V.toList $ pretty <$> es)@@ -374,6 +382,7 @@ (==) (IParseCol _ i) (IParseCol _ j) = i == j (==) (FParseCol _ i) (FParseCol _ j) = i == j (==) (Field _ i) (Field _ j) = i == j+ (==) LastField{} LastField{} = True (==) AllColumn{} AllColumn{} = True (==) AllField{} AllField{} = True (==) (EApp _ e0 e1) (EApp _ e0' e1') = e0 == e0' && e1 == e1'
src/Jacinda/Backend/Normalize.hs view
@@ -1,8 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module Jacinda.Backend.Normalize ( compileR- , compileIn- , eClosed+module Jacinda.Backend.Normalize ( eClosed , closedProgram , readDigits , readFloat@@ -21,7 +19,6 @@ import Control.Exception (Exception, throw) import Control.Monad.State.Strict (State, evalState, gets, modify, runState)-import Control.Recursion (cata, embed) import Data.Bifunctor (second) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as ASCII@@ -83,22 +80,6 @@ readFloat :: BS.ByteString -> Double readFloat = read . ASCII.unpack --- TODO: do this on all expressions?--- fill in regex with compiled.-compileR :: E a- -> E a-compileR = cata a where -- TODO: combine with eNorm pass?- a (RegexLitF _ rr) = RegexCompiled (compileDefault rr)- a x = embed x- -- TODO: is cata performant enough?--compileIn :: Program a -> Program a-compileIn (Program ds e) = Program (compileD <$> ds) (compileR e)--compileD :: D a -> D a-compileD d@SetFS{} = d-compileD (FunDecl n l e) = FunDecl n l (compileR e)- desugar :: a desugar = error "Should have been desugared by this stage." @@ -184,7 +165,9 @@ eNorm e@AllColumn{} = pure e eNorm e@IParseCol{} = pure e eNorm e@FParseCol{} = pure e+eNorm e@ParseCol{} = pure e eNorm e@AllField{} = pure e+eNorm e@LastField{} = pure e eNorm (Guarded ty pe e) = Guarded ty <$> eNorm pe <*> eNorm e eNorm (Implicit ty e) = Implicit ty <$> eNorm e eNorm (Lam ty n e) = Lam ty n <$> eNorm e@@ -289,6 +272,11 @@ pure $ case eI of StrLit _ str -> IntLit tyI (fromIntegral $ BS.length str) _ -> EApp ty (UBuiltin ty' Tally) eI+eNorm (EApp ty op@(UBuiltin _ TallyList) e) = do+ eI <- eNorm e+ pure $ case eI of+ (Arr _ xs) -> mkI $ fromIntegral $ V.length xs+ _ -> EApp ty op eI eNorm (EApp ty (EApp ty' op@(BBuiltin _ Lt) e) e') = do eI <- eNorm e eI' <- eNorm e'@@ -511,3 +499,4 @@ BoolLit _ True -> eNorm e0 BoolLit _ False -> eNorm e1 _ -> Cond ty p' <$> eNorm e0 <*> eNorm e1 -- needed to perform substitutions+eNorm e = error ("Internal error: " ++ show e)
src/Jacinda/Backend/TreeWalk.hs view
@@ -35,11 +35,9 @@ | InternalError deriving (Show) -type FileBS = BS.ByteString- instance Exception StreamError where -(!) :: V.Vector a -> Int -> a+(!) :: Show a => V.Vector a -> Int -> a v ! ix = case v V.!? ix of Just x -> x Nothing -> throw $ IndexOutOfBounds ix@@ -80,16 +78,11 @@ -- TODO: do I want to interleave state w/ eNorm or w/e -withFp :: FileBS -> E (T K) -> E (T K)-withFp fp = cata a where- a (NBuiltinF _ Fp) = mkStr fp- a x = embed x- -- eval-eEval :: (FileBS, Int, BS.ByteString, V.Vector BS.ByteString) -- ^ Field context (for that line)+eEval :: (Int, BS.ByteString, V.Vector BS.ByteString) -- ^ Field context (for that line) -> E (T K) -> E (T K)-eEval (fp, ix, line, ctx) = go where+eEval (ix, line, ctx) = go where go b@BoolLit{} = b go i@IntLit{} = i go f@FloatLit{} = f@@ -102,13 +95,13 @@ go (NBuiltin _ Nf) = mkI (fromIntegral $ V.length ctx) go (EApp ty op@BBuiltin{} e) = EApp ty op (go e) go (NBuiltin _ Ix) = mkI (fromIntegral ix)- go (NBuiltin _ Fp) = mkStr fp go (NBuiltin _ None) = OptionVal undefined Nothing go (EApp ty (UBuiltin _ Some) e) = let eI = go e in OptionVal ty (Just eI) go AllField{} = StrLit tyStr line go (Field _ i) = StrLit tyStr (ctx ! (i-1)) -- cause vector indexing starts at 0+ go LastField{} = StrLit tyStr (V.last ctx) go (EApp _ (UBuiltin _ IParse) e) = let eI = asStr (go e) in parseAsEInt eI@@ -274,12 +267,12 @@ let str = asStr (go e) re = asRegex (go e') bss = splitBy re str- in Arr undefined (StrLit undefined <$> bss)+ in Arr undefined (mkStr <$> bss) go (EApp _ (EApp _ (BBuiltin _ Splitc) e) e') = let str = asStr (go e) c = the (asStr (go e')) bss = BS.split c str- in Arr undefined (StrLit undefined <$> V.fromList bss)+ in Arr undefined (mkStr <$> V.fromList bss) go (EApp _ (EApp _ (EApp _ (TBuiltin _ Substr) e0) e1) e2) = let eI0 = asStr (go e0) eI1 = asInt (go e1)@@ -359,6 +352,10 @@ go (Cond _ p e0 e1) = let p' = asBool (go p) in if p' then go e0 else go e1+ go (EApp _ (UBuiltin _ TallyList) e) =+ let xs = asArr (go e)+ in mkI $ fromIntegral $ V.length xs+ go e = error ("Internal error: " ++ show e) -- just shove some big number into the renamer and hope it doesn't clash (bad, -- hack, this is why we got kicked out of the garden of Eden)@@ -377,8 +374,8 @@ -> BS.ByteString atField re i = (! (i-1)) . splitBy re -mkCtx :: FileBS -> RurePtr -> Int -> BS.ByteString -> (FileBS, Int, BS.ByteString, V.Vector BS.ByteString)-mkCtx fp re ix line = (fp, ix, line, splitBy re line)+mkCtx :: RurePtr -> Int -> BS.ByteString -> (Int, BS.ByteString, V.Vector BS.ByteString)+mkCtx re ix line = (ix, line, splitBy re line) applyUn :: E (T K) -> E (T K)@@ -389,88 +386,80 @@ _ -> error "Internal error?" -- | Turn an expression representing a stream into a stream of expressions (using line as context)-ir :: FileBS- -> RurePtr+ir :: RurePtr -> E (T K) -> [BS.ByteString] -> [E (T K)] -- TODO: include chunks/context too?-ir _ _ AllColumn{} = fmap mkStr-ir _ re (Column _ i) = fmap (mkStr . atField re i)-ir _ re (IParseCol _ i) = fmap (parseAsEInt . atField re i)-ir _ re (FParseCol _ i) = fmap (parseAsF . atField re i)-ir fp re (Implicit _ e) =- let e' = compileR e- in imap (\ix line -> eEval (mkCtx fp re ix line) e')-ir fp re (Guarded _ pe e) =- let pe' = compileR pe- e' = compileR e+ir _ AllColumn{} = fmap mkStr+ir re (Column _ i) = fmap (mkStr . atField re i)+ir re (IParseCol _ i) = fmap (parseAsEInt . atField re i)+ir re (FParseCol _ i) = fmap (parseAsF . atField re i)+ir re (ParseCol ty@(TyApp _ _ (TyB _ TyFloat)) i) = ir re (FParseCol ty i)+ir re (ParseCol ty@(TyApp _ _ (TyB _ TyInteger)) i) = ir re (IParseCol ty i)+ir re (Implicit _ e) =+ imap (\ix line -> eEval (mkCtx re ix line) e)+ir re (Guarded _ pe e) = -- TODO: normalize before stream- in fmap (uncurry (\ix line -> eEval (mkCtx fp re ix line) e')) . ifilter' (\ix line -> asBool (eEval (mkCtx fp re ix line) pe'))-ir fp re (EApp _ (EApp _ (BBuiltin _ Map) op) stream) = let op' = compileR (withFp fp op) in fmap (applyUn op') . ir fp re stream-ir fp re (EApp _ (EApp _ (BBuiltin _ Filter) op) stream) =- let op' = compileR (withFp fp op)- in filter (asBool . applyUn op') . ir fp re stream-ir fp re (EApp _ (EApp _ (BBuiltin _ MapMaybe) op) stream) =- let op' = compileR (withFp fp op)- in mapMaybe (asOpt . applyUn op') . ir fp re stream-ir fp re (EApp _ (UBuiltin _ CatMaybes) stream) =- mapMaybe asOpt . ir fp re stream-ir fp re (EApp _ (EApp _ (BBuiltin _ Prior) op) stream) = prior (applyOp (withFp fp (compileR op))) . ir fp re stream-ir fp re (EApp _ (EApp _ (EApp _ (TBuiltin _ ZipW) op) streaml) streamr) = \lineStream ->+ fmap (uncurry (\ix line -> eEval (mkCtx re ix line) e)) . ifilter' (\ix line -> asBool (eEval (mkCtx re ix line) pe))+ir re (EApp _ (EApp _ (BBuiltin _ Map) op) stream) = fmap (applyUn op) . ir re stream+ir re (EApp _ (EApp _ (BBuiltin _ Filter) op) stream) =+ filter (asBool . applyUn op) . ir re stream+ir re (EApp _ (EApp _ (BBuiltin _ MapMaybe) op) stream) =+ mapMaybe (asOpt . applyUn op) . ir re stream+ir re (EApp _ (UBuiltin _ CatMaybes) stream) =+ mapMaybe asOpt . ir re stream+ir re (EApp _ (EApp _ (BBuiltin _ Prior) op) stream) = prior (applyOp op) . ir re stream+ir re (EApp _ (EApp _ (EApp _ (TBuiltin _ ZipW) op) streaml) streamr) = \lineStream -> let- irl = ir fp re streaml lineStream- irr = ir fp re streamr lineStream- in zipWith (applyOp (withFp fp (compileR op))) irl irr-ir fp re (EApp _ (EApp _ (EApp _ (TBuiltin _ Scan) op) seed) xs) =- scanl' (applyOp (withFp fp (compileR op))) seed . ir fp re xs-ir fp re (EApp _ (UBuiltin (TyArr _ (TyApp _ _ (TyB _ TyStr)) _) Dedup) e) =- nubOrdOn asStr . ir fp re e-ir fp re (EApp _ (UBuiltin (TyArr _ (TyApp _ _ (TyB _ TyInteger)) _) Dedup) e) =- nubIntOn (fromIntegral . asInt) . ir fp re e-ir fp re (EApp _ (UBuiltin (TyArr _ (TyApp _ _ (TyB _ TyFloat)) _) Dedup) e) =- nubIntOn (fromEnum . asFloat) . ir fp re e-ir fp re (EApp _ (UBuiltin (TyArr _ (TyApp _ _ (TyB _ TyBool)) _) Dedup) e) =- nubIntOn (fromEnum . asBool) . ir fp re e+ irl = ir re streaml lineStream+ irr = ir re streamr lineStream+ in zipWith (applyOp op) irl irr+ir re (EApp _ (EApp _ (EApp _ (TBuiltin _ Scan) op) seed) xs) =+ scanl' (applyOp op) seed . ir re xs+ir re (EApp _ (UBuiltin (TyArr _ (TyApp _ _ (TyB _ TyStr)) _) Dedup) e) =+ nubOrdOn asStr . ir re e+ir re (EApp _ (UBuiltin (TyArr _ (TyApp _ _ (TyB _ TyInteger)) _) Dedup) e) =+ nubIntOn (fromIntegral . asInt) . ir re e+ir re (EApp _ (UBuiltin (TyArr _ (TyApp _ _ (TyB _ TyFloat)) _) Dedup) e) =+ nubIntOn (fromEnum . asFloat) . ir re e+ir re (EApp _ (UBuiltin (TyArr _ (TyApp _ _ (TyB _ TyBool)) _) Dedup) e) =+ nubIntOn (fromEnum . asBool) . ir re e -- | Output stream that prints each entry (expression) printStream :: [E (T K)] -> IO () printStream = traverse_ print -foldWithCtx :: FileBS- -> RurePtr+foldWithCtx :: RurePtr -> E (T K) -> E (T K) -> E (T K) -> [BS.ByteString] -> E (T K)-foldWithCtx fp re op seed streamExpr = foldl' (applyOp $ withFp fp (compileR op)) seed . ir fp re streamExpr+foldWithCtx re op seed streamExpr = foldl' (applyOp op) seed . ir re streamExpr -fold1 :: FileBS- -> RurePtr+fold1 :: RurePtr -> E (T K) -> E (T K) -> [BS.ByteString] -> E (T K)-fold1 fp re op streamExpr bs =- case ir fp re streamExpr bs of+fold1 re op streamExpr bs =+ case ir re streamExpr bs of e:es -> foldl' (applyOp op) e es _ -> throw EmptyFold -runJac :: FileBS- -> RurePtr -- ^ Record separator+runJac :: RurePtr -- ^ Record separator -> Int -> Program (T K) -> Either StreamError ([BS.ByteString] -> IO ())-runJac fp re i e = fileProcessor fp re (closedProgram i e)+runJac re i e = fileProcessor re (closedProgram i e) -foldAll :: FileBS- -> RurePtr+foldAll :: RurePtr -> [(Int, E (T K), E (T K), E (T K))] -> [BS.ByteString] -> [(Int, E (T K))]-foldAll fp re foldExprs bs = evalAll seeds (mkStreams streamExprs) where+foldAll re foldExprs bs = evalAll seeds (mkStreams streamExprs) where (is, ops, seeds, streamExprs) = unzip4 foldExprs- mkStreams = fmap (\streamExpr -> ir fp re streamExpr bs)+ mkStreams = fmap (\streamExpr -> ir re streamExpr bs) evalAll seedsϵ ess | not (any null ess) = let es' = zipWith3 applyOp' ops seedsϵ (headMaybe <$> ess) in es' `seqAll` evalAll es' (tail' <$> ess) -- if I try to use the (all null ess) criterion it space@@ -514,103 +503,92 @@ mkFoldVar :: Int -> b -> E b mkFoldVar i l = Var l (Name "fold_placeholder" (Unique i) l) -gatherFoldsM :: FileBS -> E (T K) -> State (Int, [(Int, E (T K), E (T K), E (T K))]) (E (T K))-gatherFoldsM fp (EApp _ (EApp _ (EApp _ (TBuiltin (TyArr _ _ (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyStream) _) _))) Fold) op) seed) stream) = do+gatherFoldsM :: E (T K) -> State (Int, [(Int, E (T K), E (T K), E (T K))]) (E (T K))+gatherFoldsM (EApp _ (EApp _ (EApp _ (TBuiltin (TyArr _ _ (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyStream) _) _))) Fold) op) seed) stream) = do (i,_) <- get- modify (bimap (+1) ((i, withFp fp (compileR op), seed, stream) :))+ modify (bimap (+1) ((i, op, seed, stream) :)) pure $ mkFoldVar i undefined-gatherFoldsM fp (EApp ty e0 e1) = EApp ty <$> gatherFoldsM fp e0 <*> gatherFoldsM fp e1-gatherFoldsM fp (Tup ty es) = Tup ty <$> traverse (gatherFoldsM fp) es-gatherFoldsM fp (Arr ty es) = Arr ty <$> traverse (gatherFoldsM fp) es-gatherFoldsM fp (OptionVal ty e) = OptionVal ty <$> traverse (gatherFoldsM fp) e-gatherFoldsM fp (Cond ty p e e') = Cond ty <$> gatherFoldsM fp p <*> gatherFoldsM fp e <*> gatherFoldsM fp e'-gatherFoldsM fp (NBuiltin _ Fp) = pure $ mkStr fp-gatherFoldsM _ (NBuiltin _ None) = pure $ OptionVal undefined Nothing-gatherFoldsM _ e@BBuiltin{} = pure e-gatherFoldsM _ e@TBuiltin{} = pure e-gatherFoldsM _ e@UBuiltin{} = pure e-gatherFoldsM _ e@NBuiltin{} = pure e-gatherFoldsM _ e@StrLit{} = pure e-gatherFoldsM _ e@FloatLit{} = pure e-gatherFoldsM _ e@IntLit{} = pure e-gatherFoldsM _ e@BoolLit{} = pure e+gatherFoldsM (EApp ty e0 e1) = EApp ty <$> gatherFoldsM e0 <*> gatherFoldsM e1+gatherFoldsM (Tup ty es) = Tup ty <$> traverse gatherFoldsM es+gatherFoldsM (Arr ty es) = Arr ty <$> traverse gatherFoldsM es+gatherFoldsM (OptionVal ty e) = OptionVal ty <$> traverse gatherFoldsM e+gatherFoldsM (Cond ty p e e') = Cond ty <$> gatherFoldsM p <*> gatherFoldsM e <*> gatherFoldsM e'+gatherFoldsM (NBuiltin _ None) = pure $ OptionVal undefined Nothing+gatherFoldsM e@BBuiltin{} = pure e+gatherFoldsM e@TBuiltin{} = pure e+gatherFoldsM e@UBuiltin{} = pure e+gatherFoldsM e@NBuiltin{} = pure e+gatherFoldsM e@StrLit{} = pure e+gatherFoldsM e@FloatLit{} = pure e+gatherFoldsM e@IntLit{} = pure e+gatherFoldsM e@BoolLit{} = pure e --- evaluate something that has a fold nested in it-eWith :: FileBS -> RurePtr -> E (T K) -> [BS.ByteString] -> E (T K)-eWith fp re (EApp _ (EApp _ (EApp _ (TBuiltin (TyArr _ _ (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyStream) _) _))) Fold) op) seed) stream) = foldWithCtx fp re op seed stream-eWith fp re (EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyStream) _) _)) Fold1) op) stream) = fold1 fp re (withFp fp $ compileR op) stream-eWith _ _ e@BBuiltin{} = const e-eWith _ _ e@UBuiltin{} = const e-eWith _ _ e@TBuiltin{} = const e-eWith _ _ e@StrLit{} = const e-eWith _ _ e@FloatLit{} = const e-eWith _ _ e@IntLit{} = const e-eWith _ _ e@BoolLit{} = const e-eWith fp _ (NBuiltin _ Fp) = const (mkStr fp)-eWith fp re e = \bs ->- let (eHoles, (_, folds)) = runState (gatherFoldsM fp e) (0, []) -- 0 state, should contain no vars by now- in eClosed undefined $ ungather (IM.fromList $ foldAll fp re folds bs) eHoles-{--eWith fp re (EApp ty e0 e1) = \bs -> eClosed undefined (EApp ty (eWith fp re e0 bs) (eWith fp re e1 bs)) -}-{--eWith fp re (Tup ty es) = \bs -> Tup ty ((\e -> eWith fp re e bs) <$> es)-eWith fp re (OptionVal ty e) = \bs -> OptionVal ty ((\eϵ -> eWith fp re eϵ bs) <$> e)-eWith fp re (Cond ty p e e') = \bs -> eClosed undefined (Cond ty (eWith fp re p bs) (eWith fp re e bs) (eWith fp re e' bs))--}+eWith :: RurePtr -> E (T K) -> [BS.ByteString] -> E (T K)+eWith re (EApp _ (EApp _ (EApp _ (TBuiltin (TyArr _ _ (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyStream) _) _))) Fold) op) seed) stream) = foldWithCtx re op seed stream+eWith re (EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyStream) _) _)) Fold1) op) stream) = fold1 re op stream+eWith _ e@BBuiltin{} = const e+eWith _ e@UBuiltin{} = const e+eWith _ e@TBuiltin{} = const e+eWith _ e@StrLit{} = const e+eWith _ e@FloatLit{} = const e+eWith _ e@IntLit{} = const e+eWith _ e@BoolLit{} = const e+eWith re e = \bs ->+ let (eHoles, (_, folds)) = runState (gatherFoldsM e) (0, []) -- 0 state, should contain no vars by now+ in eClosed undefined $ ungather (IM.fromList $ foldAll re folds bs) eHoles takeConcatMap :: (a -> [b]) -> [a] -> [b] takeConcatMap f = concat . transpose . fmap f -- | Given an expression, turn it into a function which will process the file.-fileProcessor :: FileBS- -> RurePtr+fileProcessor :: RurePtr -> E (T K) -> Either StreamError ([BS.ByteString] -> IO ())-fileProcessor _ _ AllField{} = Left NakedField-fileProcessor _ _ Field{} = Left NakedField-fileProcessor _ _ (NBuiltin _ Ix) = Left NakedField-fileProcessor _ _ AllColumn{} = Right $ \inp ->- printStream $ fmap mkStr inp-fileProcessor _ re (Column _ i) = Right $ \inp -> do- printStream $ fmap (mkStr . atField re i) inp-fileProcessor _ re (IParseCol _ i) = Right $ \inp -> do- printStream $ fmap (parseAsEInt . atField re i) inp-fileProcessor _ re (FParseCol _ i) = Right $ \inp -> do- printStream $ fmap (parseAsF . atField re i) inp-fileProcessor fp re e@Guarded{} = Right $ \inp ->- printStream $ ir fp re e inp-fileProcessor fp re e@Implicit{} = Right $ \inp ->- printStream $ ir fp re e inp-fileProcessor fp re e@(EApp _ (EApp _ (BBuiltin _ Filter) _) _) = Right $ \inp ->- printStream $ ir fp re e inp+fileProcessor _ AllField{} = Left NakedField+fileProcessor _ Field{} = Left NakedField+fileProcessor _ (NBuiltin _ Ix) = Left NakedField+fileProcessor re e@AllColumn{} = Right $ \inp ->+ printStream $ ir re e inp+fileProcessor re e@Column{} = Right $ \inp ->+ printStream $ ir re e inp+fileProcessor re e@IParseCol{} = Right $ \inp ->+ printStream $ ir re e inp+fileProcessor re e@FParseCol{} = Right $ \inp ->+ printStream $ ir re e inp+fileProcessor re e@ParseCol{} = Right $ \inp -> printStream $ ir re e inp+fileProcessor re e@Guarded{} = Right $ \inp ->+ printStream $ ir re e inp+fileProcessor re e@Implicit{} = Right $ \inp ->+ printStream $ ir re e inp+fileProcessor re e@(EApp _ (EApp _ (BBuiltin _ Filter) _) _) = Right $ \inp ->+ printStream $ ir re e inp -- at the moment, catMaybes only works on streams-fileProcessor fp re e@(EApp _ (UBuiltin _ CatMaybes) _) = Right $ \inp ->- printStream $ ir fp re e inp-fileProcessor fp re e@(EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ _ (TyApp _ (TyB _ TyStream) _))) Map) _) _) = Right $ \inp ->- printStream $ ir fp re e inp-fileProcessor fp re e@(EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ _ (TyApp _ (TyB _ TyStream) _))) MapMaybe) _) _) = Right $ \inp ->- printStream $ ir fp re e inp-fileProcessor fp re e@(EApp _ (EApp _ (BBuiltin _ Prior) _) _) = Right $ \inp ->- printStream $ ir fp re e inp-fileProcessor fp re e@(EApp _ (EApp _ (EApp _ (TBuiltin _ Scan) _) _) _) = Right $ \inp ->- printStream $ ir fp re e inp-fileProcessor fp re e@(EApp _ (EApp _ (EApp _ (TBuiltin _ ZipW) _) _) _) = Right $ \inp ->- printStream $ ir fp re e inp-fileProcessor fp re e@(EApp _ (UBuiltin _ Dedup) _) = Right $ \inp ->- printStream $ ir fp re e inp-fileProcessor fp re (Anchor _ es) = Right $ \inp ->- printStream $ takeConcatMap (\e -> ir fp re e inp) es-fileProcessor _ _ Var{} = error "Internal error?"-fileProcessor _ _ e@IntLit{} = Right $ const (print e)-fileProcessor _ _ e@BoolLit{} = Right $ const (print e)-fileProcessor _ _ e@StrLit{} = Right $ const (print e)-fileProcessor _ _ e@FloatLit{} = Right $ const (print e)-fileProcessor _ _ e@RegexLit{} = Right $ const (print e)-fileProcessor fp _ (NBuiltin _ Fp) = Right $ const (print fp)-fileProcessor _ _ Lam{} = Left UnevalFun-fileProcessor _ _ Dfn{} = badSugar-fileProcessor _ _ ResVar{} = badSugar-fileProcessor _ _ BBuiltin{} = Left UnevalFun-fileProcessor _ _ UBuiltin{} = Left UnevalFun-fileProcessor _ _ TBuiltin{} = Left UnevalFun-fileProcessor fp re e = Right $ print . eWith fp re e+fileProcessor re e@(EApp _ (UBuiltin _ CatMaybes) _) = Right $ \inp ->+ printStream $ ir re e inp+fileProcessor re e@(EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ _ (TyApp _ (TyB _ TyStream) _))) Map) _) _) = Right $ \inp ->+ printStream $ ir re e inp+fileProcessor re e@(EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ _ (TyApp _ (TyB _ TyStream) _))) MapMaybe) _) _) = Right $ \inp ->+ printStream $ ir re e inp+fileProcessor re e@(EApp _ (EApp _ (BBuiltin _ Prior) _) _) = Right $ \inp ->+ printStream $ ir re e inp+fileProcessor re e@(EApp _ (EApp _ (EApp _ (TBuiltin _ Scan) _) _) _) = Right $ \inp ->+ printStream $ ir re e inp+fileProcessor re e@(EApp _ (EApp _ (EApp _ (TBuiltin _ ZipW) _) _) _) = Right $ \inp ->+ printStream $ ir re e inp+fileProcessor re e@(EApp _ (UBuiltin _ Dedup) _) = Right $ \inp ->+ printStream $ ir re e inp+fileProcessor re (Anchor _ es) = Right $ \inp ->+ printStream $ takeConcatMap (\e -> ir re e inp) es+fileProcessor _ Var{} = error "Internal error?"+fileProcessor _ e@IntLit{} = Right $ const (print e)+fileProcessor _ e@BoolLit{} = Right $ const (print e)+fileProcessor _ e@StrLit{} = Right $ const (print e)+fileProcessor _ e@FloatLit{} = Right $ const (print e)+fileProcessor _ e@RegexLit{} = Right $ const (print e)+fileProcessor _ Lam{} = Left UnevalFun+fileProcessor _ Dfn{} = badSugar+fileProcessor _ ResVar{} = badSugar+fileProcessor _ BBuiltin{} = Left UnevalFun+fileProcessor _ UBuiltin{} = Left UnevalFun+fileProcessor _ TBuiltin{} = Left UnevalFun+fileProcessor re e = Right $ print . eWith re e
src/Jacinda/File.hs view
@@ -10,6 +10,7 @@ import Control.Monad ((<=<)) import Control.Monad.IO.Class (liftIO) import Control.Monad.State.Strict (StateT, get, put, runStateT)+import Control.Recursion (cata, embed) import Data.Bifunctor (second) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as ASCII@@ -58,13 +59,32 @@ parseWithMax' :: BSL.ByteString -> Either (ParseError AlexPosn) (Program AlexPosn, Int) parseWithMax' = fmap (uncurry renamePGlobal . second (rewriteProgram . snd)) . parseWithMax +type FileBS = BS.ByteString++-- fill in regex with compiled.+compileR :: FileBS+ -> E (T K)+ -> E (T K)+compileR fp = cata a where+ a (RegexLitF _ rrϵ) = RegexCompiled (compileDefault rrϵ)+ a (NBuiltinF _ Fp) = mkStr fp+ a x = embed x+ -- TODO: is cata performant enough?++compileIn :: FileBS -> Program (T K) -> Program (T K)+compileIn fp (Program ds e) = Program (compileD fp <$> ds) (compileR fp e)++compileD :: FileBS -> D (T K) -> D (T K)+compileD _ d@SetFS{} = d+compileD fp (FunDecl n l e) = FunDecl n l (compileR fp e)+ exprEval :: BSL.ByteString -> E (T K) exprEval src = case parseWithMax' src of Left err -> throw err Right (ast, m) -> let (typed, i) = yeet $ runTypeM m (tyProgram ast)- in closedProgram i (compileIn typed)+ in closedProgram i (compileIn undefined typed) compileFS :: Maybe BS.ByteString -> RurePtr compileFS (Just bs) = compileDefault bs@@ -80,7 +100,7 @@ incls' <- defaultIncludes <*> pure incls (ast, m) <- parseEWithMax incls' src (typed, i) <- yeetIO $ runTypeM m (tyProgram ast)- cont <- yeetIO $ runJac (ASCII.pack fp) (compileFS (cliFS <|> getFS ast)) i typed+ cont <- yeetIO $ runJac (compileFS (cliFS <|> getFS ast)) i (compileIn (ASCII.pack fp) typed) cont $ fmap BSL.toStrict (ASCIIL.lines contents) -- see: BSL.split, BSL.splitWith
src/Jacinda/Lexer.x view
@@ -107,6 +107,7 @@ "," { mkSym Comma } "." { mkSym Dot } "#" { mkSym TallyTok }+ "#*" { mkSym LengthTok } "[:" { mkSym ConstTok } "!" { mkSym Exclamation } ":" { mkSym Colon }@@ -121,6 +122,7 @@ ":?" { mkSym MapMaybeTok } "~*" { mkSym CapTok } "-." { mkSym NegTok }+ "`*" { mkSym LastFieldTok } in { mkKw KwIn } let { mkKw KwLet }@@ -273,6 +275,7 @@ | Comma | Dot | TallyTok+ | LengthTok | ConstTok | LBracePercent | LBraceBar@@ -288,6 +291,7 @@ | MapMaybeTok | CapTok | NegTok+ | LastFieldTok instance Pretty Sym where pretty PlusTok = "+"@@ -320,6 +324,7 @@ pretty Comma = "," pretty Dot = "." pretty TallyTok = "#"+ pretty LengthTok = "#*" pretty Quot = "\"" pretty Caret = "^" pretty ConstTok = "[:"@@ -336,6 +341,7 @@ pretty MapMaybeTok = ":?" pretty CapTok = "~*" pretty NegTok = "-."+ pretty LastFieldTok = "`*" data Keyword = KwLet | KwIn
src/Jacinda/Parser.y view
@@ -53,6 +53,7 @@ lbracePercent { TokSym $$ LBracePercent } lbraceBar { TokSym $$ LBraceBar } tally { TokSym $$ TallyTok }+ tallyL { TokSym $$ LengthTok } const { TokSym $$ ConstTok } filter { TokSym $$ FilterTok } exclamation { TokSym $$ Exclamation }@@ -99,6 +100,7 @@ allField { TokFieldLit $$ 0 } column { $$@(TokStreamLit _ _) } field { $$@(TokFieldLit _ _) }+ lastField { TokSym $$ LastFieldTok } -- TokSym is maybe insensible but whatever let { TokKeyword $$ KwLet } in { TokKeyword $$ KwIn }@@ -218,12 +220,16 @@ | field { Field (loc $1) (ix $1) } | allColumn { AllColumn $1 } | allField { AllField $1 }+ | lastField { LastField $1 } | field iParse { EApp (loc $1) (UBuiltin $2 IParse) (Field (loc $1) (ix $1)) } | field fParse { EApp (loc $1) (UBuiltin $2 FParse) (Field (loc $1) (ix $1)) } | name iParse { EApp (Name.loc $1) (UBuiltin $2 IParse) (Var (Name.loc $1) $1) } | name fParse { EApp (Name.loc $1) (UBuiltin $2 FParse) (Var (Name.loc $1) $1) } | field colon { EApp (loc $1) (UBuiltin $2 Parse) (Field (loc $1) (ix $1)) } | name colon { EApp (Name.loc $1) (UBuiltin $2 Parse) (Var (Name.loc $1) $1) }+ | lastField iParse { EApp $1 (UBuiltin $2 IParse) (LastField $1) }+ | lastField fParse { EApp $1 (UBuiltin $2 FParse) (LastField $1) }+ | lastField colon { EApp $1 (UBuiltin $2 Parse) (LastField $1) } | x colon { EApp $1 (UBuiltin $2 Parse) (ResVar $1 X) } | y colon { EApp $1 (UBuiltin $2 Parse) (ResVar $1 Y) } | x iParse { EApp $1 (UBuiltin $2 IParse) (ResVar $1 X) }@@ -232,6 +238,7 @@ | y fParse { EApp $1 (UBuiltin $2 FParse) (ResVar $1 Y) } | column iParse { IParseCol (loc $1) (ix $1) } | column fParse { FParseCol (loc $1) (ix $1) }+ | column colon { ParseCol (loc $1) (ix $1) } | parens(iParse) { UBuiltin $1 IParse } | parens(fParse) { UBuiltin $1 FParse } | parens(colon) { UBuiltin $1 Parse }@@ -251,6 +258,7 @@ | lanchor sepBy(E, dot) rparen { Anchor $1 (reverse $2) } | E E { EApp (eLoc $1) $1 $2 } | tally { UBuiltin $1 Tally }+ | tallyL { UBuiltin $1 TallyList } | const { UBuiltin $1 Const } | exclamation { UBuiltin $1 Not } | lsqbracket E rsqbracket { Dfn $1 $2 }
src/Jacinda/Regex.hs view
@@ -58,12 +58,12 @@ splitBy :: RurePtr -> BS.ByteString -> V.Vector BS.ByteString+splitBy _ "" = mempty splitBy re haystack@(BS.BS fp l) = (\sp -> V.fromList [BS.BS (fp `plusForeignPtr` s) (e-s) | (s, e) <- sp]) 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
src/Jacinda/Rename.hs view
@@ -132,6 +132,7 @@ renameProgram :: Program a -> RenameM (Program a) renameProgram (Program ds e) = Program <$> traverse renameD ds <*> renameE e +{-# INLINABLE renameE #-} renameE :: (HasRenames s, MonadState s m) => E a -> m (E a) renameE (EApp l e e') = EApp l <$> renameE e <*> renameE e' renameE (Tup l es) = Tup l <$> traverse renameE es
src/Jacinda/Ty.hs view
@@ -425,6 +425,7 @@ tyE0 (IParseCol _ i) = pure $ IParseCol (tyStream tyI) i tyE0 (FParseCol _ i) = pure $ FParseCol (tyStream tyF) i tyE0 (Field _ i) = pure $ Field tyStr i+tyE0 (LastField _) = pure $ LastField tyStr tyE0 AllField{} = pure $ AllField tyStr tyE0 AllColumn{} = pure $ AllColumn (tyStream tyStr) tyE0 (NBuiltin _ Ix) = pure $ NBuiltin tyI Ix@@ -456,6 +457,10 @@ tyE0 (UBuiltin _ FParse) = pure $ UBuiltin (tyArr tyStr tyF) FParse tyE0 (UBuiltin _ Floor) = pure $ UBuiltin (tyArr tyF tyI) Floor tyE0 (UBuiltin _ Ceiling) = pure $ UBuiltin (tyArr tyF tyI) Ceiling+tyE0 (UBuiltin _ TallyList) = do+ a <- dummyName "a"+ let a' = var a+ pure $ UBuiltin (tyArr a' tyI) TallyList tyE0 (UBuiltin l Negate) = do a <- dummyName "a" modify (mapClassVars (addC a (IsNum, l)))@@ -468,6 +473,11 @@ tyE0 (NBuiltin _ None) = do a <- dummyName "a" pure $ NBuiltin (tyOpt $ var a) None+tyE0 (ParseCol l i) = do+ a <- dummyName "a"+ let a' = var a+ modify (mapClassVars (addC a (IsParseable, l)))+ pure $ ParseCol (tyStream a') i tyE0 (UBuiltin l Parse) = do a <- dummyName "a" let a' = var a
test/Spec.hs view
@@ -29,6 +29,7 @@ ["drwxr-xr-x","12","vanessa","staff","384","Dec","26","19:43","_darcs"] , splitWhitespaceT " 55 ./src/Jacinda/File.hs" ["55", "./src/Jacinda/File.hs"] , splitWhitespaceT "" []+ , splitWhitespaceT "5" ["5"] , testCase "type of" (tyOfT sumBytes (TyB Star TyInteger)) , testCase "type of" (tyOfT krakRegex (TyApp Star (TyB (KArr Star Star) TyStream) (TyB Star TyStr))) -- stream of str , testCase "type of" (tyOfT krakCol (TyApp Star (TyB (KArr Star Star) TyStream) (TyB Star TyStr))) -- stream of str@@ -41,7 +42,8 @@ , testCase "typechecks dfn" (tyFile "test/examples/ab.jac") , testCase "parses parens" (tyFile "examples/lib.jac") , testCase "typechecks/parses correctly" (tyFile "test/examples/line.jac")- , testCase "split eval" (evalTo "[x+' '+y]|'' split '01-23-1987' /-/" " 01 23 1987")+ , testCase "split eval" (evalTo "[x+' '+y]|> split '01-23-1987' /-/" "01 23 1987")+ , testCase "length eval" (evalTo "#*split '01-23-1987' /-/" "3") , testCase "captureE" (evalTo "'01-23-1987' ~* 3 /(\\d{2})-(\\d{2})-(\\d{4})/" "Some 1987") , testCase "if...then...else" (evalTo "if #t then 0 else 1" "0") ]
test/examples/awkBook1.jac view
@@ -1,2 +1,1 @@-{. TODO: maybe need parseable class?-{`3:i>0}{(`1.`2:f*`3:f)}+{`3:i>0}{(`1.`2:f*`3:)}