jacinda 0.2.0.0 → 0.2.1.0
raw patch · 14 files changed
+258/−98 lines, 14 files
Files
- CHANGELOG.md +7/−0
- README.md +10/−1
- doc/guide.pdf binary
- jacinda.cabal +13/−5
- man/ja.1 +10/−4
- src/Data/Vector/Ext.hs +7/−0
- src/Jacinda/AST.hs +11/−1
- src/Jacinda/Backend/Normalize.hs +14/−1
- src/Jacinda/Backend/TreeWalk.hs +85/−70
- src/Jacinda/File.hs +7/−5
- src/Jacinda/Lexer.x +22/−7
- src/Jacinda/Parser.y +14/−0
- src/Jacinda/Parser/Rewrite.hs +1/−0
- src/Jacinda/Ty.hs +57/−4
CHANGELOG.md view
@@ -1,3 +1,10 @@+# 0.2.1.0++ * Add `fp` builtin+ * Add `:` unary operator+ * Floor/ceiling operators+ * `Some` and `None` literals+ # 0.2.0.0 * Complete implementation of folds/maps for lists
README.md view
@@ -3,6 +3,10 @@ # Installation +## Releases++There are binaries for some platforms on the [releases page](https://github.com/vmchale/jacinda/releases/).+ ## 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.@@ -13,6 +17,10 @@ cabal install jacinda ``` +## Vim Plugin++There is a [vim plugin](https://github.com/vmchale/jacinda-vim).+ # SHOCK & AWE ```@@ -21,7 +29,7 @@ ``` curl -sL https://raw.githubusercontent.com/nychealth/coronavirus-data/master/latest/now-weekly-breakthrough.csv | \- ja ',[1.0-x%y] {ix>1}{`5:f} {ix>1}{`11:f}' -F,+ ja ',[1.0-x%y] {ix>1}{`5:} {ix>1}{`11:}' -F, ``` # Documentation@@ -52,6 +60,7 @@ * Type system is questionable * Postfix `:f` and `:i` are handled poorly * File imports/includes+ * Various bugs in evaluation with regular expressions Intentionally missing features:
doc/guide.pdf view
binary file changed (181299 → 181573 bytes)
jacinda.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: jacinda-version: 0.2.0.0+version: 0.2.1.0 license: AGPL-3 license-file: COPYING maintainer: vamchale@gmail.com@@ -24,6 +24,11 @@ type: git location: https://github.com/vmchale/jacinda +flag cross+ description: Enable to ease cross-compiling+ default: False+ manual: True+ library jacinda-lib exposed-modules: Jacinda.Parser@@ -34,8 +39,7 @@ Jacinda.Regex Jacinda.File - build-tool-depends: alex:alex, happy:happy- hs-source-dirs: src+ hs-source-dirs: src other-modules: Jacinda.Lexer Intern.Name@@ -45,9 +49,10 @@ Jacinda.Backend.TreeWalk Jacinda.Backend.Printf Data.List.Ext+ Data.Vector.Ext - default-language: Haskell2010- ghc-options: -Wall -O2+ default-language: Haskell2010+ ghc-options: -Wall -O2 build-depends: base >=4.10.0.0 && <5, bytestring >=0.11.0.0,@@ -62,6 +67,9 @@ microlens-mtl, vector, recursion >=1.0.0.0++ if !flag(cross)+ build-tool-depends: alex:alex, happy:happy if impl(ghc >=8.0) ghc-options:
man/ja.1 view
@@ -1,4 +1,4 @@-.\" Automatically generated by Pandoc 2.16.2+.\" Automatically generated by Pandoc 2.17 .\" .TH "ja (1)" "" "" "" "" .hy@@ -42,6 +42,8 @@ .PP \f[B]:f\f[R] Postfix operator: parse float .PP+\f[B]:\f[R] Postfix operator: parse, inferring type+.PP \f[B]#\f[R] Prefix operator: tally (count bytes in string) .TP \f[B],\f[R] Ternary operator: zip with@@ -62,7 +64,7 @@ \f[B]#.\f[R] Binary operator: filter (a -> Bool) -> Stream a -> Stream a .TP-\f[B].\f[R] Binary operator: prior+\f[B]\[rs].\f[R] Binary operator: prior (a -> a -> a) -> Stream a -> Stream a .PP \f[B]max\f[R] Maximum of two values@@ -90,10 +92,10 @@ \f[B]splitc\f[R] Split a string on a single character Str -> Str -> List Str .TP-\f[B]floor\f[R] Floor function+\f[B]|.\f[R] Floor function Float -> Int .TP-\f[B]ceil\f[R] Ceiling function+\f[B]|\[ga]\f[R] Ceiling function Float -> Int .PP \f[B]sprintf\f[R] Convert an expression to a string using the format@@ -105,6 +107,8 @@ \f[B]match\f[R] Str -> Regex -> Option (Int . Int)+.PP+\f[B]fp\f[R] Filename .SS SYNTAX .PP \f[B]\[ga]n\f[R] nth field@@ -127,6 +131,8 @@ List a -> a .PP \f[B]->n\f[R] Get the nth element of a tuple+.PP+\f[B]{.\f[R] Line comment .SH BUGS .PP Please report any bugs you may come across to
+ src/Data/Vector/Ext.hs view
@@ -0,0 +1,7 @@+module Data.Vector.Ext ( priorM_+ ) where++import qualified Data.Vector as V++priorM_ :: Monad m => (a -> a -> m b) -> V.Vector a -> m ()+priorM_ op xs = V.zipWithM_ op (V.tail xs) xs
src/Jacinda/AST.hs view
@@ -87,6 +87,7 @@ pretty (TyVar _ n) = pretty n pretty (TyArr _ ty ty') = pretty ty <+> "⟶" <+> pretty ty' pretty (TyTup _ tys) = jacTup tys+ pretty (TyNamed _ tn) = pretty tn instance Show (T a) where show = show . pretty@@ -99,8 +100,10 @@ | Select Int | IParse | FParse+ | Parse | Floor | Ceiling+ | Some deriving (Eq) instance Pretty BUn where@@ -113,6 +116,8 @@ pretty FParse = ":f" pretty Floor = "floor" pretty Ceiling = "ceil"+ pretty Parse = ":"+ pretty Some = "Some" -- ternary data BTer = ZipW@@ -189,6 +194,8 @@ -- 0-ary data N = Ix+ | None+ | Fp deriving (Eq) -- expression@@ -264,6 +271,8 @@ instance Pretty N where pretty Ix = "ix"+ pretty None = "None"+ pretty Fp = "fp" instance Pretty (E a) where pretty (Column _ i) = "$" <> pretty i@@ -291,6 +300,7 @@ pretty (EApp _ (UBuiltin _ (Select i)) e) = pretty e <> "->" <> pretty i pretty (EApp _ (UBuiltin _ IParse) e') = pretty e' <> ":i" pretty (EApp _ (UBuiltin _ FParse) e') = pretty e' <> ":f"+ pretty (EApp _ (UBuiltin _ Parse) e') = pretty e' <> ":" pretty (EApp _ e@UBuiltin{} e') = pretty e <> pretty e' pretty (EApp _ e e') = pretty e <+> pretty e' pretty (Var _ n) = pretty n@@ -313,7 +323,7 @@ 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)- pretty (OptionVal _ (Just e)) = "Some" <+> pretty e+ pretty (OptionVal _ (Just e)) = "Some" <+> pretty e pretty (OptionVal _ Nothing) = "None" instance Show (E a) where
src/Jacinda/Backend/Normalize.hs view
@@ -169,7 +169,7 @@ eNorm e@BBuiltin{} = pure e eNorm e@TBuiltin{} = pure e eNorm (Tup tys es) = Tup tys <$> traverse eNorm es-eNorm e@(NBuiltin _ Ix) = pure e+eNorm e@NBuiltin{} = pure e eNorm (EApp ty op@BBuiltin{} e) = EApp ty op <$> eNorm e eNorm (EApp ty (EApp ty' op@(BBuiltin _ Matches) e) e') = do eI <- eNorm e@@ -408,6 +408,19 @@ pure $ case eI of (StrLit _ str) -> parseAsF str _ -> EApp ty op eI+eNorm (EApp ty op@(UBuiltin (TyArr _ _ (TyB _ TyFloat)) Parse) e) = do+ eI <- eNorm e+ pure $ case eI of+ (StrLit _ str) -> parseAsF str+ _ -> EApp ty op eI+eNorm (EApp ty op@(UBuiltin (TyArr _ _ (TyB _ TyInteger)) Parse) e) = do+ eI <- eNorm e+ pure $ case eI of+ (StrLit _ str) -> parseAsEInt str+ _ -> EApp ty op eI+eNorm (EApp ty op@(UBuiltin _ Some) e) = do+ eI <- eNorm e+ pure $ OptionVal ty (Just eI) eNorm Dfn{} = desugar eNorm ResVar{} = desugar eNorm (Let _ (Name _ (Unique i) _, b) e) = do
src/Jacinda/Backend/TreeWalk.hs view
@@ -5,6 +5,7 @@ -- TODO: normalize before mapping? import Control.Exception (Exception, throw)+import Control.Recursion (cata, embed) import qualified Data.ByteString as BS import Data.Foldable (foldl', traverse_) import Data.List (scanl')@@ -25,6 +26,8 @@ | IndexOutOfBounds Int deriving (Show) +type FileBS = BS.ByteString+ instance Exception StreamError where (!) :: V.Vector a -> Int -> a@@ -64,11 +67,16 @@ -- 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 :: (Int, BS.ByteString, V.Vector BS.ByteString) -- ^ Field context (for that line)+eEval :: (FileBS, Int, BS.ByteString, V.Vector BS.ByteString) -- ^ Field context (for that line) -> E (T K) -> E (T K)-eEval (ix, line, ctx) = go where+eEval (fp, ix, line, ctx) = go where go b@BoolLit{} = b go i@IntLit{} = i go f@FloatLit{} = f@@ -80,6 +88,7 @@ go op@TBuiltin{} = op go (EApp ty op@BBuiltin{} e) = EApp ty op (go e) go (NBuiltin _ Ix) = mkI (fromIntegral ix)+ go (NBuiltin _ Fp) = mkStr fp go AllField{} = StrLit tyStr line go (Field _ i) = StrLit tyStr (ctx ! (i-1)) -- cause vector indexing starts at 0 go (EApp _ (UBuiltin _ IParse) e) =@@ -88,6 +97,12 @@ go (EApp _ (UBuiltin _ FParse) e) = let eI = asStr (go e) in parseAsF eI+ go (EApp _ (UBuiltin (TyArr _ _ (TyB _ TyInteger)) Parse) e) =+ let eI = asStr (go e)+ in parseAsEInt eI+ go (EApp _ (UBuiltin (TyArr _ _ (TyB _ TyFloat)) Parse) e) =+ let eI = asStr (go e)+ in parseAsF eI go (EApp _ (EApp _ (BBuiltin _ Matches) e) e') = let eI = go e eI' = go e'@@ -261,12 +276,11 @@ applyOp' op e e' = go (EApp undefined (EApp undefined op e) e') go (Arr ty es) = Arr ty (go <$> es) -applyOp :: Int- -> E (T K) -- ^ Operator+applyOp :: E (T K) -- ^ Operator -> E (T K) -> E (T K) -> E (T K)-applyOp i op e e' = eClosed i (EApp undefined (EApp undefined op e) e') -- FIXME: undefined is ??+applyOp op e e' = eClosed undefined (EApp undefined (EApp undefined op e) e') -- FIXME: undefined is ?? atField :: RurePtr -> Int@@ -274,87 +288,88 @@ -> BS.ByteString atField re i = (! (i-1)) . splitBy re -mkCtx :: RurePtr -> Int -> BS.ByteString -> (Int, BS.ByteString, V.Vector BS.ByteString)-mkCtx re ix line = (ix, line, splitBy re line)+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) -applyUn :: Int- -> E (T K)+applyUn :: E (T K) -> E (T K) -> E (T K)-applyUn i unOp e =+applyUn unOp e = case eLoc unOp of- TyArr _ _ res -> eClosed i (EApp res unOp e)+ TyArr _ _ res -> eClosed undefined (EApp res unOp e) _ -> error "Internal error?" -- | Turn an expression representing a stream into a stream of expressions (using line as context)-ir :: RurePtr- -> Int+ir :: FileBS+ -> 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 re _ (Implicit _ e) =+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 re ix line) e')-ir re _ (Guarded _ pe 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 -- FIXME: compile e too? -- TODO: normalize before stream- in imap (\ix line -> eEval (mkCtx re ix line) e') . ifilter (\ix line -> asBool (eEval (mkCtx re ix line) pe'))-ir re i (EApp _ (EApp _ (BBuiltin _ Map) op) stream) = let op' = compileR op in fmap (applyUn i op') . ir re i stream-ir re i (EApp _ (EApp _ (BBuiltin _ Filter) op) stream) =- let op' = compileR op- in filter (asBool . applyUn i op') . ir re i stream-ir re i (EApp _ (EApp _ (BBuiltin _ Prior) op) stream) = prior (applyOp i op) . ir re i stream-ir re i (EApp _ (EApp _ (EApp _ (TBuiltin _ ZipW) op) streaml) streamr) = \lineStream ->+ in imap (\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 _ Prior) op) stream) = prior (applyOp (withFp fp op)) . ir fp re stream+ir fp re (EApp _ (EApp _ (EApp _ (TBuiltin _ ZipW) op) streaml) streamr) = \lineStream -> let- irl = ir re i streaml lineStream- irr = ir re i streamr lineStream- in zipWith (applyOp i op) irl irr-ir re i (EApp _ (EApp _ (EApp _ (TBuiltin _ Scan) op) seed) xs) =- scanl' (applyOp i op) seed . ir re i xs+ irl = ir fp re streaml lineStream+ irr = ir fp re streamr lineStream+ in zipWith (applyOp (withFp fp op)) irl irr+ir fp re (EApp _ (EApp _ (EApp _ (TBuiltin _ Scan) op) seed) xs) =+ scanl' (applyOp (withFp fp op)) seed . ir fp re xs -- | Output stream that prints each entry (expression) printStream :: [E (T K)] -> IO () printStream = traverse_ print -foldWithCtx :: RurePtr -> Int+foldWithCtx :: FileBS+ -> RurePtr -> E (T K) -> E (T K) -> E (T K) -> [BS.ByteString] -> E (T K)-foldWithCtx re i op seed streamExpr = foldl' (applyOp i op) seed . ir re i streamExpr+foldWithCtx fp re op seed streamExpr = foldl' (applyOp op) seed . ir fp re streamExpr -runJac :: RurePtr -- ^ Record separator+runJac :: FileBS+ -> RurePtr -- ^ Record separator -> Int -> Program (T K) -> Either StreamError ([BS.ByteString] -> IO ())-runJac re i e = fileProcessor re i (closedProgram i e)+runJac fp re i e = fileProcessor fp re (closedProgram i e) -- evaluate something that has a fold nested in it-eWith :: RurePtr -> Int -> E (T K) -> [BS.ByteString] -> E (T K)-eWith re i (EApp _ (EApp _ (EApp _ (TBuiltin (TyArr _ _ (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyStream) _) _))) Fold) op) seed) stream) = foldWithCtx re i op seed stream-eWith re i (EApp ty e0 e1) = \bs -> eClosed i (EApp ty (eWith re i e0 bs) (eWith re i e1 bs))-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 i (Tup ty es) = \bs -> Tup ty ((\e -> eWith re i e bs) <$> es)+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 ty e0 e1) = \bs -> eClosed undefined (EApp ty (eWith fp re e0 bs) (eWith fp re e1 bs))+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 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)+-- TODO: rewrite tuple-of-folds as fold-of-tuples ... "compile" to E (T K) -> E (T K)+-- OR "compile" to [(Int, E (T K)] -> ... --- TODO: passing in 'i' separately to each eClosed is sketch but... hopefully--- won't blow up in our faces--- -- | Given an expression, turn it into a function which will process the file.-fileProcessor :: RurePtr- -> Int+fileProcessor :: FileBS+ -> RurePtr -> E (T K) -> Either StreamError ([BS.ByteString] -> IO ()) fileProcessor _ _ AllField{} = Left NakedField@@ -362,37 +377,37 @@ fileProcessor _ _ (NBuiltin _ Ix) = Left NakedField fileProcessor _ _ AllColumn{} = Right $ \inp -> printStream $ fmap mkStr inp-fileProcessor re _ (Column _ i) = Right $ \inp -> do+fileProcessor _ re (Column _ i) = Right $ \inp -> do printStream $ fmap (mkStr . atField re i) inp-fileProcessor re _ (IParseCol _ i) = Right $ \inp -> do+fileProcessor _ re (IParseCol _ i) = Right $ \inp -> do printStream $ fmap (parseAsEInt . atField re i) inp-fileProcessor re _ (FParseCol _ i) = Right $ \inp -> do+fileProcessor _ re (FParseCol _ i) = Right $ \inp -> do printStream $ fmap (parseAsF . atField re i) inp--- TODO: this should extract any regex and compile them, use io/low-level API...-fileProcessor re i e@Guarded{} = Right $ \inp -> do- printStream $ ir re i e inp-fileProcessor re i e@Implicit{} = Right $ \inp -> do- printStream $ ir re i e inp-fileProcessor re i e@(EApp _ (EApp _ (BBuiltin _ Filter) _) _) = Right $ \inp -> do- printStream $ ir re i e inp-fileProcessor re i e@(EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ _ (TyApp _ (TyB _ TyStream) _))) Map) _) _) = Right $ \inp -> do- printStream $ ir re i e inp-fileProcessor re i e@(EApp _ (EApp _ (BBuiltin _ Prior) _) _) = Right $ \inp -> do- printStream $ ir re i e inp-fileProcessor re i e@(EApp _ (EApp _ (EApp _ (TBuiltin _ Scan) _) _) _) = Right $ \inp -> do- printStream $ ir re i e inp-fileProcessor re i e@(EApp _ (EApp _ (EApp _ (TBuiltin _ ZipW) _) _) _) = Right $ \inp -> do- printStream $ ir re i e inp+fileProcessor fp re e@Guarded{} = Right $ \inp -> do+ printStream $ ir fp re e inp+fileProcessor fp re e@Implicit{} = Right $ \inp -> do+ printStream $ ir fp re e inp+fileProcessor fp re e@(EApp _ (EApp _ (BBuiltin _ Filter) _) _) = Right $ \inp -> do+ printStream $ ir fp re e inp+fileProcessor fp re e@(EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ _ (TyApp _ (TyB _ TyStream) _))) Map) _) _) = Right $ \inp -> do+ printStream $ ir fp re e inp+fileProcessor fp re e@(EApp _ (EApp _ (BBuiltin _ Prior) _) _) = Right $ \inp -> do+ printStream $ ir fp re e inp+fileProcessor fp re e@(EApp _ (EApp _ (EApp _ (TBuiltin _ Scan) _) _) _) = Right $ \inp -> do+ printStream $ ir fp re e inp+fileProcessor fp re e@(EApp _ (EApp _ (EApp _ (TBuiltin _ ZipW) _) _) _) = Right $ \inp -> do+ printStream $ ir fp re e inp 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 re i e = Right $ print . eWith re i e+fileProcessor fp re e = Right $ print . eWith fp re e
src/Jacinda/File.hs view
@@ -11,6 +11,7 @@ import Control.Monad ((<=<)) import Data.Bifunctor (second) import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as ASCII import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy.Char8 as ASCIIL import Data.Functor (void)@@ -42,16 +43,17 @@ compileFS (Just bs) = compileDefault bs compileFS Nothing = defaultRurePtr -runOnBytes :: BSL.ByteString -- ^ Program+runOnBytes :: FilePath+ -> BSL.ByteString -- ^ Program -> Maybe BS.ByteString -- ^ Field separator -> BSL.ByteString -> IO ()-runOnBytes src cliFS contents =+runOnBytes fp src cliFS contents = case parseWithMax' src of Left err -> throwIO err Right (ast, m) -> do (typed, i) <- yeetIO $ runTypeM m (tyProgram ast)- cont <- yeetIO $ runJac (compileFS (cliFS <|> getFS ast)) i typed+ cont <- yeetIO $ runJac (ASCII.pack fp) (compileFS (cliFS <|> getFS ast)) i typed cont $ fmap BSL.toStrict (ASCIIL.lines contents) -- see: BSL.split, BSL.splitWith @@ -59,13 +61,13 @@ -> Maybe BS.ByteString -- ^ Field separator -> Handle -> IO ()-runOnHandle src cliFS = runOnBytes src cliFS <=< BSL.hGetContents+runOnHandle src cliFS = runOnBytes "(runOnBytes)" src cliFS <=< BSL.hGetContents runOnFile :: BSL.ByteString -> Maybe BS.ByteString -> FilePath -> IO ()-runOnFile e fs = runOnBytes e fs <=< BSL.readFile+runOnFile e fs fp = runOnBytes fp e fs =<< BSL.readFile fp tcIO :: BSL.ByteString -> IO () tcIO = yeetIO . tyCheck
src/Jacinda/Lexer.x view
@@ -44,7 +44,7 @@ $str_special = [\\\'] -@escape_str = \\ [$str_special n]+@escape_str = \\ [$str_special nt] @string = \' ([^ $str_special] | @escape_str)* \' @@ -83,7 +83,6 @@ "|" { mkSym FoldTok } \" { mkSym Quot }- ¨ { mkSym Quot } "^" { mkSym Caret } "=" { mkSym EqTok }@@ -110,6 +109,8 @@ ";" { mkSym Semicolon } "\." { mkSym BackslashDot } \\ { mkSym Backslash }+ "|`" { mkSym CeilSym }+ "|." { mkSym FloorSym } in { mkKw KwIn } let { mkKw KwLet }@@ -120,7 +121,9 @@ fs { mkRes VarFs } ix { mkRes VarIx }- ⍳ { mkRes VarIx }+ -- TODO: does this uncover an alex bug?+ -- ⍳ { mkRes VarIx }+ -- ¨ { mkSym Quot } min { mkRes VarMin } max { mkRes VarMax } @@ -132,6 +135,9 @@ floor { mkBuiltin BuiltinFloor } ceil { mkBuiltin BuiltinCeil } match { mkBuiltin BuiltinMatch }+ Some { mkBuiltin BuiltinSome }+ None { mkBuiltin BuiltinNone }+ fp { mkBuiltin BuiltinFp } ":i" { mkBuiltin BuiltinIParse } ":f" { mkBuiltin BuiltinFParse }@@ -150,11 +156,10 @@ $digit+\.$digit+ { tok (\p s -> alex $ TokFloat p (read $ ASCII.unpack s)) } _$digit+\.$digit+ { tok (\p s -> alex $ TokFloat p (negate $ read $ ASCII.unpack $ BSL.tail s)) } - -- TODO: allow chars to be escaped- -- TODO: consider dropping this syntax for strings? @string { tok (\p s -> alex $ TokStr p (escReplace' $ BSL.init $ BSL.tail s)) } - "/"[^\/]*"/" { tok (\p s -> alex $ TokRR p (BSL.init $ BSL.tail s)) } -- TODO: allow slashes that are escaped+ -- TODO: allow chars to be escaped+ "/"[^\/]*"/" { tok (\p s -> alex $ TokRR p (BSL.init $ BSL.tail s)) } @name { tok (\p s -> TokName p <$> newIdentAlex p (mkText s)) } @tyname { tok (\p s -> TokTyName p <$> newIdentAlex p (mkText s)) }@@ -189,7 +194,7 @@ escReplace = T.replace "\\\"" "\"" . T.replace "\\n" "\n"- . T.replace "\\$" "$"+ . T.replace "\\t" "\t" mkText :: BSL.ByteString -> T.Text mkText = decodeUtf8 . BSL.toStrict@@ -257,6 +262,8 @@ | Backslash | BackslashDot | FilterTok+ | FloorSym+ | CeilSym instance Pretty Sym where pretty PlusTok = "+"@@ -296,6 +303,8 @@ pretty Backslash = "\\" pretty BackslashDot = "\\." pretty FilterTok = "#."+ pretty FloorSym = "|."+ pretty CeilSym = "|`" data Keyword = KwLet | KwIn@@ -339,6 +348,9 @@ | BuiltinFloor | BuiltinCeil | BuiltinMatch+ | BuiltinSome+ | BuiltinNone+ | BuiltinFp instance Pretty Builtin where pretty BuiltinIParse = ":i"@@ -351,6 +363,9 @@ pretty BuiltinFloor = "floor" pretty BuiltinCeil = "ceil" pretty BuiltinMatch = "match"+ pretty BuiltinSome = "Some"+ pretty BuiltinNone = "None"+ pretty BuiltinFp = "fp" data Token a = EOF { loc :: a } | TokSym { loc :: a, _sym :: Sym }
src/Jacinda/Parser.y view
@@ -52,6 +52,8 @@ backslashdot { TokSym $$ BackslashDot } at { $$@(TokAccess _ _) } select { $$@(TokSelect _ _) }+ floorSym { TokSym $$ FloorSym }+ ceilSym { TokSym $$ CeilSym } plus { TokSym $$ PlusTok } minus { TokSym $$ MinusTok }@@ -108,6 +110,9 @@ ceil { TokBuiltin $$ BuiltinCeil } option { TokBuiltin $$ BuiltinOption } match { TokBuiltin $$ BuiltinMatch }+ some { TokBuiltin $$ BuiltinSome }+ none { TokBuiltin $$ BuiltinNone }+ fp { TokBuiltin $$ BuiltinFp } iParse { TokBuiltin $$ BuiltinIParse } fParse { TokBuiltin $$ BuiltinFParse }@@ -186,6 +191,10 @@ | 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) }+ | 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) } | x fParse { EApp $1 (UBuiltin $2 FParse) (ResVar $1 X) } | y iParse { EApp $1 (UBuiltin $2 IParse) (ResVar $1 Y) }@@ -222,7 +231,12 @@ | option { TBuiltin $1 Option } | floor { UBuiltin $1 Floor } | ceil { UBuiltin $1 Ceiling }+ | floorSym { UBuiltin $1 Floor }+ | ceilSym { UBuiltin $1 Ceiling }+ | some { UBuiltin $1 Some } | ix { NBuiltin $1 Ix }+ | none { NBuiltin $1 None }+ | fp { NBuiltin $1 Fp } | parens(at) { UBuiltin (loc $1) (At $ ix $1) } | parens(select) { UBuiltin (loc $1) (Select $ field $1) } | E at { EApp (eLoc $1) (UBuiltin (loc $2) (At $ ix $2)) $1 }
src/Jacinda/Parser/Rewrite.hs view
@@ -31,6 +31,7 @@ a (EAppF l e0@(EApp _ (BBuiltin _ Matches) _) (EApp l1 (EApp l2 e1@(BBuiltin _ Or) e2) e3)) = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3 a (EAppF l e0@(EApp _ (BBuiltin _ NotMatches) _) (EApp l1 (EApp l2 e1@(BBuiltin _ And) e2) e3)) = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3 a (EAppF l e0@(EApp _ (BBuiltin _ NotMatches) _) (EApp l1 (EApp l2 e1@(BBuiltin _ Or) e2) e3)) = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3+ -- TODO rewrite dfn a (EAppF l e0@Var{} (EApp lϵ e1 e2)) = EApp l (EApp lϵ e0 e1) e2 a (EAppF l e0@(BBuiltin _ Max) (EApp lϵ e1 e2)) = EApp l (EApp lϵ e0 e1) e2 a (EAppF l e0@(BBuiltin _ Min) (EApp lϵ e1 e2)) = EApp l (EApp lϵ e0 e1) e2
src/Jacinda/Ty.hs view
@@ -20,7 +20,8 @@ import qualified Data.Set as S import qualified Data.Text as T import Data.Typeable (Typeable)-import Debug.Trace+import qualified Data.Vector as V+import qualified Data.Vector.Ext as V import Intern.Name import Intern.Unique import Jacinda.AST@@ -37,11 +38,13 @@ data Error a = UnificationFailed a (T ()) (T ()) | Doesn'tSatisfy a (T ()) C | IllScoped a (Name a)+ | Ambiguous (E ()) instance Pretty a => Pretty (Error a) where pretty (UnificationFailed l ty ty') = pretty l <+> "could not unify type" <+> squotes (pretty ty) <+> "with" <+> squotes (pretty ty') pretty (Doesn'tSatisfy l ty c) = pretty l <+> squotes (pretty ty) <+> "is not a member of class" <+> pretty c pretty (IllScoped l n) = pretty l <+> squotes (pretty n) <+> "is not in scope."+ pretty (Ambiguous e) = "type of" <+> squotes (pretty e) <+> "is ambiguous" instance Pretty a => Show (Error a) where show = show . pretty@@ -150,6 +153,7 @@ substConstraints :: IM.IntMap (T a) -> T a -> T a substConstraints _ ty@TyB{} = ty+substConstraints _ ty@TyNamed{} = ty substConstraints tys ty@(TyVar _ (Name _ (Unique k) _)) = fromMaybe ty (substInt tys k) substConstraints tys (TyTup l tysϵ) = TyTup l (substConstraints tys <$> tysϵ) substConstraints tys (TyApp l ty ty') =@@ -197,6 +201,7 @@ checkType (TyB _ TyInteger) (IsEq, _) = pure () checkType (TyB _ TyInteger) (IsParseable, _) = pure () checkType (TyB _ TyFloat) (IsParseable, _) = pure ()+checkType ty (IsParseable, l) = throwError $ Doesn'tSatisfy l (void ty) IsParseable checkType (TyB _ TyFloat) (IsSemigroup, _) = pure () checkType (TyB _ TyFloat) (IsNum, _) = pure () checkType (TyB _ TyFloat) (IsOrd, _) = pure ()@@ -261,6 +266,28 @@ pure $ FunDecl (n $> ty) [] e' tyD0 FunDecl{} = error "Internal error. Should have been desugared by now." +isAmbiguous :: T K -> Bool+isAmbiguous TyVar{} = True+isAmbiguous (TyArr _ ty ty') = isAmbiguous ty || isAmbiguous ty'+isAmbiguous (TyApp _ ty ty') = isAmbiguous ty || isAmbiguous ty'+isAmbiguous (TyTup _ tys) = any isAmbiguous tys+isAmbiguous TyNamed{} = False+isAmbiguous TyB{} = False++checkAmb :: E (T K) -> TypeM a ()+checkAmb e@(BBuiltin ty _) | isAmbiguous ty = throwError $ Ambiguous (void e)+checkAmb TBuiltin{} = pure () -- don't fail on ternary builtins, we don't need it anyway... better error messages+checkAmb e@(UBuiltin ty _) | isAmbiguous ty = throwError $ Ambiguous (void e)+checkAmb (Implicit _ e') = checkAmb e'+checkAmb (Guarded _ p e') = checkAmb p *> checkAmb e'+checkAmb (EApp _ e' e'') = checkAmb e' *> checkAmb e'' -- more precise errors, don't fail yet! (if they aren't ambiguous, it shouldn't be+checkAmb (Tup _ es) = traverse_ checkAmb es+checkAmb e@(Arr ty _) | isAmbiguous ty = throwError $ Ambiguous (void e)+checkAmb e@(Var ty _) | isAmbiguous ty = throwError $ Ambiguous (void e)+checkAmb (Let _ bs e) = traverse_ checkAmb [e, snd bs]+checkAmb (Lam _ _ e) = checkAmb e -- I think+checkAmb _ = pure ()+ tyProgram :: Ord a => Program a -> TypeM a (Program (T K)) tyProgram (Program ds e) = do ds' <- traverse tyD0 ds@@ -270,7 +297,8 @@ traverse_ (uncurry (checkClass backNames)) toCheck backNames' <- unifyM =<< gets constraints -- FIXME: not sure if termination/whatever is guaranteed, need 2 think..- pure (fmap (substConstraints backNames') (Program ds' e'))+ let res = fmap (substConstraints backNames') (Program ds' e')+ checkAmb (expr res) $> res -- FIXME kind check tyE :: Ord a => E a -> TypeM a (E (T K))@@ -326,6 +354,9 @@ tyVec :: T K tyVec = TyB (KArr Star Star) TyVec +mkVec :: T K -> T K+mkVec = hkt tyVec+ tyOpt :: T K -> T K tyOpt = hkt (TyB (KArr Star Star) TyOption) @@ -342,6 +373,7 @@ tyE0 AllField{} = pure $ AllField tyStr tyE0 AllColumn{} = pure $ AllColumn (tyStream tyStr) tyE0 (NBuiltin _ Ix) = pure $ NBuiltin tyI Ix+tyE0 (NBuiltin _ Fp) = pure $ NBuiltin tyStr Fp tyE0 (BBuiltin l Plus) = BBuiltin <$> tySemiOp l <*> pure Plus tyE0 (BBuiltin l Minus) = BBuiltin <$> tyNumOp l <*> pure Minus tyE0 (BBuiltin l Times) = BBuiltin <$> tyNumOp l <*> pure Times@@ -353,8 +385,8 @@ tyE0 (BBuiltin l Neq) = BBuiltin <$> tyEq l <*> pure Neq tyE0 (BBuiltin l Min) = BBuiltin <$> tyM l <*> pure Min tyE0 (BBuiltin l Max) = BBuiltin <$> tyM l <*> pure Max-tyE0 (BBuiltin _ Split) = pure $ BBuiltin (tyArr tyStr (tyArr tyStr (hkt tyVec tyStr))) Split-tyE0 (BBuiltin _ Splitc) = pure $ BBuiltin (tyArr tyStr (tyArr tyStr (hkt tyVec tyStr))) Splitc+tyE0 (BBuiltin _ Split) = pure $ BBuiltin (tyArr tyStr (tyArr tyStr (mkVec tyStr))) Split+tyE0 (BBuiltin _ Splitc) = pure $ BBuiltin (tyArr tyStr (tyArr tyStr (mkVec tyStr))) Splitc tyE0 (BBuiltin _ Matches) = pure $ BBuiltin (tyArr tyStr (tyArr tyStr tyBool)) Matches tyE0 (BBuiltin _ NotMatches) = pure $ BBuiltin (tyArr tyStr (tyArr tyStr tyBool)) NotMatches tyE0 (UBuiltin _ Tally) = pure $ UBuiltin (tyArr tyStr tyI) Tally@@ -368,6 +400,18 @@ 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 _ Some) = do+ a <- dummyName "a"+ let a' = var a+ pure $ UBuiltin (tyArr a' (tyOpt a')) Some+tyE0 (NBuiltin _ None) = do+ a <- dummyName "a"+ pure $ NBuiltin (tyOpt $ var a) None+tyE0 (UBuiltin l Parse) = do+ a <- dummyName "a"+ let a' = var a+ modifying classVarsLens (addC a (IsParseable, l))+ pure $ UBuiltin (tyArr tyStr a') Parse tyE0 (BBuiltin l Sprintf) = do a <- dummyName "a" let a' = var a@@ -499,3 +543,12 @@ a <- dummyName "a" let a' = var a pure $ OptionVal (tyOpt a') Nothing+tyE0 (Arr l v) | V.null v = do+ a <- dummyName "a"+ let a' = var a+ pure $ Arr (mkVec a') V.empty+ | otherwise = do+ v' <- traverse tyE0 v+ let x = V.head v'+ V.priorM_ (\y y' -> pushConstraint l (eLoc y) (eLoc y')) v'+ pure $ Arr (eLoc x) v'