jacinda 3.2.0.0 → 3.2.0.1
raw patch · 22 files changed
+177/−164 lines, 22 files
Files
- CHANGELOG.md +6/−0
- README.md +4/−0
- bench/Bench.hs +11/−11
- doc/guide.pdf binary
- examples/tagsex.jac +0/−12
- jacinda.cabal +10/−8
- lib/color.jac +4/−1
- lib/prefixSizes.jac +11/−0
- man/ja.1 +3/−1
- src/A.hs +0/−1
- src/A/E.hs +4/−3
- src/A/I.hs +16/−28
- src/File.hs +46/−39
- src/Include.hs +5/−2
- src/Jacinda/Backend/T.hs +2/−1
- src/L.x +3/−4
- src/Parser.y +5/−6
- src/Parser/Rw.hs +4/−4
- src/R.hs +2/−5
- src/Ty.hs +21/−22
- test/Spec.hs +1/−2
- x/Opt.hs +19/−14
CHANGELOG.md view
@@ -1,3 +1,9 @@+# 3.2.0.1++ * Include file in errors+ * Performance improvements+ * Fix string escaping; `\'` is allowed inside string literals+ # 3.2.0.0 * Add records and accessors (with row types)
README.md view
@@ -9,6 +9,10 @@ If you are on Mac, you will need to install `*-librure.dylib` as well. +## Nix++Jacinda is available as a [Nix package](https://search.nixos.org/packages?channel=unstable&from=0&size=1&type=packages&query=jacinda) (thanks to Lukas Epple, who is the maintainer).+ ## 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.
bench/Bench.hs view
@@ -16,20 +16,20 @@ , bench "exprEval" $ nf exprEval "reintercalate ' ' (split '01-23-1987' /-/)" ] , bgroup "csv"- [ bench "dedup" $ nfIO (silence $ runOnFile [] "~.{ix>1}{`8}" [] CSV "bench/data/food-prices.csv")- , bench "succdiff" $ nfIO (silence $ runOnFile [] "(%)\\. {%/Apple/}{`3:}" [] CSV "bench/data/food-prices.csv")+ [ bench "dedup" $ nfIO (silence $ runOnFile [] "" "~.{ix>1}{`8}" [] CSV "bench/data/food-prices.csv")+ , bench "succdiff" $ nfIO (silence $ runOnFile [] "" "(%)\\. {%/Apple/}{`3:}" [] CSV "bench/data/food-prices.csv") ] , bgroup "stream"- [ bench "path" $ nfIO (silence $ runOnFile [] "{|[x+'\\n'+y]|>`$}" [] (AWK (Just ":") Nothing) "bench/data/PATH")- , bench "RS" $ nfIO (silence $ runOnFile [] "$0" [] (AWK Nothing (Just ":")) "bench/data/PATH")- , bench "runOnFile" $ nfIO (silence $ runOnFile [] "(+)|0 {%/Bloom/}{1}" [] (AWK Nothing Nothing) "bench/data/ulysses.txt")- , bench "runOnFile/wc.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/wc.jac" ; runOnFile [] contents [] (AWK Nothing Nothing) "bench/data/ulysses.txt" })- , bench "runOnFile/span2.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/span2.jac" ; runOnFile [] contents [] (AWK Nothing Nothing) "bench/data/span.txt" })- , bench "sedstream.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/sedstream.jac" ; runOnFile [] contents [] (AWK Nothing Nothing) "bench/data/lines.txt" })- , bench "gnused.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/gnused.jac" ; runOnFile [] contents [] (AWK Nothing Nothing) "bench/data/lines.txt" })+ [ bench "path" $ nfIO (silence $ runOnFile [] "" "{|[x+'\\n'+y]|>`$}" [] (AWK (Just ":") Nothing) "bench/data/PATH")+ , bench "RS" $ nfIO (silence $ runOnFile [] "" "$0" [] (AWK Nothing (Just ":")) "bench/data/PATH")+ , bench "runOnFile" $ nfIO (silence $ runOnFile [] "" "(+)|0 {%/Bloom/}{1}" [] (AWK Nothing Nothing) "bench/data/ulysses.txt")+ , bench "runOnFile/wc.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/wc.jac" ; runOnFile [] "examples/wc.jac" contents [] (AWK Nothing Nothing) "bench/data/ulysses.txt" })+ , bench "runOnFile/span2.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/span2.jac" ; runOnFile [] "examples/span2.jac" contents [] (AWK Nothing Nothing) "bench/data/span.txt" })+ , bench "sedstream.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/sedstream.jac" ; runOnFile [] "examples/sedstream.jac" contents [] (AWK Nothing Nothing) "bench/data/lines.txt" })+ , bench "gnused.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/gnused.jac" ; runOnFile [] "exampes/gnused.jac" contents [] (AWK Nothing Nothing) "bench/data/lines.txt" }) -- , bench "fungnused.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/fungnused.jac" ; runOnFile [] contents (AWK Nothing Nothing) "bench/data/lines.txt" })- , bench "hsLibversionMac.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/hsLibversionMac.jac"; runOnFile [] contents [] (AWK Nothing Nothing) "bench/data/pandoc-mac" })- , bench "sedsmtp.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/sedsmtp.jac" ; runOnFile [] contents [] (AWK Nothing Nothing) "test/examples/data/2.txt" })+ , bench "hsLibversionMac.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/hsLibversionMac.jac"; runOnFile [] "examples/hsLibVersionMac.jac" contents [] (AWK Nothing Nothing) "bench/data/pandoc-mac" })+ , bench "sedsmtp.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/sedsmtp.jac" ; runOnFile [] "examples/sedsmtp.jac" contents [] (AWK Nothing Nothing) "test/examples/data/2.txt" }) ] ]
doc/guide.pdf view
binary file changed (79844 → 94324 bytes)
− 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.2.0.0+version: 3.2.0.1 license: AGPL-3.0-only license-file: COPYING maintainer: vamchale@gmail.com@@ -48,13 +48,13 @@ library jacinda-lib import: warnings exposed-modules:+ File+ A Parser Parser.Rw- A Ty Ty.Const Jacinda.Regex- File hs-source-dirs: src other-modules:@@ -98,16 +98,17 @@ lazy-csv other-extensions:- OverloadedStrings- OverloadedLists DeriveFunctor- FlexibleContexts+ OverloadedStrings DeriveAnyClass DeriveGeneric- TypeFamilies+ DeriveFoldable+ DeriveTraversable+ TupleSections+ OverloadedLists if !flag(cross)- build-tool-depends: alex:alex >=3.5.0.0, happy:happy >=1.17.1+ build-tool-depends: alex:alex >=3.5.0.0, happy:happy >=2.1 executable ja import: warnings@@ -119,6 +120,7 @@ ghc-options: -rtsopts "-with-rtsopts=-A200k -k32k" build-depends: base,+ directory, jacinda-lib, optparse-applicative >=0.14.1.0, text
lib/color.jac view
@@ -15,6 +15,9 @@ fn blue := code '34'; fn magenta := code '35'; fn cyan := code '36';-fn white := code '37'+fn white := code '37'; fn boldred := code '31;1';+fn boldyellow := code '33;1';+fn boldblue := code '34;1';+fn boldmagenta := code '37;1';
+ lib/prefixSizes.jac view
@@ -0,0 +1,11 @@+fn prettyMem(x) :=+ ?x>=1073741824.0+ ;sprintf'%f GB' (x%1073741824.0)+ ;?x>=1048576.0+ ;sprintf'%f MB' (x%1048576.0)+ ;?x>=1024.0+ ;sprintf'%f kB' (x%1024.0)+ ;sprintf'%f b' x;++{. du reports memory in bytes by default+fn duMem(x) := prettyMem(x*1024.0);
man/ja.1 view
@@ -134,7 +134,8 @@ \f[B]\-.\f[R] Unary negate .TP \f[B]sprintf\f[R] Convert an expression to a string using the format string-\f[B]%f\f[R] float \f[B]%i\f[R] integer \f[B]%s\f[R] string+\f[B]%f\f[R] float \f[B]%i\f[R] integer \f[B]%s\f[R] string \f[B]%b\f[R]+boolean .TP \f[B]option\f[R] Option eliminator b \-> (a \-> b) \-> Option a \-> b@@ -237,6 +238,7 @@ \f[B]:flush;\f[R] Flush stdout for every line .SH INFLUENTIAL ENVIRONMENT VARIABLES \f[CR]JAC_PATH\f[R] \- colon\-separated list of directories to search+for imports .SH EXAMPLES .TP [#x>72] #. $0
src/A.hs view
@@ -202,7 +202,6 @@ | Guarded { eLoc :: a, eP, eGuarded :: E a } | Implicit { eLoc :: a, eImplicit :: E a } | Let { eLoc :: a, eBind :: (Nm a, E a), eE :: E a }- -- TODO: literals type (make pattern matching easier down the road) | Var { eLoc :: a, eVar :: !(Nm a) } | F { hole :: !(Nm a) } | Lit { eLoc :: a, lit :: !L }
src/A/E.hs view
@@ -4,9 +4,9 @@ import A import C-import Control.Monad ((<=<))-import Control.Monad.State.Strict (State, state)-import qualified Data.Text as T+import Control.Monad ((<=<))+import Control.Monad.Trans.State.Strict (State, state)+import qualified Data.Text as T import Nm import U @@ -35,6 +35,7 @@ mkLam ts e = do (lam, app) <- unseam ts pure $ lam (app e)+-- fmap (($e).(uncurry (.))) (unseam ts) eta = eM <=< eO
src/A/I.hs view
@@ -1,17 +1,13 @@-{-# LANGUAGE FlexibleContexts #-}- module A.I ( RM, UM, ISt (..)- , ib- , β, lβ- , runI+ , ib, lβ ) where import A import C-import Control.Monad.State.Strict (State, gets, modify, runState, state)-import Data.Bifunctor (second)-import Data.Foldable (traverse_)-import qualified Data.IntMap as IM+import Control.Monad.Trans.State.Strict (State, gets, modify, runState, state)+import Data.Bifunctor (second)+import Data.Foldable (traverse_)+import qualified Data.IntMap as IM import Nm import R import Ty@@ -19,30 +15,25 @@ data ISt a = ISt { renames :: !Renames, binds :: IM.IntMap (E a) } -instance HasRenames (ISt a) where- rename f s = fmap (\x -> s { renames = x }) (f (renames s))+instance HasRenames (ISt a) where rename f s = fmap (\x -> s { renames = x }) (f (renames s)) type RM a = State (ISt a); type UM = State Int -bind :: Nm a -> E a -> ISt a -> ISt a-bind (Nm _ (U u) _) e (ISt r bs) = ISt r (IM.insert u e bs)--bindM :: Nm a -> E a -> RM a ()-bindM n e = modify (bind n e)+bind :: Nm a -> E a -> RM a ()+bind (Nm _ (U u) _) e = modify (\(ISt r bs) -> ISt r (IM.insert u e bs)) runI i = second (max_.renames) . flip runState (ISt (Rs i mempty) mempty) ib :: Int -> Program T -> (E T, Int) ib i = uncurry (flip β).runI i.iP where iP (Program ds e) = traverse_ iD ds *> iE e -β :: Int -> E a -> (E a, Int) β i = runI i.bM.(i `seq`) lβ :: E a -> UM (E a) lβ e = state (`β` e) iD :: D T -> RM T ()-iD (FunDecl n [] e) = do {eI <- iE e; bindM n eI}+iD (FunDecl n [] e) = do {eI <- iE e; bind n eI} iD SetFS{} = pure (); iD SetRS{} = pure (); iD SetAsv = pure (); iD SetUsv = pure (); iD SetCsv = pure () iD SetORS{} = pure (); iD SetOFS{} = pure (); iD FlushDecl{} = pure () iD FunDecl{} = desugar@@ -51,15 +42,14 @@ bM :: E a -> RM a (E a) bM (EApp _ (EApp _ (Lam _ n (Lam _ n' e')) e'') e) = do- eI <- bM e; bindM n' eI- eI'' <- bM e''; bindM n eI''+ eI <- bM e; bind n' eI+ eI'' <- bM e''; bind n eI'' bM e' bM (EApp _ (Lam _ n e') e) = do- eI <- bM e- bindM n eI *> bM e'+ eI <- bM e; bind n eI+ bM e' bM (EApp l e0 e1) = do- e0' <- bM e0- e1' <- bM e1+ e0' <- bM e0; e1' <- bM e1 case e0' of Lam{} -> bM (EApp l e0' e1') _ -> pure (EApp l e0' e1')@@ -69,8 +59,7 @@ Just e' -> rE e' Nothing -> pure e bM (Let l (n, e') e) = do- e'B <- bM e'- eB <- bM e+ e'B <- bM e'; eB <- bM e pure $ Let l (n, e'B) eB bM (Tup l es) = Tup l <$> traverse bM es; bM (Arr l es) = Arr l <$> traverse bM es bM (Rec l es) = Rec l <$> traverse (secondM bM) es@@ -105,8 +94,7 @@ iE (OptionVal t es) = OptionVal t <$> traverse iE es iE (Cond t p e e') = Cond t <$> iE p <*> iE e <*> iE e' iE (Let _ (n, e') e) = do- eI <- iE e'- bindM n eI *> iE e+ eI <- iE e'; bind n eI; iE e iE e@(Var t (Nm _ (U i) _)) = do st <- gets binds case IM.lookup i st of
src/File.hs view
@@ -1,28 +1,28 @@-module File ( tcIO- , tySrc- , runStdin- , runOnFile+{-# LANGUAGE OverloadedStrings #-}++module File ( tcIO, tySrc+ , runStdin, runOnFile , exprEval ) where import A import A.E import A.I-import Control.Applicative ((<|>))-import Control.Exception (Exception, throw, throwIO)-import Control.Monad.IO.Class (liftIO)-import Control.Monad.State.Strict (StateT, get, put, runState, runStateT)-import Data.Bifunctor (second)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as BSL-import qualified Data.ByteString.Lazy.Char8 as ASCIIL-import Data.Foldable (fold, traverse_)-import Data.Functor (($>))-import qualified Data.Text as T-import Data.Text.Encoding (encodeUtf8)-import qualified Data.Text.IO as TIO-import Data.Tuple (swap)-import qualified Data.Vector as V+import Control.Applicative ((<|>))+import Control.Exception (Exception, throw, throwIO)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.State.Strict (StateT, get, put, runState, runStateT)+import Data.Bifunctor (second)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.Char8 as ASCIIL+import Data.Foldable (fold, traverse_)+import Data.Functor (($>))+import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8)+import qualified Data.Text.IO as TIO+import Data.Tuple (swap)+import qualified Data.Vector as V import Include import Jacinda.Backend.Const import Jacinda.Backend.T@@ -31,10 +31,11 @@ import L import Parser import Parser.Rw+import Prettyprinter (Pretty (pretty)) import R-import Regex.Rure (RurePtr)-import System.IO (stdin)-import Text.CSV.Lazy.ByteString (CSVField (..), parseCSV)+import Regex.Rure (RurePtr)+import System.IO (stdin)+import Text.CSV.Lazy.ByteString (CSVField (..), parseCSV) import Ty csvCtx :: BSL.ByteString -> [LineCtx]@@ -55,23 +56,23 @@ contents <- liftIO $ TIO.readFile =<< resolveImport incls fp st <- get case parseLibWithCtx contents st of- Left err -> liftIO (throwIO err)+ Left err -> liftIO (throwIO (FPos fp<$>err)) Right (st', ([], ds)) -> put st' $> (rwD <$> ds) Right (st', (is, ds)) -> do {put st'; dss <- traverse (parseLib incls) is; pure (concat dss ++ fmap rwD ds)} -parseP :: [FilePath] -> T.Text -> [(T.Text, Value)] -> StateT AlexUserState IO (Program AlexPosn)-parseP incls src var = do+parseP :: [FilePath] -> FilePath -> T.Text -> [(T.Text, Value)] -> StateT AlexUserState IO (Program AlexPosn)+parseP incls fn src var = do st <- get case parseWithCtx src var st of- Left err -> liftIO $ throwIO err+ Left err -> liftIO $ throwIO (FPos fn<$>err) Right (st', (is, Program ds e)) -> do put st' dss <- traverse (parseLib incls) is pure $ Program (concat dss ++ fmap rwD ds) (rwE e) -- | Parse + rename-parsePWithMax :: [FilePath] -> T.Text -> [(T.Text, T.Text)] -> IO (Program AlexPosn, Int)-parsePWithMax incls src vars = uncurry rP.swap.second fst3 <$> runStateT (parseP incls src vars) alexInitUserState+parsePWithMax :: [FilePath] -> FilePath -> T.Text -> [(T.Text, T.Text)] -> IO (Program AlexPosn, Int)+parsePWithMax incls fn src vars = uncurry rP.swap.second fst3 <$> runStateT (parseP incls fn src vars) alexInitUserState where fst3 (x,_,_) = x parseWithMax' :: T.Text -> Either (ParseError AlexPosn) (Program AlexPosn, Int)@@ -79,6 +80,10 @@ type FileBS = BS.ByteString +data FPos = FPos { filen :: String, pos :: !AlexPosn }++instance Pretty FPos where pretty (FPos f l) = pretty f <> ":" <> pretty l+ tcompile=compileDefault.encodeUtf8 compileR :: FileBS@@ -138,15 +143,16 @@ runOnBytes :: [FilePath] -> FilePath -- ^ Data file name, for @nf@+ -> FilePath -- ^ For error locations -> T.Text -- ^ Program -> [(T.Text, Value)] -> Mode -> BSL.ByteString -> IO ()-runOnBytes incls fp src vars mode contents = do+runOnBytes incls fp fn src vars mode contents = do incls' <- defaultIncludes <*> pure incls- (ast, m) <- parsePWithMax incls' src vars- (typed, i) <- yIO $ runTyM m (tyP ast)+ (ast, m) <- parsePWithMax incls' fn src vars+ (typed, i) <- yIO fn $ runTyM m (tyP ast) let (eI, j) = ib i typed m'Throw $ cF eI let (e', k) = runState (eta eI) j@@ -163,25 +169,27 @@ (_, CSV) -> let ctxs = csvCtx contents in cont ctxs runStdin :: [FilePath]+ -> FilePath -- ^ For error location -> T.Text -- ^ Program -> [(T.Text, Value)] -> Mode -> IO ()-runStdin is src vars m = runOnBytes is "(stdin)" src vars m =<< BSL.hGetContents stdin+runStdin is src fn vars m = runOnBytes is "(stdin)" src fn vars m =<< BSL.hGetContents stdin runOnFile :: [FilePath]+ -> FilePath -> T.Text -> [(T.Text, Value)] -> Mode -> FilePath -> IO ()-runOnFile is e vs m fp = runOnBytes is fp e vs m =<< BSL.readFile fp+runOnFile is fn e vs m fp = runOnBytes is fp fn e vs m =<< BSL.readFile fp -tcIO :: [FilePath] -> T.Text -> IO ()-tcIO incls src = do+tcIO :: [FilePath] -> FilePath -> T.Text -> IO ()+tcIO incls fn src = do incls' <- defaultIncludes <*> pure incls- (ast, m) <- parsePWithMax incls' src []- (pT, i) <- yIO $ runTyM m (tyP ast)+ (ast, m) <- parsePWithMax incls' fn src []+ (pT, i) <- yIO fn $ runTyM m (tyP ast) let (eI, _) = ib i pT m'Throw $ cF eI @@ -194,8 +202,7 @@ m'Throw :: Exception e => Maybe e -> IO () m'Throw = traverse_ throwIO -yIO :: Exception e => Either e a -> IO a-yIO = either throwIO pure+yIO fp = either (throwIO.(FPos fp<$>)) pure yeet :: Exception e => Either e a -> a yeet = either throw id
src/Include.hs view
@@ -7,7 +7,7 @@ import Data.List.Split (splitWhen) import Data.Maybe (listToMaybe) import Paths_jacinda (getDataDir)-import System.Directory (doesFileExist, getCurrentDirectory)+import System.Directory (doesFileExist, getCurrentDirectory,doesDirectoryExist) import System.Environment (lookupEnv) import System.FilePath ((</>)) @@ -20,7 +20,10 @@ path <- jacPath d <- getDataDir dot <- getCurrentDirectory- pure $ (dot:).(d:).(++path)+ share <- doesDirectoryExist shareDir+ pure $ (if share then (shareDir:) else id).(dot:).(d:).(++path)+ where+ shareDir = "/usr/local/share/jac" jacPath :: IO [FilePath] jacPath = maybe [] splitEnv <$> lookupEnv "JAC_PATH"
src/Jacinda/Backend/T.hs view
@@ -7,7 +7,7 @@ import C import Control.Exception (Exception, throw) import Control.Monad (zipWithM, (<=<))-import Control.Monad.State.Strict (State, evalState, runState, state)+import Control.Monad.Trans.State.Strict (State, evalState, runState, state) import Data.Bifunctor (first, second) import qualified Data.ByteString as BS import Data.ByteString.Builder (hPutBuilder)@@ -99,6 +99,7 @@ pSF _ _ [] = pure () run :: Bool -> Int -> E T -> [LineCtx] -> IO ()+run _ _ e _ | ty@TyArr{} <- eLoc e = error ("Found function type: " ++ show ty) run flush j e ctxs | TyB TyUnit <- eLoc e = (\(s, f, env) -> pSF flush (s,f) env) $ flip evalState j $ do (res, tt, iEnv, μ) <- unit e u <- nI
src/L.x view
@@ -1,4 +1,5 @@ {+ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-} module L ( alexMonadScan , alexInitUserState@@ -221,9 +222,6 @@ { -dropQuotes :: BSL.ByteString -> BSL.ByteString-dropQuotes = BSL.init . BSL.tail- alex :: a -> Alex a alex = pure @@ -242,7 +240,7 @@ -- this is inefficient but w/e escReplace :: T.Text -> T.Text escReplace =- T.replace "\\\"" "\""+ T.replace "\\\'" "\'" . T.replace "\\\\" "\\" . T.replace "\\ESC" "\ESC" . T.replace "\\n" "\n"@@ -485,6 +483,7 @@ | TokAccess { loc :: a, ix :: Int } | TokSelect { loc :: a, field :: Int } | TokR { loc :: a, nfield :: Nm a }+ deriving Functor instance Pretty (Token a) where pretty EOF{} = "(eof)"
src/Parser.y view
@@ -1,4 +1,5 @@ {+ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-} module Parser ( parse , parseWithMax@@ -31,7 +32,7 @@ %name parseLib Library %name pValue Value %tokentype { Token AlexPosn }-%errorhandlertype explist+%error.expected %error { parseError } %monad { Parse } { (>>=) } { pure } %lexer { lift alexMonadScan >>= } { EOF _ }@@ -385,8 +386,8 @@ type Value = T.Text -parseError :: (Token AlexPosn, [String]) -> Parse a-parseError = throwError . uncurry Unexpected+parseError :: Token AlexPosn -> [String] -> Parse a+parseError tok = throwError . Unexpected tok mkLet :: a -> [(Nm a, E a)] -> E a -> E a mkLet _ [] e = e@@ -394,6 +395,7 @@ data ParseError a = Unexpected !(Token a) [String] | LexErr String+ deriving Functor instance Pretty a => Pretty (ParseError a) where pretty (Unexpected tok valid) = pretty (loc tok) <+> "Unexpected" <+> pretty tok <> "." <+> "Expected one of" <+> concatWith (\x y -> x <> "," <+> y) (squotes.pretty<$>valid)@@ -405,9 +407,6 @@ instance (Pretty a, Typeable a) => Exception (ParseError a) type Parse = ExceptT (ParseError AlexPosn) Alex--parseThrow :: Parse a -> T.Text -> a-parseThrow p = snd.either throw id.runParse p guess :: AlexPosn -> T.Text -> E AlexPosn guess l v = case snd<$>runParse pValue v of
src/Parser/Rw.hs view
@@ -81,14 +81,14 @@ rwE e@IParseCol{} = e rwE e@FParseCol{} = e rwE e@ParseCol{} = e-rwE e@Field{} = e-rwE e@LastField{} = e-rwE e@FieldList{} = e-rwE e@AllField{} = e rwE e@AllColumn{} = e rwE e@IParseAllCol{} = e rwE e@FParseAllCol{} = e rwE e@ParseAllCol{} = e+rwE e@Field{} = e+rwE e@LastField{} = e+rwE e@FieldList{} = e+rwE e@AllField{} = e rwE F{} = error "impossible."; rwE RC{} = error "impossible." rwE (Guarded l p e) = Guarded l (rwE p) (rwE e) rwE (Implicit l e) = Implicit l (rwE e)
src/R.hs view
@@ -1,8 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module R ( rE- , rP- , RenameM+module R ( rE, rP , Renames (..) , HasRenames (..) ) where@@ -23,8 +21,7 @@ class HasRenames a where rename :: Lens' a Renames -instance HasRenames Renames where- rename = id+instance HasRenames Renames where rename=id boundLens :: Lens' Renames (IM.IntMap Int) boundLens f s = fmap (\x -> s { bound = x }) (f (bound s))
src/Ty.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-} module Ty ( Subst@@ -8,34 +8,33 @@ ) where import A-import Control.Exception (Exception, throw)-import Control.Monad (zipWithM)-import Control.Monad.Except (liftEither, throwError)-import Control.Monad.State.Strict (StateT, gets, modify, runState, runStateT, state)-import Data.Bifunctor (first, second)-import Data.Foldable (traverse_)-import Data.Function (on)-import Data.Functor (void, ($>))-import qualified Data.IntMap as IM-import qualified Data.IntSet as IS-import Data.List (find)-import qualified Data.Set as S-import qualified Data.Text as T-import Data.Typeable (Typeable)-import qualified Data.Vector as V+import Control.Exception (Exception, throw)+import Control.Monad (zipWithM)+import Control.Monad.Except (liftEither, throwError)+import Control.Monad.Trans.State.Strict (StateT, gets, modify, runState, runStateT, state)+import Data.Bifunctor (first, second)+import Data.Foldable (traverse_)+import Data.Function (on)+import Data.Functor (void, ($>))+import qualified Data.IntMap as IM+import qualified Data.IntSet as IS+import qualified Data.Set as S+import qualified Data.Text as T+import Data.Typeable (Typeable)+import qualified Data.Vector as V import Nm-import qualified Nm.Map as Nm-import Prettyprinter (Pretty (..), squotes, (<+>))+import qualified Nm.Map as Nm+import Prettyprinter (Pretty (..), squotes, (<+>)) import Ty.Const import U -data Err a = UF a T T+data Err a = UF a T T | MF T T | Doesn'tSatisfy a T C | IllScoped a (Nm a) | Ambiguous T (E ()) | IllScopedTyVar (TyName ())- | MF T T | Occ a T T+ deriving Functor instance Pretty a => Pretty (Err a) where pretty (UF l ty ty') = pretty l <+> "could not unify type" <+> squotes (pretty ty) <+> "with" <+> squotes (pretty ty')@@ -141,8 +140,8 @@ | 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 (TyArr t0 t1) (TyArr t0' t1') = do {s0 <- mguPrep l s t0 t0'; mguPrep l s0 t1 t1'}-mgu l s (t0:$t1) (t0':$t1') = do {s0 <- mguPrep l s t0 t0'; mguPrep l s0 t1 t1'}+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' mgu l s (Rho n rs) t'@(TyTup ts) | length ts >= fst (IM.findMax rs) && fst (IM.findMin rs) > 0 = tS_ (\sϵ (i, tϵ) -> IM.insert (unU$unique n) t' <$> mguPrep l sϵ (ts!!(i-1)) tϵ) s (IM.toList rs)
test/Spec.hs view
@@ -3,7 +3,6 @@ module Main (main) where import A-import Control.Monad ((<=<)) import qualified Data.ByteString as BS import Data.Foldable (toList) import Data.Functor (void)@@ -102,7 +101,7 @@ (IParseCol () 5) tyFile :: FilePath -> Assertion-tyFile = tcIO [] <=< TIO.readFile+tyFile fp = tcIO [] fp =<< TIO.readFile fp tyRight :: T.Text -> Assertion tyRight src = assertBool (T.unpack src) (tySrc src `seq` True)
x/Opt.hs view
@@ -4,6 +4,7 @@ import A (Mode (..)) import Control.Applicative ((<|>))+import System.Directory (doesDirectoryExist) import qualified Data.Text as T import qualified Data.Text.IO as TIO import qualified Data.Version as V@@ -30,8 +31,8 @@ <> metavar "VALUE" <> help "Pass a value on the command-line")) -jacFile :: Parser FilePath-jacFile = argument str+j'File :: Parser FilePath+j'File = argument str (metavar "JACFILE" <> help "Source code" <> jacCompletions)@@ -84,13 +85,12 @@ <> command "install-dir" (info (pure Install) (progDesc "Show directory for bundled libraries"))) <|> exprP where- tcP = TC <$> jacFile <*> includes- runP = Run <$> jacFile <*> jacFs <*> jacRs <*> inpFile <*> includes <*> defVar- exprP = Expr <$> jacExpr <*> inpFile <*> jacFs <*> asv <*> usv <*> csv <*> jacRs <*> includes- eP = Eval <$> jacExpr+ tcP = TC <$> j'File <*> incls; eP = Eval <$> jacExpr+ runP = Run <$> j'File <*> jacFs <*> jacRs <*> inpFile <*> incls <*> defVar+ exprP = Expr <$> jacExpr <*> inpFile <*> jacFs <*> asv <*> usv <*> csv <*> jacRs <*> incls -includes :: Parser [FilePath]-includes = many $ strOption+incls :: Parser [FilePath]+incls = many $ strOption (metavar "DIR" <> long "include" <> short 'I'@@ -123,10 +123,15 @@ ap _ _ _ fs rs = AWK fs rs run :: Cmd -> IO ()-run (TC fp is) = tcIO is =<< TIO.readFile fp-run (Run fp fs rs Nothing is vs) = do { contents <- TIO.readFile fp ; runStdin is contents vs (AWK fs rs) }-run (Run fp fs rs (Just dat) is vs) = do { contents <- TIO.readFile fp ; runOnFile is contents vs (AWK fs rs) dat }-run (Expr eb Nothing fs a u c rs is) = let m = ap a u c fs rs in runStdin is eb [] m-run (Expr eb (Just fp) fs a u c rs is) = let m = ap a u c fs rs in runOnFile is eb [] m fp+run (TC fp is) = tcIO is fp =<< TIO.readFile fp+run (Run fp fs rs Nothing is vs) = do { contents <- TIO.readFile fp ; runStdin is fp contents vs (AWK fs rs) }+run (Run fp fs rs (Just dat) is vs) = do { contents <- TIO.readFile fp ; runOnFile is fp contents vs (AWK fs rs) dat }+run (Expr eb Nothing fs a u c rs is) = let m = ap a u c fs rs in runStdin is "(no file info)" eb [] m+run (Expr eb (Just fp) fs a u c rs is) = let m = ap a u c fs rs in runOnFile is "(no file info)" eb [] m fp run (Eval e) = print (exprEval e)-run Install = putStrLn =<< P.getDataDir+run Install = putStrLn =<< getDataDir++getDataDir = do+ cabal <- P.getDataDir+ b <- doesDirectoryExist cabal+ pure $ if b then cabal else "/usr/local/share/jac"