packages feed

jacinda 2.0.1.0 → 2.0.2.0

raw patch · 29 files changed

+600/−520 lines, 29 filesdep ~base

Dependency ranges changed: base

Files

CHANGELOG.md view
@@ -1,3 +1,11 @@+# 2.0.2.0++  * Add support for custom record separators+  * Faster float parsing+  * Add \`$ builtin+  * Allow escaped `/` within regex+  * Round out support for `$0:f` &c.+ # 2.0.1.0    * Add `mapMaybe`, `dedup`, `filter`, `fold`, `fold1`, `scan`, `dedupOn`,
app/Main.hs view
@@ -1,6 +1,7 @@+{-# LANGUAGE OverloadedStrings #-}+ module Main (main) where -import           Data.Semigroup      ((<>)) import qualified Data.Text           as T import qualified Data.Text.IO        as TIO import qualified Data.Version        as V@@ -11,7 +12,7 @@  data Command = TypeCheck !FilePath ![FilePath]              | Run !FilePath !(Maybe FilePath) ![FilePath]-             | Expr !T.Text !(Maybe FilePath) !(Maybe T.Text) ![FilePath]+             | Expr !T.Text !(Maybe FilePath) !(Maybe T.Text) !Bool !(Maybe T.Text) ![FilePath]              | Eval !T.Text  jacFile :: Parser FilePath@@ -20,6 +21,17 @@     <> help "Source code"     <> jacCompletions) +asv :: Parser Bool+asv = switch+    (long "asv"+    <> help "Read from ASV")++jacRs :: Parser (Maybe T.Text)+jacRs = optional $ option str+    (short 'R'+    <> metavar "REGEXP"+    <> help "Record separator")+ jacFs :: Parser (Maybe T.Text) jacFs = optional $ option str     (short 'F'@@ -49,7 +61,7 @@     where         tcP = TypeCheck <$> jacFile <*> includes         runP = Run <$> jacFile <*> inpFile <*> includes-        exprP = Expr <$> jacExpr <*> inpFile <*> jacFs <*> includes+        exprP = Expr <$> jacExpr <*> inpFile <*> jacFs <*> asv <*> jacRs <*> includes         eP = Eval <$> jacExpr  includes :: Parser [FilePath]@@ -75,10 +87,15 @@ main :: IO () main = run =<< execParser wrapper +ap :: Bool -> Maybe T.Text -> Maybe T.Text+ap True Just{}  = errorWithoutStackTrace "--asv specified with field separator."+ap True Nothing = Just "\\x1f"+ap _ fs         = fs+ run :: Command -> IO ()-run (TypeCheck fp is)         = tcIO is =<< TIO.readFile fp-run (Run fp Nothing is)       = do { contents <- TIO.readFile fp ; runOnHandle is contents Nothing stdin }-run (Run fp (Just dat) is)    = do { contents <- TIO.readFile fp ; runOnFile is contents Nothing dat }-run (Expr eb Nothing fs is)   = runOnHandle is eb fs stdin-run (Expr eb (Just fp) fs is) = runOnFile is eb fs fp-run (Eval e)                  = print (exprEval e)+run (TypeCheck fp is)              = tcIO is =<< TIO.readFile fp+run (Run fp Nothing is)            = do { contents <- TIO.readFile fp ; runOnHandle is contents Nothing Nothing stdin }+run (Run fp (Just dat) is)         = do { contents <- TIO.readFile fp ; runOnFile is contents Nothing Nothing dat }+run (Expr eb Nothing fs a rs is)   = runOnHandle is eb (ap a fs) rs stdin+run (Expr eb (Just fp) fs a rs is) = runOnFile is eb (ap a fs) rs fp+run (Eval e)                       = print (exprEval e)
bench/Bench.hs view
@@ -13,14 +13,15 @@ main =     defaultMain [ bgroup "eval"                       [ bench "exprEval" $ nf exprEval "[x+' '+y]|'' split '01-23-1987' /-/"-                      , bench "runOnFile" $ nfIO (silence $ runOnFile [] "(+)|0 {%/Bloom/}{1}" Nothing "bench/data/ulysses.txt")-                      , bench "runOnFile" $ nfIO (silence $ do { contents <- TIO.readFile "examples/wc.jac" ; runOnFile [] contents Nothing "bench/data/ulysses.txt" })-                      , bench "runOnFile" $ nfIO (silence $ do { contents <- TIO.readFile "examples/span2.jac" ; runOnFile [] contents Nothing "bench/data/span.txt" })+                      , bench "path" $ nfIO (silence $ runOnFile [] "{|[x+'\\n'+y]|>`$}" (Just ":") Nothing "bench/data/PATH")+                      , bench "RS" $ nfIO (silence $ runOnFile [] "$0" Nothing (Just ":") "bench/data/PATH")+                      , bench "runOnFile" $ nfIO (silence $ runOnFile [] "(+)|0 {%/Bloom/}{1}" Nothing Nothing "bench/data/ulysses.txt")+                      , bench "runOnFile" $ nfIO (silence $ do { contents <- TIO.readFile "examples/wc.jac" ; runOnFile [] contents Nothing Nothing "bench/data/ulysses.txt" })+                      , bench "runOnFile" $ nfIO (silence $ do { contents <- TIO.readFile "examples/span2.jac" ; runOnFile [] contents Nothing Nothing "bench/data/span.txt" })                       ]                 ]  instance NFData (E a) where-    rnf (StrLit _ str)  = rnf str; rnf (ILit _ i) = rnf i;-    rnf (BLit _ b) = rnf b; rnf (FLit _ f) = rnf f+    rnf (Lit _ l) = rnf l     rnf (Arr _ es) = rnf es; rnf (Tup _ es) = rnf es     rnf (OptionVal _ e) = rnf e
doc/guide.pdf view

binary file changed (205361 → 207341 bytes)

examples/hsLibversionMac.jac view
@@ -1,1 +1,1 @@-~..?{| `0 ~* 1 /(^[A-Za-z][A-Za-z0-9\-]*\-\d+(\.\d+)*)\-[0-9a-zA-Z]{22}$/}+~..?{| `0 ~* 1 /(^[A-Za-z][A-Za-z0-9\-]*\-\d+(\.\d+)*)\-[0-9a-zA-Z]{8}$/}
+ examples/path3.jac view
@@ -0,0 +1,4 @@+#!/usr/bin/env -S ja run+:set fs:=/:/;++{|[x+'\n'+y]|>`$}
+ examples/pathrs.jac view
@@ -0,0 +1,4 @@+#!/usr/bin/env -S ja run+:set rs:=/:/;++$0
jacinda.cabal view
@@ -1,7 +1,7 @@-cabal-version:      2.0+cabal-version:      2.2 name:               jacinda-version:            2.0.1.0-license:            AGPL-3+version:            2.0.2.0+license:            AGPL-3.0-only license-file:       COPYING maintainer:         vamchale@gmail.com author:             Vanessa McHale@@ -14,6 +14,8 @@ build-type:         Simple data-files:     lib/*.jac+    lib/csv/*.jac+    lib/fs/*.jac     prelude/*.jac  extra-source-files:@@ -62,9 +64,18 @@      autogen-modules:  Paths_jacinda     default-language: Haskell2010-    ghc-options:      -Wall -O2 -Wno-missing-signatures+    other-extensions:+        OverloadedStrings OverloadedLists DeriveFunctor FlexibleContexts+        DeriveAnyClass DeriveGeneric TypeFamilies++    ghc-options:+        -Wincomplete-uni-patterns -Wincomplete-record-updates+        -Wredundant-constraints -Widentities -Wcpp-undef+        -Wmissing-export-lists -Wunused-packages -Wall -O2+        -Wno-missing-signatures -Wno-x-partial+     build-depends:-        base >=4.10.0.0 && <5,+        base >=4.11.0.0 && <5,         bytestring >=0.11.0.0,         text,         prettyprinter >=1.7.0,@@ -79,24 +90,11 @@         microlens-mtl >=0.1.8.0,         vector >=0.12.2.0,         recursion >=1.0.0.0,-        split+        split,+        deepseq      if !flag(cross)-        build-tool-depends: alex:alex >=3.4.0.0, happy:happy--    if impl(ghc >=8.0)-        ghc-options:-            -Wincomplete-uni-patterns -Wincomplete-record-updates-            -Wredundant-constraints -Widentities--    if impl(ghc >=8.4)-        ghc-options: -Wmissing-export-lists--    if impl(ghc >=8.2)-        ghc-options: -Wcpp-undef--    if impl(ghc >=8.10)-        ghc-options: -Wunused-packages+        build-tool-depends: alex:alex >=3.5.0.0, happy:happy  executable ja     main-is:          Main.hs@@ -104,33 +102,31 @@     other-modules:    Paths_jacinda     autogen-modules:  Paths_jacinda     default-language: Haskell2010-    ghc-options:      -Wall -rtsopts "-with-rtsopts=-A200k -k32k"+    ghc-options:+        -Wincomplete-uni-patterns -Wincomplete-record-updates+        -Wredundant-constraints -Widentities -Wcpp-undef+        -Wmissing-export-lists -Wunused-packages -Wall -rtsopts+        "-with-rtsopts=-A200k -k32k" -Wincomplete-uni-patterns+        -Wincomplete-record-updates -Wredundant-constraints -Widentities+        -Wcpp-undef -Wmissing-export-lists -Wunused-packages+     build-depends:         base,         jacinda-lib,         optparse-applicative >=0.14.1.0,         text -    if impl(ghc >=8.0)-        ghc-options:-            -Wincomplete-uni-patterns -Wincomplete-record-updates-            -Wredundant-constraints -Widentities--    if impl(ghc >=8.4)-        ghc-options: -Wmissing-export-lists--    if impl(ghc >=8.2)-        ghc-options: -Wcpp-undef--    if impl(ghc >=8.10)-        ghc-options: -Wunused-packages- test-suite jacinda-test     type:             exitcode-stdio-1.0     main-is:          Spec.hs     hs-source-dirs:   test     default-language: Haskell2010-    ghc-options:      -Wall -threaded -rtsopts "-with-rtsopts=-N -K1K" -Wall+    ghc-options:+        -Wincomplete-uni-patterns -Wincomplete-record-updates+        -Wredundant-constraints -Widentities -Wcpp-undef+        -Wmissing-export-lists -Wunused-packages -Wall -threaded -rtsopts+        "-with-rtsopts=-N -K1K" -Wall+     build-depends:         base,         jacinda-lib,@@ -139,26 +135,17 @@         text,         tasty-hunit -    if impl(ghc >=8.0)-        ghc-options:-            -Wincomplete-uni-patterns -Wincomplete-record-updates-            -Wredundant-constraints -Widentities--    if impl(ghc >=8.4)-        ghc-options: -Wmissing-export-lists--    if impl(ghc >=8.2)-        ghc-options: -Wcpp-undef--    if impl(ghc >=8.10)-        ghc-options: -Wunused-packages- benchmark jacinda-bench     type:             exitcode-stdio-1.0     main-is:          Bench.hs     hs-source-dirs:   bench     default-language: Haskell2010-    ghc-options:      -Wall -rtsopts "-with-rtsopts=-A200k -k32k"+    ghc-options:+        -Wincomplete-uni-patterns -Wincomplete-record-updates+        -Wredundant-constraints -Widentities -Wcpp-undef+        -Wmissing-export-lists -Wunused-packages -Wall -rtsopts+        "-with-rtsopts=-A200k -k32k"+     build-depends:         base,         criterion,@@ -166,17 +153,3 @@         deepseq,         text,         silently--    if impl(ghc >=8.0)-        ghc-options:-            -Wincomplete-uni-patterns -Wincomplete-record-updates-            -Wredundant-constraints -Widentities--    if impl(ghc >=8.4)-        ghc-options: -Wmissing-export-lists--    if impl(ghc >=8.2)-        ghc-options: -Wcpp-undef--    if impl(ghc >=8.10)-        ghc-options: -Wunused-packages
+ lib/csv/headers.jac view
@@ -0,0 +1,2 @@+fn headers() :=+  {ix=1}{[x+'\n'+y]|>`$};
+ lib/fs/basename.jac view
@@ -0,0 +1,2 @@+fn fileName(x) :=+  x ~* 2 /([^\/]*\/)*(.*)/;
man/ja.1 view
@@ -1,10 +1,10 @@-.\" Automatically generated by Pandoc 3.1.7+.\" Automatically generated by Pandoc 3.1.12 .\" .TH "ja (1)" "" "" "" "" .SH NAME-ja - Jacinda: data filtering, processing, reporting+ja \- Jacinda: data filtering, processing, reporting .SH SYNOPSIS-ja run src.jac -i data.txt+ja run src.jac \-i data.txt .PP cat FILE1 FILE2 | ja \[aq]#\[dq]$0\[cq] .PP@@ -14,21 +14,27 @@ .SH DESCRIPTION \f[B]Jacinda\f[R] is a data stream processing language à la AWK. .SH SUBCOMMANDS-\f[B]run\f[R] - Run a program from file+\f[B]run\f[R] \- Run a program from file .PP-\f[B]tc\f[R] - Typecheck a program+\f[B]tc\f[R] \- Typecheck a program .PP-\f[B]e\f[R] - Evaluate an expression (without reference to a file)+\f[B]e\f[R] \- Evaluate an expression (without reference to a file) .SH OPTIONS .TP-\f[B]-h\f[R] \f[B]--help\f[R]+\f[B]\-h\f[R] \f[B]\-\-help\f[R] Display help .TP-\f[B]-V\f[R] \f[B]--version\f[R]+\f[B]\-V\f[R] \f[B]\-\-version\f[R] Display version information .TP-\f[B]-I\f[R] \f[B]--include\f[R]+\f[B]\-I\f[R] \f[B]\-\-include\f[R] Include directory for imports+.TP+\f[B]\-F\f[R]+Field separator regex+.TP+\f[B]\-R\f[R]+Record separator regex .SH LANGUAGE .SS REGEX Regular expressions follow Rust\[cq]s regex library:@@ -43,43 +49,43 @@ \f[B]#\f[R] Prefix operator: tally (count bytes in string) .TP \f[B]#*\f[R] Prefix operator: list length-List a -> a+List a \-> a .TP \f[B],\f[R] Ternary operator: zip with-(a -> b -> c) -> Stream a -> Stream b -> Stream c+(a \-> b \-> c) \-> Stream a \-> Stream b \-> Stream c .TP \f[B]|\f[R] Ternary operator: fold-Foldable f :=> (b -> a -> b) -> b -> f a -> b+Foldable f :=> (b \-> a \-> b) \-> b \-> f a \-> b .TP \f[B]|>\f[R] Fold without seed-Foldable f :=> (a -> a -> a) -> f a -> a+Foldable f :=> (a \-> a \-> a) \-> f a \-> a .TP \f[B]\[ha]\f[R] Ternary operator: scan-(b -> a -> b) -> b -> Stream a -> Stream b+(b \-> a \-> b) \-> b \-> Stream a \-> Stream b .TP \f[B]\[dq]\f[R], \f[B]¨\f[R] Binary operator: map-Functor f :=> a -> b -> f a -> f b+Functor f :=> a \-> b \-> f a \-> f b .TP \f[B][:\f[R] Unary operator: const-a -> b -> a+a \-> b \-> a .TP \f[B]#.\f[R] Binary operator: filter-Witherable f :=> (a -> Bool) -> f a -> f a+Witherable f :=> (a \-> Bool) \-> f a \-> f a .TP \f[B]\[rs].\f[R] Binary operator: prior-(a -> a -> b) -> Stream a -> Stream b+(a \-> a \-> b) \-> Stream a \-> Stream b .TP \f[B]\[ti].\f[R] Unary deduplication (stream)-Ord a :=> Stream a -> Stream a+Ord a :=> Stream a \-> Stream a .TP \f[B]\[ti].*\f[R] Deduplicate on (stream)-Ord b :=> (a -> b) -> Stream a -> Stream a+Ord b :=> (a \-> b) \-> Stream a \-> Stream a .TP \f[B]max\f[R] Maximum of two values-Ord a :=> a -> a -> a+Ord a :=> a \-> a \-> a .TP \f[B]min\f[R] Minimum of two values-Ord a :=> a -> a -> a+Ord a :=> a \-> a \-> a .PP \f[B]&\f[R] Boolean and .PP@@ -88,51 +94,51 @@ \f[B]!\f[R] Prefix boolean not .TP \f[B]\[ti]\f[R] Matches regex-Str -> Regex -> Bool+Str \-> Regex \-> Bool .TP \f[B]!\[ti]\f[R] Does not match-Str -> Regex -> Bool+Str \-> Regex \-> Bool .PP \f[B]ix\f[R], \f[B]⍳\f[R] Line number .TP \f[B]substr\f[R] Extract substring-Str -> Int -> Int -> Str+Str \-> Int \-> Int \-> Str .TP \f[B]split\f[R] Split a string by regex-Str -> Regex -> List Str+Str \-> Regex \-> List Str .TP \f[B]splitc\f[R] Split a string on a single character-Str -> Str -> List Str+Str \-> Str \-> List Str .TP \f[B]⌊\f[R], \f[B]|.\f[R] Floor function-Float -> Int+Float \-> Int .TP \f[B]⌈\f[R], \f[B]|\[ga]\f[R] Ceiling function-Float -> Int+Float \-> Int .PP-\f[B]-.\f[R] Unary negate+\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 .TP \f[B]option\f[R] Option eliminator-b -> (a -> b) -> Option a -> b+b \-> (a \-> b) \-> Option a \-> b .TP \f[B]match\f[R]-Str -> Regex -> Option (Int .+Str \-> Regex \-> Option (Int . Int) .TP \f[B]\[ti]*\f[R] Match, returning nth capture group-Str -> Int -> Regex -> Option Str+Str \-> Int \-> Regex \-> Option Str .TP-\f[B]captures\f[R] Return all captures (nth capture group)-Str -> Int -> Regex -> List Str+\f[B]captures\f[R] Return all aptures (nth capture group)+Str \-> Int \-> Regex \-> List Str .TP \f[B]:?\f[R] mapMaybe-Witherable f :=> (a -> Option b) -> f a -> f b+Witherable f :=> (a \-> Option b) \-> f a \-> f b .TP \f[B].?\f[R] catMaybes-Witherable f :=> f (Option a) -> f a+Witherable f :=> f (Option a) \-> f a .PP \f[B]fp\f[R] Filename .PP@@ -140,10 +146,17 @@ .SS SYNTAX \f[B]\[ga]n\f[R] nth field .PP+\f[B]\[ga]0\f[R] current line+.PP \f[B]\[ga]*\f[R] last field+.TP+\f[B]\[ga]$\f[R] all fields+List Str .PP \f[B]$n\f[R] nth column .PP+\f[B]$0\f[R] stream of lines+.PP \f[B]{%<pattern>}{<expr>}\f[R] Filtered stream on lines matching <pattern>, defined by <expr> .PP@@ -157,9 +170,9 @@ \f[B]_n\f[R] Negative number .TP \f[B].n\f[R] Extract the nth value-List a -> a+List a \-> a .PP-\f[B]->n\f[R] Get the nth element of a tuple+\f[B]\->n\f[R] Get the nth element of a tuple .PP \f[B]{.\f[R] Line comment .PP@@ -167,9 +180,11 @@ .SS DECLARATIONS \f[B]:set fs=/REGEX/;\f[R] Set field separator .PP+\f[B]:set rs=/REGEX/;\f[R] Set record separator+.PP \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+\f[CR]JAC_PATH\f[R] \- colon\-separated list of directories to search .SH EXAMPLES .TP [#x>72] #. $0@@ -184,9 +199,12 @@ {|sprintf \[aq]%i %i\[aq] (\[ga]2 . \[ga]1)} Print the first two fields in opposite order .TP-:set fs := /,[ \[rs]t]*|[ \[rs]t]+/; {|sprintf \[aq]%i %i\[aq] (\[ga]2 . \[ga]1)}+:set fs:=/,[ \[rs]t]*|[ \[rs]t]+/; {|sprintf \[aq]%i %i\[aq] (\[ga]2 . \[ga]1)} Same, with input fields separated by comma and/or blanks and tabs. .TP+:set fs:=/,/; {ix=1}{[x+`\[rs]n'+y]|>\[ga]$}+Present column names of a .csv file, one per line+.TP (+)|0 $1:i Sum first column .TP@@ -217,8 +235,10 @@ Please report any bugs you may come across to https://github.com/vmchale/jacinda/issues .SH COPYRIGHT-Copyright 2021-2022.+Copyright 2021\-2022. Vanessa McHale. All Rights Reserved. .SH AUTHORS-Vanessa McHale<vamchale@gmail.com>.+Vanessa McHale\c+.MT vamchale@gmail.com+.ME \c.
src/A.hs view
@@ -1,32 +1,24 @@-{-# LANGUAGE DeriveFoldable    #-}+{-# LANGUAGE DeriveAnyClass    #-} {-# LANGUAGE DeriveFunctor     #-} {-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies      #-} -module A ( E (..)-         , T (..)-         , TB (..)-         , BBin (..)-         , BTer (..)-         , BUn (..)-         , DfnVar (..)-         , D (..)-         , Program (..)-         , C (..)-         , N (..)+module A ( E (..), T (..), (~>), TB (..), C (..)+         , L (..), N (..), BBin (..), BTer (..)+         , BUn (..), DfnVar (..)+         , D (..), Program (..)          , mapExpr-         , getFS, flushD+         , getS, flushD          -- * Base functors          , EF (..)          ) where +import           Control.DeepSeq    (NFData) import           Control.Recursion  (Base, Corecursive, Recursive) import qualified Data.ByteString    as BS import qualified Data.IntMap        as IM-import           Data.Maybe         (listToMaybe)-import           Data.Semigroup     ((<>))+import           Data.List          (foldl') import qualified Data.Text          as T import           Data.Text.Encoding (decodeUtf8) import qualified Data.Vector        as V@@ -44,14 +36,9 @@ (<##>) :: Doc a -> Doc a -> Doc a (<##>) x y = x <> hardline <> hardline <> y -data TB = TyInteger-        | TyFloat-        | TyStr | TyR-        | TyStream-        | TyVec-        | TyBool-        | TyOption-        | TyUnit+data TB = TyInteger | TyFloat | TyStr+        | TyStream | TyVec | TyOption+        | TyR | TyBool | TyUnit         deriving (Eq, Ord)  tupledByFunky :: Doc ann -> [Doc ann] -> Doc ann@@ -63,8 +50,15 @@ jacTup :: Pretty a => [a] -> Doc ann jacTup = tupledBy " . " . fmap pretty +infixr 0 ~>++(~>) :: T -> T -> T+(~>) = TyArr++infixr 0 :$+ data T = TyB { tyBuiltin :: TB }-       | TyApp { tyApp0 :: T, tyApp1 :: T }+       | (:$) { tyApp0 :: T, tyApp1 :: T } -- TODO: :$        | TyArr { tyArr0 :: T, tyArr1 :: T }        | TyVar { tyVar :: Nm () }        | TyTup { tyTups :: [T] }@@ -72,21 +66,15 @@        deriving (Eq, Ord)  instance Pretty TB where-    pretty TyInteger = "Integer"-    pretty TyStream  = "Stream"-    pretty TyBool    = "Bool"-    pretty TyStr     = "Str"-    pretty TyFloat   = "Float"-    pretty TyVec     = "List"-    pretty TyOption  = "Optional"-    pretty TyUnit    = "𝟙"-    pretty TyR       = "Regex"+    pretty TyInteger = "Integer"; pretty TyStr = "Str"; pretty TyFloat = "Float"+    pretty TyStream = "Stream"; pretty TyVec = "List"; pretty TyOption = "Optional"+    pretty TyBool = "Bool"; pretty TyUnit = "𝟙"; pretty TyR = "Regex"  instance Show TB where show=show.pretty  instance Pretty T where     pretty (TyB b)        = pretty b-    pretty (TyApp ty ty') = pretty ty <+> pretty ty'+    pretty (ty:$ty')      = pretty ty <+> pretty ty'     pretty (TyVar n)      = pretty n     pretty (TyArr ty ty') = pretty ty <+> "⟶" <+> pretty ty'     pretty (TyTup tys)    = jacTup tys@@ -100,16 +88,11 @@ data BUn = Tally -- length of string field          | Const          | Not -- ^ Boolean-         | At Int-         | Select Int-         | IParse-         | FParse-         | Parse-         | Floor-         | Ceiling+         | At Int | Select Int+         | IParse | FParse | Parse+         | Floor | Ceiling          | Some-         | Dedup-         | CatMaybes+         | Dedup | CatMaybes          | Negate          | TallyList -- length of vector          deriving (Eq)@@ -157,43 +140,20 @@           | And | Or           | Min | Max           | Split | Splitc-          | Prior-          | Filter-          | Sprintf-          | Match-          | MapMaybe-          | Fold1-          | DedupOn+          | Prior | DedupOn | MapMaybe+          | Filter | Fold1+          | Match | Sprintf           deriving (Eq)  instance Pretty BBin where-    pretty Plus       = "+"-    pretty Times      = "*"-    pretty Div        = "%"-    pretty Minus      = "-"-    pretty Eq         = "="-    pretty Gt         = ">"-    pretty Lt         = "<"-    pretty Geq        = ">="-    pretty Leq        = "<="-    pretty Neq        = "!="-    pretty Map        = "¨"-    pretty Matches    = "~"-    pretty NotMatches = "!~"-    pretty And        = "&"-    pretty Or         = "||"-    pretty Max        = "max"-    pretty Min        = "min"-    pretty Prior      = "\\."-    pretty Filter     = "#."-    pretty Split      = "split"-    pretty Splitc     = "splitc"-    pretty Sprintf    = "sprintf"-    pretty Match      = "match"-    pretty MapMaybe   = ":?"-    pretty Fold1      = "|>"-    pretty Exp        = "**"-    pretty DedupOn    = "~.*"+    pretty Plus = "+"; pretty Times = "*"; pretty Div = "%"; pretty Minus = "-"+    pretty Eq = "="; pretty Gt = ">"; pretty Lt = "<"; pretty Geq = ">="+    pretty Leq = "<="; pretty Neq = "!="; pretty Map = "¨"; pretty Matches = "~"+    pretty NotMatches = "!~"; pretty And = "&"; pretty Or = "||"+    pretty Max = "max"; pretty Min = "min"; pretty Prior = "\\."; pretty Filter = "#."+    pretty Split = "split"; pretty Splitc = "splitc"; pretty Sprintf = "sprintf"+    pretty Match = "match"; pretty MapMaybe = ":?"; pretty Fold1 = "|>"+    pretty Exp = "**"; pretty DedupOn = "~.*"  data DfnVar = X | Y deriving (Eq) @@ -202,31 +162,28 @@ -- 0-ary data N = Ix | Nf | None | Fp deriving (Eq) +data L = ILit !Integer | FLit !Double | BLit !Bool | StrLit BS.ByteString deriving (Generic, NFData, Eq)+ -- expression 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 }+         | 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+         | FParseAllCol { eLoc :: a } -- ^ @$0@, parsed as a float+         | ParseAllCol { eLoc :: a }          | EApp { eLoc :: a, eApp0 :: E a, eApp1 :: E a }          | Guarded { eLoc :: a, eP :: E a, 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) }-         | ILit { eLoc :: a, eInt :: !Integer }-         | BLit { eLoc :: a, eBool :: !Bool }-         | StrLit { eLoc :: a, eStr :: BS.ByteString }+         | Lit { eLoc :: a, lit :: !L }          | RegexLit { eLoc :: a, eRr :: BS.ByteString }-         | FLit { eLoc :: a, eFloat :: !Double }          | 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 }+         | 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] }          | ResVar { eLoc :: a, dfnVar :: DfnVar }@@ -241,33 +198,21 @@          deriving (Functor, Generic)  instance Recursive (E a) where- instance Corecursive (E a) where  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+            | IParseColF a Int | FParseColF a Int | ParseColF a Int+            | FieldF a Int | LastFieldF a | FieldListF a | AllFieldF a+            | AllColumnF a | IParseAllColF a | FParseAllColF a | ParseAllColF a             | EAppF a x x-            | GuardedF a x x-            | ImplicitF a x+            | GuardedF a x x | ImplicitF a x             | LetF a (Nm a, x) x             | VarF a (Nm a)-            | ILitF a Integer-            | BLitF a Bool-            | StrLitF a BS.ByteString+            | LitF a !L             | RegexLitF a BS.ByteString-            | FLitF a Double             | LamF a (Nm a) x             | DfnF a x-            | BBF a BBin-            | TBF a BTer-            | UBF a BUn-            | NBF a N+            | BBF a BBin | TBF a BTer | UBF a BUn | NBF a N             | TupF a [x]             | ResVarF a DfnVar             | RCF RurePtr@@ -278,22 +223,33 @@             | CondF a x x x             | InF x (Maybe x) (Maybe x) x             | RwBF a BBin | RwTF a BTer-            deriving (Generic, Functor, Foldable, Traversable)+            deriving (Generic, Functor)  type instance Base (E a) = (EF a)  instance Pretty N where     pretty Ix = "⍳"; pretty Nf = "nf"; pretty None = "None"; pretty Fp = "fp" +instance Pretty L where+    pretty (ILit i)     = pretty i+    pretty (FLit d)     = pretty d+    pretty (BLit True)  = "#t"+    pretty (BLit False) = "#f"+    pretty (StrLit str) = pretty (decodeUtf8 str)+ instance Pretty (E a) where     pretty (Column _ i)                                           = "$" <> pretty i     pretty AllColumn{}                                            = "$0"+    pretty IParseAllCol{}                                         = "$0:i"+    pretty FParseAllCol{}                                         = "$0:f"+    pretty ParseAllCol{}                                          = "$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 FieldList{}                                            = "`$"     pretty (EApp _ (EApp _ (BB _ Prior) e) e')                    = pretty e <> "\\." <+> pretty e'     pretty (EApp _ (EApp _ (BB _ Max) e) e')                      = "max" <+> pretty e <+> pretty e'     pretty (EApp _ (EApp _ (BB _ Min) e) e')                      = "min" <+> pretty e <+> pretty e'@@ -318,15 +274,11 @@     pretty (EApp _ (UB _ Parse) e')                               = pretty e' <> ":"     pretty (EApp _ e@UB{} e')                                     = pretty e <> pretty e'     pretty (EApp _ e e')                                          = pretty e <+> pretty e'+    pretty (Lit _ l)                                              = pretty l     pretty (Var _ n)                                              = pretty n-    pretty (ILit _ i)                                             = pretty i     pretty (RegexLit _ rr)                                        = "/" <> pretty (decodeUtf8 rr) <> "/"-    pretty (FLit _ f)                                             = pretty f-    pretty (BLit _ True)                                          = "#t"-    pretty (BLit _ False)                                         = "#f"     pretty (BB _ b)                                               = parens (pretty b)     pretty (UB _ u)                                               = pretty u-    pretty (StrLit _ str)                                         = pretty (decodeUtf8 str)     pretty (ResVar _ x)                                           = pretty x     pretty (Tup _ es)                                             = jacTup es     pretty (Lam _ n e)                                            = parens ("λ" <> pretty n <> "." <+> pretty e)@@ -358,6 +310,7 @@     (==) (FParseCol _ i) (FParseCol _ j)        = i == j     (==) (Field _ i) (Field _ j)                = i == j     (==) LastField{} LastField{}                = True+    (==) FieldList{} FieldList{}                = True     (==) AllColumn{} AllColumn{}                = True     (==) AllField{} AllField{}                  = True     (==) (EApp _ e0 e1) (EApp _ e0' e1')        = e0 == e0' && e1 == e1'@@ -366,11 +319,8 @@     (==) (Let _ (n, eϵ) e) (Let _ (n', eϵ') e') = eqName n n' && e == e' && eϵ == eϵ'     (==) (Var _ n) (Var _ n')                   = eqName n n'     (==) (Lam _ n e) (Lam _ n' e')              = eqName n n' && e == e'-    (==) (ILit _ i) (ILit _ j)                  = i == j-    (==) (FLit _ u) (FLit _ v)                  = u == v-    (==) (StrLit _ str) (StrLit _ str')         = str == str'+    (==) (Lit _ l) (Lit _ l')                   = l == l'     (==) (RegexLit _ rr) (RegexLit _ rr')       = rr == rr'-    (==) (BLit _ b) (BLit _ b')                 = b == b'     (==) (BB _ b) (BB _ b')                     = b == b'     (==) (TB _ b) (TB _ b')                     = b == b'     (==) (UB _ unOp) (UB _ unOp')               = unOp == unOp'@@ -394,28 +344,26 @@        deriving (Eq, Ord)  instance Pretty C where-    pretty IsNum       = "Num"-    pretty IsEq        = "Eq"-    pretty IsOrd       = "Ord"-    pretty IsParse     = "Parseable"-    pretty IsSemigroup = "Semigroup"-    pretty Functor     = "Functor"-    pretty Foldable    = "Foldable"-    pretty IsPrintf    = "Printf"-    pretty Witherable  = "Witherable"+    pretty IsNum = "Num"; pretty IsEq = "Eq"; pretty IsOrd = "Ord"+    pretty IsParse = "Parseable"; pretty IsSemigroup = "Semigroup"+    pretty Functor = "Functor"; pretty Foldable = "Foldable"+    pretty IsPrintf = "Printf"; pretty Witherable = "Witherable"  instance Show C where show=show.pretty  -- decl-data D a = SetFS T.Text+data D a = SetFS T.Text | SetRS T.Text          | FunDecl (Nm a) [Nm a] (E a)          | FlushDecl+         | SetAsv          deriving (Functor)  instance Pretty (D a) where-    pretty (SetFS bs)       = ":set" <+> "/" <> pretty bs <> "/;"+    pretty (SetFS bs)       = ":set fs :=" <+> "/" <> pretty bs <> "/;"+    pretty (SetRS rs)       = ":set rs :=" <+> "/" <> pretty rs <> "/;"     pretty (FunDecl n ns e) = "fn" <+> pretty n <> tupled (pretty <$> ns) <+> ":=" <#> indent 2 (pretty e <> ";")     pretty FlushDecl        = ":flush;"+    pretty SetAsv           = ":set asv;"  data Program a = Program { decls :: [D a], expr :: E a } deriving (Functor) @@ -427,8 +375,12 @@ flushD :: Program a -> Bool flushD (Program ds _) = any p ds where p FlushDecl = True; p _ = False -getFS :: Program a -> Maybe T.Text-getFS (Program ds _) = listToMaybe (concatMap go ds) where go (SetFS bs) = [bs]; go _ = []+getS :: Program a -> (Maybe T.Text, Maybe T.Text)+getS (Program ds _) = foldl' go (Nothing, Nothing) ds where+    go (_, rs) (SetFS bs) = (Just bs, rs)+    go (_, rs) SetAsv     = (Just "\\x1f", rs)+    go (fs, _) (SetRS bs) = (fs, Just bs)+    go next _             = next  mapExpr :: (E a -> E a) -> Program a -> Program a mapExpr f (Program ds e) = Program ds (f e)
src/A/E.hs view
@@ -4,8 +4,7 @@  import           A import           Control.Monad              ((<=<))-import           Control.Monad.State.Strict (State, get, modify)-import           Data.Functor               (($>))+import           Control.Monad.State.Strict (State, state) import qualified Data.Text                  as T import           Nm import           U@@ -13,7 +12,7 @@ type M = State Int  nN :: T.Text -> a -> M (Nm a)-nN n l = do {i <- get; modify (+1) $> Nm n (U$i+1) l}+nN n l = state (\i -> (Nm n (U$i+1) l, i+1))  doms :: T -> [T] doms (TyArr t t') = t:doms t'; doms _ = []
src/A/I.hs view
@@ -41,7 +41,7 @@  iD :: D T -> RM T () iD (FunDecl n [] e) = do {eI <- iE e; modify (bind n eI)}-iD SetFS{} = pure (); iD FlushDecl{} = pure ()+iD SetFS{} = pure (); iD SetRS{} = pure (); iD SetAsv = pure (); iD FlushDecl{} = pure () iD FunDecl{} = desugar  desugar = error "Internal error. Should have been de-sugared in an earlier stage!"@@ -78,16 +78,18 @@ bM (Guarded l e0 e1) = Guarded l <$> bM e0 <*> bM e1 bM (Cond l p e0 e1) = Cond l <$> bM p <*> bM e0 <*> bM e1 bM e@Column{} = pure e; bM e@IParseCol{} = pure e; bM e@FParseCol{} = pure e; bM e@AllField{} = pure e-bM e@LastField{} = pure e; bM e@Field{} = pure e; bM e@ParseCol{} = pure e; bM e@AllColumn{} = pure e; bM e@RC{} = pure e-bM e@ILit{} = pure e; bM e@FLit{} = pure e; bM e@StrLit{} = pure e; bM e@RegexLit{} = pure e; bM e@BLit{} = pure e+bM e@LastField{} = pure e; bM e@Field{} = pure e; bM e@FieldList{} = pure e; bM e@ParseCol{} = pure e+bM e@AllColumn{} = pure e; bM e@FParseAllCol{} = pure e; bM e@IParseAllCol{} = pure e; bM e@ParseAllCol{} = pure e+bM e@RC{} = pure e; bM e@Lit{} = pure e; bM e@RegexLit{} = pure e bM e@BB{} = pure e; bM e@NB{} = pure e; bM e@UB{} = pure e; bM e@TB{} = pure e bM ResVar{} = desugar; bM Dfn{} = desugar; bM Paren{} = desugar  iE :: E T -> RM T (E T) iE e@NB{} = pure e; iE e@UB{} = pure e; iE e@BB{} = pure e; iE e@TB{} = pure e iE e@Column{} = pure e; iE e@ParseCol{} = pure e; iE e@IParseCol{} = pure e; iE e@FParseCol{} = pure e-iE e@Field{} = pure e; iE e@LastField{} = pure e; iE e@AllField{} = pure e; iE e@AllColumn{} = pure e-iE e@ILit{} = pure e; iE e@FLit{} = pure e; iE e@BLit{} = pure e; iE e@StrLit{} = pure e+iE e@Field{} = pure e; iE e@LastField{} = pure e; iE e@AllField{} = pure e; iE e@FieldList{} = pure e+iE e@AllColumn{} = pure e; iE e@FParseAllCol{} = pure e; iE e@IParseAllCol{} = pure e; iE e@ParseAllCol{} = pure e+iE e@Lit{} = pure e iE e@RegexLit{} = pure e; iE e@RC{} = pure e iE (EApp t e e') = EApp t <$> iE e <*> iE e' iE (Guarded t p e) = Guarded t <$> iE p <*> iE e
src/File.hs view
@@ -65,6 +65,8 @@  type FileBS = BS.ByteString +tcompile=compileDefault.encodeUtf8+ compileR :: FileBS          -> E T          -> E T@@ -83,37 +85,42 @@             in eB j pure (compileR (error "nf not defined.") inlined)  compileFS :: Maybe T.Text -> RurePtr-compileFS (Just bs) = compileDefault (encodeUtf8 bs)-compileFS Nothing   = defaultRurePtr+compileFS = maybe defaultRurePtr tcompile  runOnBytes :: [FilePath]            -> FilePath -- ^ Data file name, for @nf@            -> T.Text -- ^ Program            -> Maybe T.Text -- ^ Field separator+           -> Maybe T.Text -- ^ Record separator            -> BSL.ByteString            -> IO ()-runOnBytes incls fp src cliFS contents = do+runOnBytes incls fp src cliFS cliRS contents = do     incls' <- defaultIncludes <*> pure incls     (ast, m) <- parseEWithMax incls' src     (typed, i) <- yIO $ runTyM m (tyP ast)     let (eI, j) = ib i typed     m'Throw $ cF eI-    cont <- yIO $ runJac (compileFS (cliFS <|> getFS ast)) (flushD typed) j (compileR (encodeUtf8 $ T.pack fp) eI)-    cont $ fmap BSL.toStrict (ASCIIL.lines contents)+    let ~(afs, ars) = getS ast+    cont <- yIO $ runJac (compileFS (cliFS <|> afs)) (flushD typed) j (compileR (encodeUtf8 $ T.pack fp) eI)+    case cliRS <|> ars of+        Nothing -> cont $ fmap BSL.toStrict (ASCIIL.lines contents)+        Just rs -> cont $ lazySplit (tcompile rs) contents  runOnHandle :: [FilePath]             -> T.Text -- ^ Program             -> Maybe T.Text -- ^ Field separator+            -> Maybe T.Text -- ^ Record separator             -> Handle             -> IO ()-runOnHandle is src cliFS = runOnBytes is "(runOnBytes)" src cliFS <=< BSL.hGetContents+runOnHandle is src cliFS cliRS = runOnBytes is "(runOnBytes)" src cliFS cliRS <=< BSL.hGetContents  runOnFile :: [FilePath]           -> T.Text           -> Maybe T.Text+          -> Maybe T.Text           -> FilePath           -> IO ()-runOnFile is e fs fp = runOnBytes is fp e fs =<< BSL.readFile fp+runOnFile is e fs rs fp = runOnBytes is fp e fs rs =<< BSL.readFile fp  tcIO :: [FilePath] -> T.Text -> IO () tcIO incls src = do
src/Jacinda/Backend/Const.hs view
@@ -5,13 +5,13 @@ import           Ty.Const  mkI :: Integer -> E T-mkI = ILit tyI+mkI = Lit tyI.ILit  mkF :: Double -> E T-mkF = FLit tyF+mkF = Lit tyF.FLit  mkB :: Bool -> E T-mkB = BLit tyB+mkB = Lit tyB.BLit  mkStr :: BS.ByteString -> E T-mkStr = StrLit tyStr+mkStr = Lit tyStr.StrLit
src/Jacinda/Backend/P.hs view
@@ -9,15 +9,14 @@ import           Control.Monad.State.Strict (State, evalState, get, modify, runState) import           Data.Bifunctor             (bimap) import qualified Data.ByteString            as BS-import qualified Data.ByteString.Char8      as ASCII import           Data.Containers.ListUtils  (nubOrdOn) import           Data.Foldable              (traverse_) import qualified Data.IntMap                as IM import           Data.List                  (scanl', transpose, uncons, unzip4) import           Data.Maybe                 (catMaybes, mapMaybe)-import           Data.Semigroup             ((<>)) import qualified Data.Vector                as V import           Data.Word                  (Word8)+import           Foreign.C.String           (CString) import           Jacinda.Backend.Const import           Jacinda.Backend.Parse import           Jacinda.Backend.Printf@@ -28,11 +27,12 @@ import           Prettyprinter.Render.Text  (putDoc) import           Regex.Rure                 (RureMatch (RureMatch), RurePtr) import           System.IO                  (hFlush, stdout)+import           System.IO.Unsafe           (unsafeDupablePerformIO) import           Ty.Const import           U  φ1 :: E T -> Int-φ1 (BB (TyArr _ (TyArr (TyApp (TyB TyStream) _) _)) Fold1) = 1+φ1 (BB (TyArr _ (TyArr (TyB TyStream:$_) _)) Fold1) = 1 φ1 (EApp _ e0 e1)                                          = φ1 e0+φ1 e1 φ1 (Tup _ es)                                              = sum (φ1<$>es) φ1 (OptionVal _ (Just e))                                  = φ1 e@@ -42,7 +42,7 @@   φ :: E T -> Int-φ (TB (TyArr _ (TyArr _ (TyArr (TyApp (TyB TyStream) _) _))) Fold) = 1+φ (TB (TyArr _ (TyArr _ (TyArr (TyB TyStream:$_) _))) Fold) = 1 φ (EApp _ e0 e1)                                                   = φ e0+φ e1 φ (Tup _ es)                                                       = sum (φ<$>es) φ (OptionVal _ (Just e))                                           = φ e@@ -77,14 +77,16 @@ v ! ix = case v V.!? ix of {Just x  -> x; Nothing -> throw $ IndexOutOfBounds ix}  parseAsEInt :: BS.ByteString -> E T-parseAsEInt = mkI . readDigits+parseAsEInt = mkI.readDigits  parseAsF :: BS.ByteString -> E T-parseAsF = FLit tyF . readFloat+parseAsF = mkF.readFloat  readFloat :: BS.ByteString -> Double-readFloat = read . ASCII.unpack+readFloat = unsafeDupablePerformIO . (`BS.useAsCString` atof) +foreign import ccall unsafe atof :: CString -> IO Double+ the :: BS.ByteString -> Word8 the bs = case BS.uncons bs of     Nothing                -> error "Empty splitc char!"@@ -118,7 +120,7 @@           allHeads = foldr seq ()  gf :: E T -> State (Int, [(Int, E T, E T, E T)]) (E T)-gf (EApp _ (EApp _ (EApp _ (TB _ Fold) op) seed) stream) | t@(TyApp (TyB TyStream) _) <- eLoc stream = do+gf (EApp _ (EApp _ (EApp _ (TB _ Fold) op) seed) stream) | t@(TyB TyStream:$_) <- eLoc stream = do     (i,_) <- get     modify (bimap (+1) ((i, op, seed, stream) :))     pure $ mkFoldVar i t@@ -129,7 +131,7 @@ gf (Cond ty p e e') = Cond ty <$> gf p <*> gf e <*> gf e' gf (Lam t n e) = Lam t n <$> gf e gf e@BB{} = pure e; gf e@TB{} = pure e; gf e@UB{} = pure e; gf e@NB{} = pure e-gf e@StrLit{} = pure e; gf e@FLit{} = pure e; gf e@ILit{} = pure e; gf e@BLit{} = pure e+gf e@Lit{} = pure e gf e@RC{} = pure e; gf e@Var{} = pure e  ug :: IM.IntMap (E T) -> E T -> E T@@ -145,7 +147,7 @@ bsProcess _ _ _ AllField{} = Left NakedField bsProcess _ _ _ Field{}    = Left NakedField bsProcess _ _ _ (NB _ Ix)  = Left NakedField-bsProcess r f u e | (TyApp (TyB TyStream) _) <- eLoc e = Right (pS f.eStream u r e)+bsProcess r f u e | (TyB TyStream:$_) <- eLoc e = Right (pS f.eStream u r e) bsProcess r f u (Anchor _ es) = Right (\bs -> pS f $ takeConcatMap (\e -> eStream u r e bs) es) bsProcess r _ u e =     Right $ \bs -> pDocLn (eF u r e bs)@@ -200,19 +202,23 @@ eStream i r (EApp _ (UB _ CatMaybes) e) bs = mapMaybe asM$eStream i r e bs eStream u r (Implicit _ e) bs = zipWith (\fs i -> eB u (pure.eCtx fs i) e) [(b, splitBy r b) | b <- bs] [1..] eStream _ _ AllColumn{} bs = mkStr<$>bs+eStream _ _ IParseAllCol{} bs = parseAsEInt<$>bs+eStream _ _ FParseAllCol{} bs = parseAsF<$>bs+eStream _ _ (ParseAllCol (_:$TyB TyInteger)) bs = parseAsEInt<$>bs+eStream _ _ (ParseAllCol (_:$TyB TyFloat)) bs = parseAsF<$>bs eStream _ r (Column _ i) bs = mkStr.(! (i-1)).splitBy r<$>bs eStream _ r (IParseCol _ n) bs = [parseAsEInt (splitBy r b ! (n-1)) | b <- bs]-eStream _ r (ParseCol (TyApp _ (TyB TyInteger)) n) bs = [parseAsEInt (splitBy r b ! (n-1)) | b <- bs]+eStream _ r (ParseCol (_:$TyB TyInteger) n) bs = [parseAsEInt (splitBy r b ! (n-1)) | b <- bs] eStream _ r (FParseCol _ n) bs = [parseAsF (splitBy r b ! (n-1)) | b <- bs]-eStream _ r (ParseCol (TyApp _ (TyB TyFloat)) n) bs = [parseAsF (splitBy r b ! (n-1)) | b <- bs]+eStream _ r (ParseCol (_:$TyB TyFloat) n) bs = [parseAsF (splitBy r b ! (n-1)) | b <- bs] eStream i r (EApp _ (EApp _ (BB _ MapMaybe) f) e) bs = let xs = eStream i r e bs in mapMaybe (asM.c1 i f) xs eStream i r (EApp _ (EApp _ (BB _ Map) f) e) bs = let xs=eStream i r e bs in fmap (c1 i f) xs eStream i r (EApp _ (EApp _ (BB _ Prior) op) e) bs = let xs=eStream i r e bs in zipWith (c2 i op) (tail xs) xs eStream i r (EApp _ (EApp _ (BB _ Filter) p) e) bs = let xs=eStream i r e bs; ps=fmap (asB.c1 i p) xs in [x | (pϵ,x) <- zip ps xs, pϵ] eStream i r (EApp _ (EApp _ (EApp _ (TB _ ZipW) f) e0) e1) bs = let xs0=eStream i r e0 bs; xs1=eStream i r e1 bs in zipWith (c2 i f) xs0 xs1-eStream i r (EApp (TyApp _ (TyB TyStr)) (UB _ Dedup) e) bs = let s = eStream i r e bs in nubOrdOn asS s-eStream i r (EApp (TyApp _ (TyB TyInteger)) (UB _ Dedup) e) bs = let s = eStream i r e bs in nubOrdOn asI s-eStream i r (EApp (TyApp _ (TyB TyFloat)) (UB _ Dedup) e) bs = let s = eStream i r e bs in nubOrdOn asF s+eStream i r (EApp (_:$TyB TyStr) (UB _ Dedup) e) bs = let s = eStream i r e bs in nubOrdOn asS s+eStream i r (EApp (_:$TyB TyInteger) (UB _ Dedup) e) bs = let s = eStream i r e bs in nubOrdOn asI s+eStream i r (EApp (_:$TyB TyFloat) (UB _ Dedup) e) bs = let s = eStream i r e bs in nubOrdOn asF s eStream i r (EApp _ (EApp _ (BB _ DedupOn) op) e) bs | TyArr _ (TyB TyStr) <- eLoc op = let xs = eStream i r e bs in nubOrdOn (asS.c1 i op) xs eStream i r (EApp _ (EApp _ (BB _ DedupOn) op) e) bs | TyArr _ (TyB TyInteger) <- eLoc op = let xs = eStream i r e bs in nubOrdOn (asI.c1 i op) xs eStream i r (EApp _ (EApp _ (BB _ DedupOn) op) e) bs | TyArr _ (TyB TyFloat) <- eLoc op = let xs = eStream i r e bs in nubOrdOn (asF.c1 i op) xs@@ -221,13 +227,13 @@     in catMaybes $ zipWith (\fs i -> if asB (eB u (pure.eCtx fs i) p) then Just (eB u (pure.eCtx fs i) e) else Nothing) bss [1..]  asS :: E T -> BS.ByteString-asS (StrLit _ s) = s; asS e = throw (InternalCoercionError e TyStr)+asS (Lit _ (StrLit s)) = s; asS e = throw (InternalCoercionError e TyStr)  asI :: E T -> Integer-asI (ILit _ i) = i; asI e = throw (InternalCoercionError e TyInteger)+asI (Lit _ (ILit i)) = i; asI e = throw (InternalCoercionError e TyInteger)  asF :: E T -> Double-asF (FLit _ x) = x; asF e = throw (InternalCoercionError e TyFloat)+asF (Lit _ (FLit x)) = x; asF e = throw (InternalCoercionError e TyFloat)  asR :: E T -> RurePtr asR (RC r) = r; asR e = throw (InternalCoercionError e TyR)@@ -236,7 +242,7 @@ asM (OptionVal _ e) = e; asM e = throw (InternalCoercionError e TyOption)  asB :: E T -> Bool-asB (BLit _ b) = b; asB e = throw (InternalCoercionError e TyBool)+asB (Lit _ (BLit b)) = b; asB e = throw (InternalCoercionError e TyBool)  asV :: E T -> V.Vector (E T) asV (Arr _ v) = v; asV e = throw (InternalCoercionError e TyVec)@@ -244,12 +250,16 @@ asT :: E T -> [E T] asT (Tup _ es) = es; asT e = throw (ExpectedTup e) +vS :: V.Vector BS.ByteString -> E T+vS = Arr (tyV tyStr).fmap mkStr+ eCtx :: (BS.ByteString, V.Vector BS.ByteString) -- ^ Line, split by field separator      -> Integer -- ^ Line number      -> E T -> E T eCtx ~(f, _) _ AllField{}  = mkStr f eCtx (_, fs) _ (Field _ i) = mkStr (fs ! (i-1)) eCtx (_, fs) _ LastField{} = mkStr (V.last fs)+eCtx (_, fs) _ FieldList{} = vS fs eCtx _ i (NB _ Ix)         = mkI i eCtx (_, fs) _ (NB _ Nf)   = mkI (fromIntegral$V.length fs) eCtx _ _ e                 = e@@ -364,13 +374,13 @@ eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) Exp) x0) x1) = do     x0' <- asF <$> eBM f x0; x1' <- asF<$>eBM f x1     pure (mkF (x0'**x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyApp (TyB TyVec) t) _) Eq) x0) x1) = do+eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyVec:$t) _) Eq) x0) x1) = do     x0' <- asV<$>eBM f x0; x1' <- asV<$>eBM f x1     mkB <$> if V.length x0'==V.length x1'         then all asB <$> V.zipWithM (c2Mϵ f op) x0' x1'         else pure False     where op = BB (TyArr t (TyArr t tyB)) Eq-eBM f (EApp _ (EApp _ (BB (TyArr (TyApp (TyB TyOption) t) _) Eq) x0) x1) = do+eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyOption:$t) _) Eq) x0) x1) = do     x0' <- asM<$>eBM f x0; x1' <- asM<$>eBM f x1     case (x0',x1') of         (Nothing, Nothing) -> pure (mkB True)@@ -396,10 +406,10 @@     pure $ mkB (not$isMatch' r' s') eBM f (EApp _ (EApp _ (BB _ Split) s) r) = do     s' <- asS<$>eBM f s; r' <- asR<$>eBM f r-    pure (Arr (tyV tyStr) (mkStr<$>splitBy r' s'))+    pure (vS (splitBy r' s')) eBM f (EApp _ (EApp _ (BB _ Splitc) s) c) = do     s' <- asS<$>eBM f s; c' <- the.asS<$>eBM f c-    pure (Arr (tyV tyStr) (mkStr <$> V.fromList (BS.split c' s')))+    pure (vS (V.fromList (BS.split c' s'))) eBM f (EApp _ (UB _ FParse) x) = do {x' <- eBM f x; pure (parseAsF (asS x'))} eBM f (EApp _ (UB _ IParse) x) = do {x' <- eBM f x; pure (parseAsEInt (asS x'))} eBM f (EApp (TyB TyInteger) (UB _ Parse) x) = do {x' <- eBM f x; pure (parseAsEInt (asS x'))}@@ -427,17 +437,17 @@ eBM f (EApp _ (EApp _ (BB _ Match) s) r) = do     s' <- eBM f s; r' <- eBM f r     pure $ asTup (find' (asR r') (asS s'))-eBM f (EApp _ (EApp _ (EApp _ (TB _ Fold) op) seed) xs) | TyApp (TyB TyVec) _ <- eLoc xs = do+eBM f (EApp _ (EApp _ (EApp _ (TB _ Fold) op) seed) xs) | TyB TyVec:$_ <- eLoc xs = do     op' <- eBM f op; seed' <- eBM f seed; xs' <- eBM f xs     V.foldM (c2Mϵ f op') seed' (asV xs')-eBM f (EApp _ (EApp _ (BB _ Fold1) op) xs) | TyApp (TyB TyVec) _ <- eLoc xs = do+eBM f (EApp _ (EApp _ (BB _ Fold1) op) xs) | TyB TyVec:$_ <- eLoc xs = do     op' <- eBM f op; xs' <- eBM f xs     let xsV=asV xs'; Just (seed, xs'') = V.uncons xsV     V.foldM (c2Mϵ f op') seed xs''-eBM f (EApp yT@(TyApp (TyB TyOption) _) (EApp _ (BB _ Map) g) x) = do+eBM f (EApp yT@(TyB TyOption:$_) (EApp _ (BB _ Map) g) x) = do     g' <- eBM f g; x' <- eBM f x     OptionVal yT <$> traverse (eBM f <=< a1 g') (asM x')-eBM f (EApp yT@(TyApp (TyB TyVec) _) (EApp _ (BB _ Map) g) x) = do+eBM f (EApp yT@(TyB TyVec:$_) (EApp _ (BB _ Map) g) x) = do     g' <- eBM f g; x' <- eBM f x     Arr yT <$> traverse (eBM f <=< a1 g') (asV x') eBM f (EApp t (EApp _ (EApp _ (TB _ Option) x) g) y) = do
src/Jacinda/Backend/Printf.hs view
@@ -5,7 +5,6 @@  import           A import qualified Data.ByteString    as BS-import           Data.Semigroup     ((<>)) import qualified Data.Text          as T import           Data.Text.Encoding (decodeUtf8, encodeUtf8) @@ -19,20 +18,20 @@ -- TODO: interpret precision, like %0.6f %.6  sprintf' :: T.Text -> E a -> T.Text-sprintf' fmt (FLit _ f) =+sprintf' fmt (Lit _ (FLit f)) =     let (prefix, fmt') = T.breakOn "%f" fmt         in prefix <> T.pack (show f) <> T.drop 2 fmt'-sprintf' fmt (ILit _ i) =+sprintf' fmt (Lit _ (ILit i)) =     let (prefix, fmt') = T.breakOn "%i" fmt         in prefix <> T.pack (show i) <> T.drop 2 fmt'-sprintf' fmt (StrLit _ bs) =+sprintf' fmt (Lit _ (StrLit bs)) =     let (prefix, fmt') = T.breakOn "%s" fmt         in prefix <> decodeUtf8 bs <> T.drop 2 fmt' sprintf' fmt (Tup _ [e]) = sprintf' fmt e sprintf' fmt (Tup l (e:es)) =     let nextFmt = sprintf' fmt e         in sprintf' nextFmt (Tup l es)-sprintf' fmt (BLit _ b) =+sprintf' fmt (Lit _ (BLit b)) =     let (prefix, fmt') = T.breakOn "%b" fmt         in prefix <> showBool b <> T.drop 2 fmt'     where showBool True  = "true"
src/Jacinda/Check/Field.hs view
@@ -20,11 +20,12 @@  cF :: E T -> Maybe LErr cF e@(Tup (TyTup ts) _) | any isS ts = Just (TS e)-cF e@Field{} = Just (NF e); cF e@AllField{} = Just (NF e); cF e@LastField{} = Just (NF e)+cF e@Field{} = Just (NF e); cF e@AllField{} = Just (NF e); cF e@LastField{} = Just (NF e); cF e@FieldList{} = Just (NF e) cF e@(NB _ Ix) = Just (NF e); cF e@(NB _ Nf) = Just (NF e) cF IParseCol{} = Nothing; cF FParseCol{} = Nothing; cF ParseCol{} = Nothing; cF Column{} = Nothing-cF AllColumn{} = Nothing; cF Guarded{} = Nothing; cF Implicit{} = Nothing; cF ILit{} = Nothing-cF BLit{} = Nothing; cF RegexLit{} = Nothing; cF FLit{} = Nothing; cF StrLit{} = Nothing+cF AllColumn{} = Nothing; cF FParseAllCol{} = Nothing; cF IParseAllCol{} = Nothing; cF ParseAllCol{} = Nothing+cF Guarded{} = Nothing; cF Implicit{} = Nothing+cF Lit{} = Nothing; cF RegexLit{} = Nothing; cF NB{} = Nothing; cF UB{} = Nothing; cF BB{} = Nothing; cF TB{} = Nothing cF Var{} = Nothing; cF (Tup _ es) = foldMapAlternative cF es; cF (Anchor _ es) = foldMapAlternative cF es cF (Arr _ es) = foldMapAlternative cF es; cF (EApp _ e e') = cF e <|> cF e'@@ -34,7 +35,7 @@ cF Dfn{} = desugar; cF Paren{} = desugar; cF ResVar{} = desugar  isS :: T -> Bool-isS (TyApp (TyB TyStream) _) = True; isS _ = False+isS (TyB TyStream:$_) = True; isS _ = False  foldMapAlternative :: (Traversable t, Alternative f) => (a -> f b) -> t a -> f b foldMapAlternative f xs = asum (f <$> xs)
src/Jacinda/Fuse.hs view
@@ -14,7 +14,7 @@ -- also "filter-of-fold1" b/c we need to pick a seed that isn't filtered.  fM :: E T -> M (E T)-fM (EApp t0 (EApp t1 (EApp t2 ho@(TB _ Fold) op) seed) stream) | TyApp (TyB TyStream) _ <- eLoc stream = do+fM (EApp t0 (EApp t1 (EApp t2 ho@(TB _ Fold) op) seed) stream) | TyB TyStream :$ _ <- eLoc stream = do     stream' <- fM stream     case stream' of         (EApp _ (EApp _ (BB _ Filter) p) xs) -> do@@ -33,18 +33,18 @@                 (TyArr sTy _) = eLoc op             s <- nN "seed" sTy; x <- nN "x" xTy             let sE=Var sTy s; xE=Var xTy x-                popT=TyArr xTy sTy; fopT=TyArr sTy popT+                popT=xTy ~> sTy; fopT=sTy ~> popT                 fop=Lam fopT s (Lam popT x (EApp undefined (EApp undefined op sE) (EApp yTy f xE)))-            fM (EApp sTy (EApp undefined (EApp undefined (TB (TyArr fopT (TyArr sTy (TyArr (TyApp (TyB TyStream) xTy) sTy))) Fold) fop) seed) xs)+            fM (EApp sTy (EApp undefined (EApp undefined (TB (fopT ~> (sTy ~> TyArr (TyB TyStream :$ xTy) sTy)) Fold) fop) seed) xs)         (EApp _ (EApp _ (BB _ MapMaybe) f) xs) -> do             -- op | seed (f:?xs) -> [option x (x `op`) (f y)] | seed xs             let TyArr xT yT=eLoc f                 sT=eLoc seed             s <- nN "seed" sT; x <- nN "x" xT             let sE=Var sT s; xE=Var xT x-                popT=TyArr xT sT; fopT=TyArr sT popT-                fop=Lam fopT s (Lam popT x (EApp sT (EApp undefined (EApp undefined (TB (TyArr sT (TyArr undefined (TyArr yT sT))) Option) sE) (EApp undefined op sE)) (EApp yT f xE)))-            fM (EApp sT (EApp undefined (EApp undefined (TB (TyArr fopT (TyArr sT (TyArr (TyApp (TyB TyStream) xT) sT))) Fold) fop) seed) xs)+                popT=xT ~> sT; fopT=sT ~> popT+                fop=Lam fopT s (Lam popT x (EApp sT (EApp undefined (EApp undefined (TB (sT ~> TyArr undefined (yT ~> sT)) Option) sE) (EApp undefined op sE)) (EApp yT f xE)))+            fM (EApp sT (EApp undefined (EApp undefined (TB (TyArr fopT (TyArr sT (TyArr (TyB TyStream :$ xT) sT))) Fold) fop) seed) xs)         (EApp _ (UB _ CatMaybes) xs) -> do             -- op | seed (.? xs) -> [option x (x `op`) y] | seed xs             let TyArr _ (TyArr xTy _)=eLoc op@@ -52,9 +52,9 @@                 sTy=eLoc seed             s <- nN "seed" sTy; x <- nN "x" xMT             let sE=Var sTy s; xE=Var xMT x-                popT=TyArr xMT sTy; fopT=TyArr sTy popT-                fop=Lam fopT s (Lam popT x (EApp sTy (EApp undefined (EApp undefined (TB (TyArr sTy (TyArr undefined (TyArr xMT sTy))) Option) sE) (EApp undefined op sE)) xE))-            fM (EApp sTy (EApp undefined (EApp undefined (TB (TyArr fopT (TyArr sTy (TyArr (TyApp (TyB TyStream) xMT) sTy))) Fold) fop) seed) xs)+                popT=xMT ~> sTy; fopT=sTy ~> popT+                fop=Lam fopT s (Lam popT x (EApp sTy (EApp undefined (EApp undefined (TB (sTy ~> TyArr undefined (xMT ~> sTy)) Option) sE) (EApp undefined op sE)) xE))+            fM (EApp sTy (EApp undefined (EApp undefined (TB (fopT ~> (sTy ~> TyArr (TyB TyStream :$ xMT) sTy)) Fold) fop) seed) xs)         _ -> pure (EApp t0 (EApp t1 (EApp t2 ho op) seed) stream') fM (Tup t es) = Tup t <$> traverse fM es fM (EApp t e0 e1) = EApp t <$> fM e0 <*> fM e1
src/Jacinda/Regex.hs view
@@ -1,7 +1,8 @@ {-# LANGUAGE OverloadedLists   #-} {-# LANGUAGE OverloadedStrings #-} -module Jacinda.Regex ( splitBy+module Jacinda.Regex ( lazySplit+                     , splitBy                      , defaultRurePtr                      , isMatch'                      , find'@@ -14,11 +15,11 @@ import           Control.Exception        (Exception, throwIO) import           Control.Monad            ((<=<)) import qualified Data.ByteString.Internal as BS-import           Data.Semigroup           ((<>))+import qualified Data.ByteString.Lazy     as BSL import qualified Data.Vector              as V import           Foreign.C.Types          (CSize) import           Foreign.ForeignPtr       (plusForeignPtr)-import           Regex.Rure               (RureMatch (..), RurePtr, captures, compile, find, findCaptures, isMatch, matches', rureDefaultFlags, rureFlagDotNL)+import           Regex.Rure               (RureFlags, RureMatch (..), RurePtr, captures, compile, find, findCaptures, isMatch, matches', rureDefaultFlags, rureFlagDotNL) import           System.IO.Unsafe         (unsafeDupablePerformIO, unsafePerformIO)  -- https://docs.rs/regex/latest/regex/#perl-character-classes-unicode-friendly@@ -28,8 +29,10 @@ {-# NOINLINE defaultRurePtr #-} defaultRurePtr :: RurePtr defaultRurePtr = unsafePerformIO $ yIO =<< compile genFlags defaultFs-    where genFlags = rureDefaultFlags <> rureFlagDotNL -- in case they want to use a custom record separator +genFlags :: RureFlags+genFlags = rureDefaultFlags <> rureFlagDotNL -- in case they want to use a custom record separator+ substr :: BS.ByteString -> Int -> Int -> BS.ByteString substr (BS.BS fp l) begin endϵ | endϵ >= begin = BS.BS (fp `plusForeignPtr` begin) (min l endϵ-begin)                                | otherwise = "error: invalid substring indices."@@ -53,14 +56,32 @@ find' :: RurePtr -> BS.ByteString -> Maybe RureMatch find' re str = unsafeDupablePerformIO $ find re str 0 --- FIXME: splitBy '\s+' '' should be [] not ['']+lazySplit :: RurePtr -> BSL.ByteString -> [BS.ByteString]+lazySplit rp bs = let c=BSL.toChunks bs in go Nothing c+        where go Nothing []      = []+              go Nothing (c:cs)  = let ss=splitByA rp c+                    in case unsnoc ss of+                        Just (iss,lss) -> iss++go (Just lss) cs+                        Nothing        -> go Nothing cs+              go (Just c) []     = let ss=splitByA rp c in ss+              go (Just e) (c:cs) = let ss=splitByA rp (e<>c)+                    in case unsnoc ss of+                        Just (iss,lss) -> iss++go (Just lss) cs+                        Nothing        -> go Nothing cs++unsnoc :: [a] -> Maybe ([a], a)+unsnoc = foldr (\x acc -> Just $ case acc of {Nothing -> ([], x); Just ~(a, b) -> (x:a, b)}) Nothing++splitBy :: RurePtr -> BS.ByteString -> V.Vector BS.ByteString+splitBy = (V.fromList .) . splitByA+ {-# NOINLINE splitBy #-}-splitBy :: RurePtr+splitByA :: 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+        -> [BS.ByteString]+splitByA _ "" = mempty+splitByA re haystack@(BS.BS fp l) =+    [BS.BS (fp `plusForeignPtr` s) (e-s) | (s, e) <- slicePairs]     where ixes = unsafeDupablePerformIO $ matches' re haystack           slicePairs = case ixes of                 (RureMatch 0 i:rms) -> mkMiddle (fromIntegral i) rms@@ -74,7 +95,7 @@ isMatch' re haystack = unsafeDupablePerformIO $ isMatch re haystack 0  compileDefault :: BS.ByteString -> RurePtr-compileDefault = unsafeDupablePerformIO . (yIO <=< compile rureDefaultFlags) -- TODO: rureFlagDotNL+compileDefault = unsafeDupablePerformIO . (yIO <=< compile genFlags)  newtype RureExe = RegexCompile String deriving (Show)
src/L.x view
@@ -22,7 +22,6 @@ import Data.Functor (($>)) import qualified Data.IntMap as IM import qualified Data.Map as M-import Data.Semigroup ((<>)) import qualified Data.Text as T import Nm import Prettyprinter (Pretty (pretty), (<+>), colon, squotes)@@ -44,6 +43,10 @@  @string = \' ([^ $str_special] | @escape_str)* \' +@escape_rr = \\ [\\\/]++@rr = "/" ([^\/] | @escape_rr)* "/"+ @name = [a-z] @follow_char* @tyname = [A-Z] @follow_char* @@ -124,6 +127,7 @@         "~*"                     { mkSym CapTok }         "-."                     { mkSym NegTok }         "`*"                     { mkSym LastFieldTok }+        "`$"                     { mkSym FieldListTok }          in                       { mkKw KwIn }         let                      { mkKw KwLet }@@ -138,6 +142,7 @@         else                     { mkKw KwElse }          fs                       { mkRes VarFs }+        rs                       { mkRes VarRs }         ix                       { mkRes VarIx }         ⍳                        { mkRes VarIx }         nf                       { mkRes VarNf }@@ -184,7 +189,7 @@         @string                  { tok (\p s -> alex $ TokStr p (escReplace $ T.init $ T.tail s)) }          -- TODO: allow chars to be escaped-        "/"[^\/]*"/"             { tok (\p s -> alex $ TokRR p (T.init $ T.tail s)) }+        @rr                      { tok (\p s -> alex $ TokRR p (escRr $ T.init $ T.tail s)) }          @name                    { tok (\p s -> TokName p <$> newIdentAlex p s) }         @tyname                  { tok (\p s -> TokTyName p <$> newIdentAlex p s) }@@ -218,6 +223,9 @@     . T.replace "\\n" "\n"     . T.replace "\\t" "\t" +escRr :: T.Text -> T.Text+escRr = T.replace "\\/" "/"+ instance Pretty AlexPosn where     pretty (AlexPn _ line col) = pretty line <> colon <> pretty col @@ -230,16 +238,9 @@ gets_alex :: (AlexState -> a) -> Alex a gets_alex f = Alex (Right . (id &&& f)) -get_ust :: Alex AlexUserState-get_ust = gets_alex alex_ust- get_pos :: Alex AlexPosn get_pos = gets_alex alex_pos -set_ust :: AlexUserState -> Alex ()-set_ust st = Alex (Right . (go &&& (const ())))-    where go s = s { alex_ust = st }- alexEOF = EOF <$> get_pos  data Sym = PlusTok@@ -292,6 +293,7 @@          | CapTok          | NegTok          | LastFieldTok+         | FieldListTok  instance Pretty Sym where     pretty PlusTok       = "+"@@ -344,6 +346,7 @@     pretty CapTok        = "~*"     pretty NegTok        = "-."     pretty LastFieldTok  = "`*"+    pretty FieldListTok  = "`$"  data Keyword = KwLet              | KwIn@@ -361,6 +364,7 @@ data Var = VarX          | VarY          | VarFs+         | VarRs          | VarIx          | VarMin          | VarMax@@ -370,6 +374,7 @@     pretty VarX     = "x"     pretty VarY     = "y"     pretty VarFs    = "fs"+    pretty VarRs    = "rs"     pretty VarIx    = "⍳"     pretty VarNf    = "nf"     pretty VarMin   = "min"@@ -474,9 +479,9 @@  newIdentAlex :: AlexPosn -> T.Text -> Alex (Nm AlexPosn) newIdentAlex pos t = do-    st <- get_ust+    st <- alexGetUserState     let (st', n) = newIdent pos t st-    set_ust st' $> (n $> pos)+    alexSetUserState st' $> (n $> pos)  newIdent :: AlexPosn -> T.Text -> AlexUserState -> (AlexUserState, Nm AlexPosn) newIdent pos t pre@(max', names, uniqs) =
src/Parser.y view
@@ -102,7 +102,8 @@     allField { TokFieldLit $$ 0 }     column { $$@(TokStreamLit _ _) }     field { $$@(TokFieldLit _ _) }-    lastField { TokSym $$ LastFieldTok } -- TokSym is maybe insensible but whatever+    lastField { TokSym $$ LastFieldTok }+    listField { TokSym $$ FieldListTok }      let { TokKeyword $$ KwLet }     in { TokKeyword $$ KwIn }@@ -124,6 +125,7 @@     ix { TokResVar $$ VarIx }     nf { TokResVar $$ VarNf }     fs { TokResVar $$ VarFs }+    rs { TokResVar $$ VarRs }      split { TokBuiltin $$ BuiltinSplit }     splitc { TokBuiltin $$ BuiltinSplitc }@@ -149,9 +151,9 @@      rr { $$@(TokRR _ _) } -%right const-%left paren iParse fParse %nonassoc leq geq gt lt neq eq+%left plus minus+%left times percent  %% @@ -206,6 +208,7 @@  D :: { D AlexPosn }   : set fs defEq rr semicolon { SetFS (rr $4) }+  | set rs defEq rr semicolon { SetRS (rr $4) }   | flush semicolon { FlushDecl }   | fn name Args defEq E semicolon { FunDecl $2 $3 $5 }   | fn name defEq E semicolon { FunDecl $2 [] $4 }@@ -221,18 +224,20 @@  Program :: { Program AlexPosn }         : many(D) E { Program (reverse $1) $2 }+          E :: { E AlexPosn }   : name { Var (Nm.loc $1) $1 }-  | intLit { ILit (loc $1) (int $1) }-  | floatLit { FLit (loc $1) (float $1) }-  | boolLit { BLit (loc $1) (boolTok $1) }-  | strLit { StrLit (loc $1) (encodeUtf8 $ strTok $1) }+  | intLit { Lit (loc $1) (ILit (int $1)) }+  | floatLit { Lit (loc $1) (FLit (float $1)) }+  | boolLit { Lit (loc $1) (BLit (boolTok $1)) }+  | strLit { Lit (loc $1) (StrLit (encodeUtf8 $ strTok $1)) }   | column { Column (loc $1) (ix $1) }   | field { Field (loc $1) (ix $1) }   | allColumn { AllColumn $1 }   | allField { AllField $1 }   | lastField { LastField $1 }+  | listField { FieldList $1 }   | field iParse { EApp (loc $1) (UB $2 IParse) (Field (loc $1) (ix $1)) }   | field fParse { EApp (loc $1) (UB $2 FParse) (Field (loc $1) (ix $1)) }   | name iParse { EApp (Nm.loc $1) (UB $2 IParse) (Var (Nm.loc $1) $1) }@@ -242,6 +247,9 @@   | lastField iParse { EApp $1 (UB $2 IParse) (LastField $1) }   | lastField fParse { EApp $1 (UB $2 FParse) (LastField $1) }   | lastField colon { EApp $1 (UB $2 Parse) (LastField $1) }+  | allField fParse { EApp $1 (UB $2 FParse) (AllField $1) }+  | allField iParse { EApp $1 (UB $2 IParse) (AllField $1) }+  | allField colon { EApp $1 (UB $2 Parse) (AllField $1) }   | x colon { EApp $1 (UB $2 Parse) (ResVar $1 X) }   | y colon { EApp $1 (UB $2 Parse) (ResVar $1 Y) }   | x iParse { EApp $1 (UB $2 IParse) (ResVar $1 X) }@@ -251,6 +259,9 @@   | column iParse { IParseCol (loc $1) (ix $1) }   | column fParse { FParseCol (loc $1) (ix $1) }   | column colon { ParseCol (loc $1) (ix $1) }+  | allColumn iParse { IParseAllCol $1 }+  | allColumn fParse { FParseAllCol $1 }+  | allColumn colon { ParseAllCol $1 }   | parens(iParse) { UB $1 IParse }   | parens(fParse) { UB $1 FParse }   | parens(colon) { UB $1 Parse }
src/Parser/Rw.hs view
@@ -13,47 +13,66 @@ rwD :: D a -> D a rwD (FunDecl n bs e) = FunDecl n bs (rwE e); rwD d = d +mFi :: BBin -> Maybe Int+mFi And        = Just 3+mFi Or         = Just 2+mFi Eq         = Just 4+mFi Geq        = Just 4+mFi Gt         = Just 4+mFi Lt         = Just 4+mFi Leq        = Just 4+mFi Neq        = Just 4+mFi Exp        = Just 8+mFi Plus       = Just 6+mFi Minus      = Just 6+mFi Times      = Just 7+mFi Div        = Just 7+mFi Map        = Just 5+mFi MapMaybe   = Just 5+mFi Filter     = Just 5+mFi Fold1      = Just 5+mFi Matches    = Just 5+mFi NotMatches = Just 5+mFi Min        = Nothing+mFi Max        = Nothing+mFi Split      = Nothing+mFi Splitc     = Nothing+mFi Sprintf    = Nothing+mFi Match      = Nothing+mFi Prior      = Just 5+mFi DedupOn    = Just 5++isPre :: BUn -> Bool+isPre At{}     = False+isPre Select{} = False+isPre IParse   = False+isPre FParse   = False+isPre Parse    = False+isPre _        = True+ rwE :: E a -> E a rwE = cata a where-    a (EAppF l e0@(UB _ Tally) (EApp lϵ (EApp lϵϵ e1@BB{} e2) e3))                      = EApp l (EApp lϵ e1 (EApp lϵϵ e0 e2)) e3-    a (EAppF l e0@(UB _ Const) (EApp lϵ (EApp lϵϵ e1@(BB _ Map) e2) e3))                = EApp l (EApp lϵ e1 (EApp lϵϵ e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Eq) _) (EApp l1 (EApp l2 e1@(BB _ And) e2) e3))         = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Eq) _) (EApp l1 (EApp l2 e1@(BB _ Or) e2) e3))          = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Neq) _) (EApp l1 (EApp l2 e1@(BB _ And) e2) e3))        = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Neq) _) (EApp l1 (EApp l2 e1@(BB _ Or) e2) e3))         = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Gt) _) (EApp l1 (EApp l2 e1@(BB _ And) e2) e3))         = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Gt) _) (EApp l1 (EApp l2 e1@(BB _ Or) e2) e3))          = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Lt) _) (EApp l1 (EApp l2 e1@(BB _ And) e2) e3))         = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Lt) _) (EApp l1 (EApp l2 e1@(BB _ Or) e2) e3))          = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Leq) _) (EApp l1 (EApp l2 e1@(BB _ And) e2) e3))        = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Leq) _) (EApp l1 (EApp l2 e1@(BB _ Or) e2) e3))         = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Geq) _) (EApp l1 (EApp l2 e1@(BB _ And) e2) e3))        = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Geq) _) (EApp l1 (EApp l2 e1@(BB _ Or) e2) e3))         = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Matches) _) (EApp l1 (EApp l2 e1@(BB _ And) e2) e3))    = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Matches) _) (EApp l1 (EApp l2 e1@(BB _ Or) e2) e3))     = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ NotMatches) _) (EApp l1 (EApp l2 e1@(BB _ And) e2) e3)) = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ NotMatches) _) (EApp l1 (EApp l2 e1@(BB _ Or) e2) e3))  = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Fold1) _) (EApp l1 (EApp l2 e1@(BB _ Eq) e2) e3))       = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Fold1) _) (EApp l1 (EApp l2 e1@(BB _ Neq) e2) e3))      = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Fold1) _) (EApp l1 (EApp l2 e1@(BB _ Gt) e2) e3))       = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Fold1) _) (EApp l1 (EApp l2 e1@(BB _ Geq) e2) e3))      = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Fold1) _) (EApp l1 (EApp l2 e1@(BB _ Leq) e2) e3))      = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3-    a (EAppF l e0@(EApp _ (BB _ Fold1) _) (EApp l1 (EApp l2 e1@(BB _ Lt) e2) e3))       = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3+    a (EAppF l e0@(UB _ op) (EApp lϵ (EApp lϵϵ e1@(BB _ bop) e2) e3))+        | Just{} <- mFi bop+        , isPre op && op /= Dedup+                                                                                        = EApp l (EApp lϵ e1 (EApp lϵϵ e0 e2)) e3+    a (EAppF l e0@(EApp _ (BB _ op0) _) (EApp l1 (EApp l2 e1@(BB _ op1) e2) e3))+        | Just f0 <- mFi op0+        , Just f1 <- mFi op1+        , f0 > f1+                                                                                        = EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3     a (EAppF l e0@Var{} (EApp lϵ (EApp lϵϵ e1 e2) e3))                                  = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3     -- TODO rewrite dfn     a (EAppF l e0@Var{} (EApp l0 e1 (EApp l1 (EApp l2 op@BB{} e2) e3)))                 = EApp l1 (EApp l2 op (EApp l (EApp l0 e0 e1) e2)) e3     a (EAppF l e0@Var{} (EApp lϵ e1 e2))                                                = EApp l (EApp lϵ e0 e1) e2-    a (EAppF l e0@(BB _ Max) (EApp lϵ e1 e2))                                           = EApp l (EApp lϵ e0 e1) e2-    a (EAppF l e0@(BB _ Min) (EApp lϵ e1 e2))                                           = EApp l (EApp lϵ e0 e1) e2-    a (EAppF l e0@(BB _ Split) (EApp lϵ e1 e2))                                         = EApp l (EApp lϵ e0 e1) e2-    a (EAppF l e0@(BB _ Match) (EApp lϵ e1 e2))                                         = EApp l (EApp lϵ e0 e1) e2-    a (EAppF l e0@(BB _ Splitc) (EApp lϵ e1 e2))                                        = EApp l (EApp lϵ e0 e1) e2-    a (EAppF l e0@(BB _ Sprintf) (EApp lϵ e1 e2))                                       = EApp l (EApp lϵ e0 e1) e2+    a (EAppF l e0@(BB _ op) (EApp lϵ e1 e2)) | Nothing <- mFi op                        = EApp l (EApp lϵ e0 e1) e2     a (EAppF l e0@(TB _ Substr) (EApp lϵ (EApp lϵϵ e1 e2) e3))                          = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3     a (EAppF l e0@(TB _ Substr) (EApp lϵ e1 (EApp lϵϵ e2 e3)))                          = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3     a (EAppF l e0@(TB _ Option) (EApp lϵ (EApp lϵϵ e1 e2) e3))                          = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3     a (EAppF l e0@(TB _ Option) (EApp lϵ e1 (EApp lϵϵ e2 e3)))                          = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3     a (EAppF l e0@(TB _ Option) (EApp lϵ e1 e2))                                        = EApp l (EApp lϵ e0 e1) e2+    a (EAppF l e0@(TB _ Captures) (EApp lϵ (EApp lϵϵ e1 e2) e3))                        = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3+    a (EAppF l e0@(TB _ Captures) (EApp lϵ e1 (EApp lϵϵ e2 e3)))                        = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3     a (EAppF l e0@(TB _ AllCaptures) (EApp lϵ (EApp lϵϵ e1 e2) e3))                     = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3     a (EAppF l e0@(TB _ AllCaptures) (EApp lϵ e1 (EApp lϵϵ e2 e3)))                     = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3     a (EAppF l (RwB l0 b) (EApp lϵ e1 e2))                                              = EApp l (EApp lϵ (BB l0 b) e1) e2
src/R.hs view
@@ -14,7 +14,7 @@ import qualified Data.IntMap                as IM import qualified Data.Text                  as T import           Lens.Micro                 (Lens', over)-import           Lens.Micro.Mtl             (modifying, use, (%=), (.=))+import           Lens.Micro.Mtl             (use, (%=), (.=)) import           Nm import           U @@ -54,10 +54,22 @@  dummyName :: (MonadState s m, HasRenames s) => a -> T.Text -> m (Nm a) dummyName l n = do+    rename.maxLens %= (+1)     st <- use (rename.maxLens)-    Nm n (U$st+1) l-        <$ modifying (rename.maxLens) (+1)+    pure $ Nm n (U st) l +doLocal :: (HasRenames s, MonadState s m) => m a -> m a+doLocal act = do+    preB <- use (rename.boundLens)+    act <* (rename.boundLens .= preB)++freshen :: (HasRenames s, MonadState s m) => Nm a -> m (Nm a)+freshen (Nm n (U i) l) = do+    rename.maxLens %= (+1)+    nU <- use (rename.maxLens)+    rename.boundLens %= IM.insert i nU+    pure (Nm n (U nU) l)+ withRenames :: (HasRenames s, MonadState s m) => (Renames -> Renames) -> m a -> m a withRenames modSt act = do     preSt <- use rename@@ -67,16 +79,6 @@     rename .= setMax postMax preSt     pure res -withName :: (HasRenames s, MonadState s m) => Nm a -> m (Nm a, Renames -> Renames)-withName (Nm t (U i) l) = do-    m <- use (rename.maxLens)-    let newUniq = m+1-    rename.maxLens .= newUniq-    pure (Nm t (U newUniq) l, mapBound (IM.insert i (m+1)))--mapBound :: (IM.IntMap Int -> IM.IntMap Int) -> Renames -> Renames-mapBound f (Renames m b) = Renames m (f b)- setMax :: Int -> Renames -> Renames setMax i (Renames _ b) = Renames i b @@ -127,9 +129,9 @@ rE (EApp l e e')   = EApp l <$> rE e <*> rE e' rE (Tup l es)      = Tup l <$> traverse rE es rE (Var l n)       = Var l <$> replaceVar n-rE (Lam l n e)     = do-    (n', modR) <- withName n-    Lam l n' <$> withRenames modR (rE e)+rE (Lam l n e)     = doLocal $ do+    n' <- freshen n+    Lam l n' <$> rE e rE (Dfn l e) | {-# SCC "hasY" #-} hasY e = do     x@(Nm nX uX _) <- dummyName l "x"     y@(Nm nY uY _) <- dummyName l "y"@@ -140,10 +142,10 @@ rE (Guarded l p e) = Guarded l <$> rE p <*> rE e rE (Implicit l e) = Implicit l <$> rE e rE ResVar{} = error "Bare reserved variable."-rE (Let l (n, eϵ) e') = do+rE (Let l (n, eϵ) e') = doLocal $ do     eϵ' <- rE eϵ-    (n', modR) <- withName n-    Let l (n', eϵ') <$> withRenames modR (rE e')+    n' <- freshen n+    Let l (n', eϵ') <$> rE e' rE (Paren _ e) = rE e rE (Arr l es) = Arr l <$> traverse rE es rE (Anchor l es) = Anchor l <$> traverse rE es
src/Ty.hs view
@@ -20,7 +20,6 @@ import           Data.Functor               (void, ($>)) import qualified Data.IntMap                as IM import qualified Data.IntSet                as IS-import           Data.Semigroup             ((<>)) import qualified Data.Set                   as S import qualified Data.Text                  as T import           Data.Typeable              (Typeable)@@ -89,7 +88,7 @@         Just ty         -> aT um ty         Nothing         -> Rho n (fmap (aT um) rs) aT _ ty'@TyB{} = ty'-aT um (TyApp ty ty') = TyApp (aT um ty) (aT um ty')+aT um (ty:$ty') = aT um ty :$ aT um ty' aT um (TyArr ty ty') = TyArr (aT um ty) (aT um ty') aT um (TyTup tys)    = TyTup (aT um <$> tys) @@ -115,7 +114,7 @@ occ (TyVar (Nm _ (U i) _))  = IS.singleton i occ TyB{}                   = IS.empty occ (TyTup ts)              = foldMap occ ts-occ (TyApp t t')            = occ t <> occ t'+occ (t:$t')                 = occ t <> occ t' occ (TyArr t t')            = occ t <> occ t' occ (Rho (Nm _ (U i) _) rs) = IS.insert i (foldMap occ (IM.elems rs)) @@ -127,7 +126,7 @@ 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 (TyApp t0 t1) (TyApp 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 (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) = tS_ (\sϵ (i, tϵ) -> IM.insert (unU$unique n) t' <$> mguPrep l sϵ (ts!!(i-1)) tϵ) s (IM.toList rs) mgu l s t@TyTup{} t'@Rho{} = mgu l s t' t@@ -148,14 +147,14 @@ substInt tys k =     case IM.lookup k tys of         Just ty'@TyVar{}     -> Just $ aT (IM.delete k tys) ty'-        Just (TyApp ty0 ty1) -> Just $ let tys'=IM.delete k tys in TyApp (aT tys' ty0) (aT tys' ty1)+        Just (ty0:$ty1)      -> Just $ let tys'=IM.delete k tys in aT tys' ty0 :$ aT tys' ty1         Just (TyArr ty0 ty1) -> Just $ let tys'=IM.delete k tys in TyArr (aT tys' ty0) (aT tys' ty1)         Just (TyTup tysϵ)    -> Just $ let tys'=IM.delete k tys in TyTup (aT tys' <$> tysϵ)         Just ty'             -> Just ty'         Nothing              -> Nothing -freshName :: T.Text -> TyM a (Nm ())-freshName n = do+freshN :: T.Text -> TyM a (Nm ())+freshN n = do     st <- gets maxU     Nm n (U $ st+1) ()         <$ modify (mapMaxU (+1))@@ -189,43 +188,43 @@                         let j' = U$k+1                         TyVar (Nm n j' l') <$ modify (\(u, s) -> (u+1, IM.insert j j' s))           cloneTyM (TyArr tyϵ ty')               = TyArr <$> cloneTyM tyϵ <*> cloneTyM ty'-          cloneTyM (TyApp tyϵ ty')               = TyApp <$> cloneTyM tyϵ <*> cloneTyM ty'+          cloneTyM (tyϵ:$ty')                    = (:$) <$> cloneTyM tyϵ <*> cloneTyM ty'           cloneTyM (TyTup tys)                   = TyTup <$> traverse cloneTyM tys           cloneTyM tyϵ@TyB{}                     = pure tyϵ  checkType :: Ord a => T -> (C, a) -> TyM a ()-checkType TyVar{} _                             = pure ()-checkType (TyB TyStr) (IsSemigroup, _)          = pure ()-checkType (TyB TyInteger) (IsSemigroup, _)      = pure ()-checkType (TyB TyFloat) (IsSemigroup, _)        = pure ()-checkType (TyB TyInteger) (IsNum, _)            = pure ()-checkType (TyB TyFloat) (IsNum, _)              = pure ()-checkType (TyB TyInteger) (IsEq, _)             = pure ()-checkType (TyB TyFloat) (IsEq, _)               = pure ()-checkType (TyB TyBool) (IsEq, _)                = pure ()-checkType (TyB TyStr) (IsEq, _)                 = pure ()-checkType (TyTup tys) (c@IsEq, l)               = traverse_ (`checkType` (c, l)) tys-checkType (Rho _ rs) (c@IsEq, l)                = traverse_ (`checkType` (c, l)) (IM.elems rs)-checkType (TyApp (TyB TyVec) ty) (c@IsEq, l)    = checkType ty (c, l)-checkType (TyApp (TyB TyOption) ty) (c@IsEq, l) = checkType ty (c, l)-checkType (TyB TyInteger) (IsParse, _)          = pure ()-checkType (TyB TyFloat) (IsParse, _)            = pure ()-checkType (TyB TyFloat) (IsOrd, _)              = pure ()-checkType (TyB TyInteger) (IsOrd, _)            = pure ()-checkType (TyB TyStr) (IsOrd, _)                = pure ()-checkType (TyB TyVec) (Functor, _)              = pure ()-checkType (TyB TyStream) (Functor, _)           = pure ()-checkType (TyB TyOption) (Functor, _)           = pure ()-checkType (TyB TyStream) (Witherable, _)        = pure ()-checkType (TyB TyVec) (Foldable, _)             = pure ()-checkType (TyB TyStream) (Foldable, _)          = pure ()-checkType (TyB TyStr) (IsPrintf, _)             = pure ()-checkType (TyB TyFloat) (IsPrintf, _)           = pure ()-checkType (TyB TyInteger) (IsPrintf, _)         = pure ()-checkType (TyB TyBool) (IsPrintf, _)            = pure ()-checkType (TyTup tys) (c@IsPrintf, l)           = traverse_ (`checkType` (c, l)) tys-checkType (Rho _ rs) (c@IsPrintf, l)            = traverse_ (`checkType` (c, l)) (IM.elems rs)-checkType ty (c, l)                             = throwError $ Doesn'tSatisfy l ty c+checkType TyVar{} _                        = pure ()+checkType (TyB TyStr) (IsSemigroup, _)     = pure ()+checkType (TyB TyInteger) (IsSemigroup, _) = pure ()+checkType (TyB TyFloat) (IsSemigroup, _)   = pure ()+checkType (TyB TyInteger) (IsNum, _)       = pure ()+checkType (TyB TyFloat) (IsNum, _)         = pure ()+checkType (TyB TyInteger) (IsEq, _)        = pure ()+checkType (TyB TyFloat) (IsEq, _)          = pure ()+checkType (TyB TyBool) (IsEq, _)           = pure ()+checkType (TyB TyStr) (IsEq, _)            = pure ()+checkType (TyTup tys) (c@IsEq, l)          = traverse_ (`checkType` (c, l)) tys+checkType (Rho _ rs) (c@IsEq, l)           = traverse_ (`checkType` (c, l)) (IM.elems rs)+checkType (TyB TyVec:$ty) (c@IsEq, l)      = checkType ty (c, l)+checkType (TyB TyOption:$ty) (c@IsEq, l)   = checkType ty (c, l)+checkType (TyB TyInteger) (IsParse, _)     = pure ()+checkType (TyB TyFloat) (IsParse, _)       = pure ()+checkType (TyB TyFloat) (IsOrd, _)         = pure ()+checkType (TyB TyInteger) (IsOrd, _)       = pure ()+checkType (TyB TyStr) (IsOrd, _)           = pure ()+checkType (TyB TyVec) (Functor, _)         = pure ()+checkType (TyB TyStream) (Functor, _)      = pure ()+checkType (TyB TyOption) (Functor, _)      = pure ()+checkType (TyB TyStream) (Witherable, _)   = pure ()+checkType (TyB TyVec) (Foldable, _)        = pure ()+checkType (TyB TyStream) (Foldable, _)     = pure ()+checkType (TyB TyStr) (IsPrintf, _)        = pure ()+checkType (TyB TyFloat) (IsPrintf, _)      = pure ()+checkType (TyB TyInteger) (IsPrintf, _)    = pure ()+checkType (TyB TyBool) (IsPrintf, _)       = pure ()+checkType (TyTup tys) (c@IsPrintf, l)      = traverse_ (`checkType` (c, l)) tys+checkType (Rho _ rs) (c@IsPrintf, l)       = traverse_ (`checkType` (c, l)) (IM.elems rs)+checkType ty (c, l)                        = throwError $ Doesn'tSatisfy l ty c  checkClass :: Ord a            => IM.IntMap T -- ^ Unification result@@ -249,6 +248,8 @@  tyDS :: Ord a => Subst -> D a -> TyM a (D T, Subst) tyDS s (SetFS bs) = pure (SetFS bs, s)+tyDS s (SetRS bs) = pure (SetRS bs, s)+tyDS s SetAsv     = pure (SetAsv, s) tyDS s FlushDecl  = pure (FlushDecl, s) tyDS s (FunDecl n@(Nm _ (U i) _) [] e) = do     (e', s') <- tyES s e@@ -259,7 +260,7 @@ isAmbiguous :: T -> Bool isAmbiguous TyVar{}        = True isAmbiguous (TyArr ty ty') = isAmbiguous ty || isAmbiguous ty'-isAmbiguous (TyApp ty ty') = isAmbiguous ty || isAmbiguous ty'+isAmbiguous (ty:$ty')      = isAmbiguous ty || isAmbiguous ty' isAmbiguous (TyTup tys)    = any isAmbiguous tys isAmbiguous TyB{}          = False isAmbiguous Rho{}          = True@@ -276,6 +277,8 @@ checkAmb e@(Var ty _) | isAmbiguous ty = throwError $ Ambiguous ty (void e) checkAmb (Let _ bs e) = traverse_ checkAmb [e, snd bs] checkAmb (Lam _ _ e) = checkAmb e -- I think+checkAmb e@(ParseAllCol t) | isAmbiguous t = throwError (Ambiguous t (void e))+checkAmb e@(ParseCol t _) | isAmbiguous t = throwError (Ambiguous t (void e)) checkAmb _ = pure ()  tS _ s []     = pure ([], s)@@ -292,39 +295,39 @@  tyNumOp :: Ord a => a -> TyM a T tyNumOp l = do-    m <- freshName "m"+    m <- freshN "m"     modify (mapCV (addC m (IsNum, l)))     let m' = var m-    pure $ tyArr m' (tyArr m' m')+    pure $ m' ~> m' ~> m'  tySemiOp :: Ord a => a -> TyM a T tySemiOp l = do-    m <- freshName "m"+    m <- freshN "m"     modify (mapCV (addC m (IsSemigroup, l)))     let m' = var m-    pure $ tyArr m' (tyArr m' m')+    pure $ m' ~> m' ~> m'  tyOrd :: Ord a => a -> TyM a T tyOrd l = do-    a <- freshName "a"+    a <- freshN "a"     modify (mapCV (addC a (IsOrd, l)))     let a' = var a-    pure $ tyArr a' (tyArr a' tyB)+    pure $ a' ~> a' ~> tyB  tyEq :: Ord a => a -> TyM a T tyEq l = do-    a <- freshName "a"+    a <- freshN "a"     modify (mapCV (addC a (IsEq, l)))     let a' = var a-    pure $ tyArr a' (tyArr a' tyB)+    pure $ a' ~> a' ~> tyB  -- min/max tyM :: Ord a => a -> TyM a T tyM l = do-    a <- freshName "a"+    a <- freshN "a"     modify (mapCV (addC a (IsOrd, l)))     let a' = var a-    pure $ tyArr a' (tyArr a' a')+    pure $ a' ~> a' ~> a'  desugar :: a desugar = error "Should have been de-sugared in an earlier stage!"@@ -337,10 +340,10 @@     pure (fmap (aT s) e')  tyES :: Ord a => Subst -> E a -> TyM a (E T, Subst)-tyES s (BLit _ b)         = pure (BLit tyB b, s)-tyES s (ILit _ i)         = pure (ILit tyI i, s)-tyES s (FLit _ f)         = pure (FLit tyF f, s)-tyES s (StrLit _ str)     = pure (StrLit tyStr str, s)+tyES s (Lit _ (BLit b))   = pure (Lit tyB (BLit b), s)+tyES s (Lit _ (ILit i))   = pure (Lit tyI (ILit i), s)+tyES s (Lit _ (FLit f))   = pure (Lit tyF (FLit f), s)+tyES s (Lit _ (StrLit str)) = pure (Lit tyStr (StrLit str), s) tyES s (RegexLit _ rr)    = pure (RegexLit tyR rr, s) tyES s (Column _ i)       = pure (Column (tyStream tyStr) i, s) tyES s (IParseCol _ i)    = pure (IParseCol (tyStream tyI) i, s)@@ -348,7 +351,11 @@ tyES s (Field _ i)        = pure (Field tyStr i, s) tyES s LastField{}        = pure (LastField tyStr, s) tyES s AllField{}         = pure (AllField tyStr, s)+tyES s FieldList{}        = pure (FieldList (tyV tyStr), s) tyES s AllColumn{}        = pure (AllColumn (tyStream tyStr), s)+tyES s FParseAllCol{}     = pure (FParseAllCol (tyStream tyF), s)+tyES s IParseAllCol{}     = pure (IParseAllCol (tyStream tyI), s)+tyES s (ParseAllCol l)    = do {a <- freshN "a"; modify (mapCV (addC a (IsParse, l))); pure (ParseAllCol (tyStream (var a)), s)} tyES s (NB _ Ix)    = pure (NB tyI Ix, s) tyES s (NB _ Fp)    = pure (NB tyStr Fp, s) tyES s (NB _ Nf)    = pure (NB tyI Nf, s)@@ -364,75 +371,75 @@ tyES s (BB l Neq)   = do {t <- tyEq l; pure (BB t Neq, s)} tyES s (BB l Min)   = do {t <- tyM l; pure (BB t Min, s)} tyES s (BB l Max)   = do {t <- tyM l; pure (BB t Max, s)}-tyES s (BB _ Split) = pure (BB (tyArr tyStr (tyArr tyR (tyV tyStr))) Split, s)-tyES s (BB _ Splitc) = pure (BB (tyArr tyStr (tyArr tyStr (tyV tyStr))) Splitc, s)-tyES s (BB _ Matches) = pure (BB (tyArr tyStr (tyArr tyR tyB)) Matches, s)-tyES s (BB _ NotMatches) = pure (BB (tyArr tyStr (tyArr tyR tyB)) NotMatches, s)-tyES s (UB _ Tally) = pure (UB (tyArr tyStr tyI) Tally, s)-tyES s (BB _ Div) = pure (BB (tyArr tyF (tyArr tyF tyF)) Div, s)-tyES s (UB _ Not) = pure (UB (tyArr tyB tyB) Not, s)-tyES s (BB _ And) = pure (BB (tyArr tyB (tyArr tyB tyB)) And, s)-tyES s (BB _ Or) = pure (BB (tyArr tyB (tyArr tyB tyB)) Or, s)-tyES s (BB _ Match) = pure (BB (tyArr tyStr (tyArr tyR (tyOpt $ TyTup [tyI, tyI]))) Match, s)-tyES s (TB _ Substr) = pure (TB (tyArr tyStr (tyArr tyI (tyArr tyI tyStr))) Substr, s)-tyES s (UB _ IParse) = pure (UB (tyArr tyStr tyI) IParse, s)+tyES s (BB _ Split) = pure (BB (tyStr ~> tyR ~> tyV tyStr) Split, s)+tyES s (BB _ Splitc) = pure (BB (tyStr ~> tyStr ~> tyV tyStr) Splitc, s)+tyES s (BB _ Matches) = pure (BB (tyStr ~> tyR ~> tyB) Matches, s)+tyES s (BB _ NotMatches) = pure (BB (tyStr ~> tyR ~> tyB) NotMatches, s)+tyES s (UB _ Tally) = pure (UB (tyStr ~> tyI) Tally, s)+tyES s (BB _ Div) = pure (BB (tyF ~> tyF ~> tyF) Div, s)+tyES s (UB _ Not) = pure (UB (tyB ~> tyB) Not, s)+tyES s (BB _ And) = pure (BB (tyB ~> tyB ~> tyB) And, s)+tyES s (BB _ Or) = pure (BB (tyB ~> tyB ~> tyB) Or, s)+tyES s (BB _ Match) = pure (BB (tyStr ~> tyR ~> tyOpt (TyTup [tyI, tyI])) Match, s)+tyES s (TB _ Substr) = pure (TB (tyStr ~> tyI ~> (tyI ~> tyStr)) Substr, s)+tyES s (UB _ IParse) = pure (UB (tyStr ~> tyI) IParse, s) tyES s (UB _ FParse) = pure (UB (tyArr tyStr tyF) FParse, s) tyES s (UB _ Floor) = pure (UB (tyArr tyF tyI) Floor, s)-tyES s (UB _ Ceiling) = pure (UB (tyArr tyF tyI) Ceiling, s)-tyES s (UB _ TallyList) = do {a <- var <$> freshName "a"; pure (UB (tyArr a tyI) TallyList, s)}-tyES s (UB l Negate) = do {a <- freshName "a"; modify (mapCV (addC a (IsNum, l))); let a'=var a in pure (UB (tyArr a' a') Negate, s)}-tyES s (UB _ Some) = do {a <- var <$> freshName "a"; pure (UB (tyArr a (tyOpt a)) Some, s)}-tyES s (NB _ None) = do {a <- freshName "a"; pure (NB (tyOpt (var a)) None, s)}-tyES s (ParseCol l i) = do {a <- freshName "a"; modify (mapCV (addC a (IsParse, l))); pure (ParseCol (tyStream (var a)) i, s)}-tyES s (UB l Parse) = do {a <- freshName "a"; modify (mapCV (addC a (IsParse, l))); pure (UB (tyArr tyStr (var a)) Parse, s)}-tyES s (BB l Sprintf) = do {a <- freshName "a"; modify (mapCV (addC a (IsPrintf, l))); pure (BB (tyArr tyStr (tyArr (var a) tyStr)) Sprintf, s)}-tyES s (BB l DedupOn) = do {a <- var <$> freshName "a"; b <- freshName "b"; modify (mapCV (addC b (IsEq, l))); let b'=var b in pure (BB (tyArr (tyArr a b') (tyArr (tyStream a) (tyStream b'))) DedupOn, s)}-tyES s (UB _ (At i)) = do {a <- var <$> freshName "a"; pure (UB (tyArr (tyV a) a) (At i), s)}-tyES s (UB l Dedup) = do {a <- freshName "a"; modify (mapCV (addC a (IsEq, l))); let sA=tyStream (var a) in pure (UB (tyArr sA sA) Dedup, s)}-tyES s (UB _ Const) = do {a <- var <$> freshName "a"; b <- var <$> freshName "b"; pure (UB (tyArr a (tyArr b a)) Const, s)}-tyES s (UB l CatMaybes) = do {a <- freshName "a"; f <- freshName "f"; modify (mapCV (addC f (Witherable, l))); let a'=var a; f'=var f in pure (UB (tyArr (TyApp f' (tyOpt a')) (TyApp f' a')) CatMaybes, s)}-tyES s (BB l Filter) = do {a <- freshName "a"; f <- freshName "f"; modify (mapCV (addC f (Witherable, l))); let a'=var a; f'=var f; w=TyApp f' a' in pure (BB (tyArr (tyArr a' tyB) (tyArr w w)) Filter, s)}+tyES s (UB _ Ceiling) = pure (UB (tyF ~> tyI) Ceiling, s)+tyES s (UB _ TallyList) = do {a <- var <$> freshN "a"; pure (UB (a ~> tyI) TallyList, s)}+tyES s (UB l Negate) = do {a <- freshN "a"; modify (mapCV (addC a (IsNum, l))); let a'=var a in pure (UB (tyArr a' a') Negate, s)}+tyES s (UB _ Some) = do {a <- var <$> freshN "a"; pure (UB (tyArr a (tyOpt a)) Some, s)}+tyES s (NB _ None) = do {a <- freshN "a"; pure (NB (tyOpt (var a)) None, s)}+tyES s (ParseCol l i) = do {a <- freshN "a"; modify (mapCV (addC a (IsParse, l))); pure (ParseCol (tyStream (var a)) i, s)}+tyES s (UB l Parse) = do {a <- freshN "a"; modify (mapCV (addC a (IsParse, l))); pure (UB (tyArr tyStr (var a)) Parse, s)}+tyES s (BB l Sprintf) = do {a <- freshN "a"; modify (mapCV (addC a (IsPrintf, l))); pure (BB (tyStr ~> (var a ~> tyStr)) Sprintf, s)}+tyES s (BB l DedupOn) = do {a <- var <$> freshN "a"; b <- freshN "b"; modify (mapCV (addC b (IsEq, l))); let b'=var b in pure (BB (tyArr (a ~> b') (tyArr (tyStream a) (tyStream b'))) DedupOn, s)}+tyES s (UB _ (At i)) = do {a <- var <$> freshN "a"; pure (UB (tyArr (tyV a) a) (At i), s)}+tyES s (UB l Dedup) = do {a <- freshN "a"; modify (mapCV (addC a (IsEq, l))); let sA=tyStream (var a) in pure (UB (sA ~> sA) Dedup, s)}+tyES s (UB _ Const) = do {a <- var <$> freshN "a"; b <- var <$> freshN "b"; pure (UB (a ~> (b ~> a)) Const, s)}+tyES s (UB l CatMaybes) = do {a <- freshN "a"; f <- freshN "f"; modify (mapCV (addC f (Witherable, l))); let a'=var a; f'=var f in pure (UB (tyArr (f':$tyOpt a') (f':$a')) CatMaybes, s)}+tyES s (BB l Filter) = do {a <- freshN "a"; f <- freshN "f"; modify (mapCV (addC f (Witherable, l))); let a'=var a; f'=var f; w=f':$a' in pure (BB (tyArr (tyArr a' tyB) (w ~> w)) Filter, s)} tyES s (UB _ (Select i)) = do-    ρ <- freshName "ρ"; a <- var <$> freshName "a"-    pure (UB (tyArr (Rho ρ (IM.singleton i a)) a) (Select i), s)+    ρ <- freshN "ρ"; a <- var <$> freshN "a"+    pure (UB (Rho ρ (IM.singleton i a) ~> a) (Select i), s) tyES s (BB l MapMaybe) = do-    a <- var <$> freshName "a"; b <- var <$> freshName "b"-    f <- freshName "f"+    a <- var <$> freshN "a"; b <- var <$> freshN "b"+    f <- freshN "f"     modify (mapCV (addC f (Witherable, l)))     let f'=var f-    pure (BB (tyArr (tyArr a (tyOpt b)) (tyArr (TyApp f' a) (TyApp f' b))) MapMaybe, s)+    pure (BB (tyArr (a ~> tyOpt b) ((f':$a) ~> (f':$b))) MapMaybe, s) tyES s (BB l Map) = do-    a <- var <$> freshName "a"; b <- var <$> freshName "b"-    f <- freshName "f"+    a <- var <$> freshN "a"; b <- var <$> freshN "b"+    f <- freshN "f"     let f'=var f     modify (mapCV (addC f (Functor, l)))-    pure (BB (tyArr (tyArr a b) (tyArr (TyApp f' a) (TyApp f' b))) Map, s)+    pure (BB (tyArr (a ~> b) ((f':$a) ~> (f':$b))) Map, s) tyES s (TB l Fold) = do-    a <- var <$> freshName "a"; b <- var <$> freshName "b"-    f <- freshName "f"+    a <- var <$> freshN "a"; b <- var <$> freshN "b"+    f <- freshN "f"     let f'=var f     modify (mapCV (addC f (Foldable, l)))-    pure (TB (tyArr (tyArr b (tyArr a b)) (tyArr b (tyArr (TyApp f' a) b))) Fold, s)+    pure (TB ((b ~> (a ~> b)) ~> (b ~> (f':$a) ~> b)) Fold, s) tyES s (BB l Fold1) = do-    a <- var <$> freshName "a"-    f <- freshName "f"+    a <- var <$> freshN "a"+    f <- freshN "f"     let f'=var f     modify (mapCV (addC f (Foldable, l)))-    pure (BB (tyArr (tyArr a (tyArr a a)) (tyArr (TyApp f' a) a)) Fold1, s)-tyES s (TB _ Captures) = pure (TB (tyArr tyStr (tyArr tyI (tyArr tyR (tyOpt tyStr)))) Captures, s)+    pure (BB ((a ~> (a ~> a)) ~> ((f':$a) ~> a)) Fold1, s)+tyES s (TB _ Captures) = pure (TB (tyStr ~> (tyI ~> (tyR ~> tyOpt tyStr))) Captures, s) tyES s (BB _ Prior) = do-    a <- var <$> freshName "a"; b <- var <$> freshName "b"-    pure (BB (tyArr (tyArr a (tyArr a b)) (tyArr (tyStream a) (tyStream b))) Prior, s)+    a <- var <$> freshN "a"; b <- var <$> freshN "b"+    pure (BB (tyArr (a ~> (a ~> b)) (tyStream a ~> tyStream b)) Prior, s) tyES s (TB _ ZipW) = do-    a <- var <$> freshName "a"; b <- var <$> freshName "b"; c <- var <$> freshName "c"-    pure (TB (tyArr (tyArr a (tyArr b c)) (tyArr (tyStream a) (tyArr (tyStream b) (tyStream c)))) ZipW, s)+    a <- var <$> freshN "a"; b <- var <$> freshN "b"; c <- var <$> freshN "c"+    pure (TB (tyArr (a ~> (b ~> c)) (tyStream a ~> (tyStream b ~> tyStream c))) ZipW, s) tyES s (TB _ Scan) = do-    a <- var <$> freshName "a"; b <- var <$> freshName "b"-    pure (TB (tyArr (tyArr b (tyArr a b)) (tyArr b (tyArr (tyStream a) (tyStream b)))) Scan, s)+    a <- var <$> freshN "a"; b <- var <$> freshN "b"+    pure (TB (tyArr (b ~> (a ~> b)) (b ~> tyStream a ~> tyStream b)) Scan, s) tyES s (TB _ Option) = do-    a <- var <$> freshName "a"; b <- var <$> freshName "b"-    pure (TB (tyArr b (tyArr (tyArr a b) (tyArr (tyOpt a) b))) Option, s)-tyES s (TB _ AllCaptures) = pure (TB (tyArr tyStr (tyArr tyI (tyArr tyR (tyV tyStr)))) AllCaptures, s)+    a <- var <$> freshN "a"; b <- var <$> freshN "b"+    pure (TB (b ~> (a ~> b) ~> (tyOpt a ~> b)) Option, s)+tyES s (TB _ AllCaptures) = pure (TB (tyStr ~> (tyI ~> (tyR ~> tyV tyStr))) AllCaptures, s) tyES s (Implicit _ e) = do {(e',s') <- tyES s e; pure (Implicit (tyStream (eLoc e')) e', s')} tyES s (Guarded l e se) = do     (se', s0) <- tyES s se@@ -440,18 +447,18 @@     s2 <- liftEither $ mguPrep l s1 tyB (eLoc e')     pure (Guarded (tyStream (eLoc se')) e' se', s2) tyES s (EApp l e0 e1)     = do-    a <- freshName "a"; b <- freshName "b"-    let a'=var a; b'=var b; e0Ty=tyArr a' b'+    a <- freshN "a"; b <- freshN "b"+    let a'=var a; b'=var b; e0Ty=a' ~> b'     (e0', s0) <- tyES s e0     (e1', s1) <- tyES s0 e1     s2 <- liftEither $ mguPrep l s1 (eLoc e0') e0Ty     s3 <- liftEither $ mguPrep l s2 (eLoc e1') a'     pure (EApp b' e0' e1', s3) tyES s (Lam _ n@(Nm _ (U i) _) e) = do-    a <- var <$> freshName "a"+    a <- var <$> freshN "a"     modify (addVarEnv i a)     (e', s') <- tyES s e-    pure (Lam (tyArr a (eLoc e')) (n$>a) e', s')+    pure (Lam (a ~> eLoc e') (n$>a) e', s') tyES s (Let _ (n@(Nm _ (U i) _), eϵ) e) = do     (eϵ', s0) <- tyES s eϵ     let bTy=eLoc eϵ'@@ -461,9 +468,9 @@ tyES s (Tup _ es) = do {(es', s') <- tS tyES s es; pure (Tup (TyTup (fmap eLoc es')) es', s')} tyES s (Var _ n) = do {t <- lookupVar n; pure (Var t (n$>t), s)} tyES s (OptionVal _ (Just e)) = do {(e', s') <- tyES s e; pure (OptionVal (tyOpt (eLoc e')) (Just e'), s')}-tyES s (OptionVal _ Nothing) = do {a <- var <$> freshName "a"; pure (OptionVal (tyOpt a) Nothing, s)}+tyES s (OptionVal _ Nothing) = do {a <- var <$> freshN "a"; pure (OptionVal (tyOpt a) Nothing, s)} tyES s (Arr l v) | V.null v = do-    a <- var <$> freshName "a"+    a <- var <$> freshN "a"     pure (Arr (tyV a) V.empty, s)                  | otherwise = do     (v',s0) <- tS tyES s (V.toList v)@@ -479,7 +486,7 @@     s4 <- liftEither $ mguPrep l s3 t (eLoc e1')     pure (Cond t p' e0' e1', s4) tyES s (Anchor l es) = do-    (es', s') <- tS (\sϵ e -> do {(e',s0) <- tyES sϵ e; a <- var <$> freshName "a"; s1 <- liftEither $ mguPrep l s0 (tyStream a) (eLoc e'); pure (e', s1)}) s es+    (es', s') <- tS (\sϵ e -> do {(e',s0) <- tyES sϵ e; a <- var <$> freshN "a"; s1 <- liftEither $ mguPrep l s0 (tyStream a) (eLoc e'); pure (e', s1)}) s es     pure (Anchor (TyB TyUnit) es', s') tyES _ RC{} = error "Regex should not be compiled at this stage." tyES _ Dfn{} = desugar; tyES _ ResVar{} = desugar; tyES _ Paren{} = desugar
src/Ty/Const.hs view
@@ -6,13 +6,13 @@  -- | argument assumed to have kind 'Star' tyStream :: T -> T-tyStream = TyApp (TyB TyStream)+tyStream = (TyB TyStream :$)  tyB, tyI, tyF, tyStr, tyR :: T tyB=TyB TyBool; tyI=TyB TyInteger; tyF=TyB TyFloat; tyStr=TyB TyStr; tyR=TyB TyR  tyOpt :: T -> T-tyOpt = TyApp (TyB TyOption)+tyOpt = (TyB TyOption :$)  tyV :: T -> T-tyV = TyApp (TyB TyVec)+tyV = (TyB TyVec :$)
test/Spec.hs view
@@ -20,8 +20,7 @@ main :: IO () main = defaultMain $     testGroup "Jacinda interpreter"-        [ testCase "parses no error" (parseNoErr sumBytes)-        , testCase "parse as" (parseTo sumBytes sumBytesAST)+        [ testCase "parse as" (parseTo sumBytes sumBytesAST)         , testCase "parse as" (parseTo "#`0>72" pAst)         , parseFile "test/examples/ab.jac"         , splitWhitespaceT "1 1.3\tj" ["1", "1.3", "j"]@@ -32,8 +31,8 @@         , splitWhitespaceT "" []         , splitWhitespaceT "5" ["5"]         , testCase "type of" (tyOfT sumBytes (TyB TyInteger))-        , testCase "type of" (tyOfT krakRegex (TyApp (TyB TyStream) (TyB TyStr))) -- stream of str-        , testCase "type of" (tyOfT krakCol (TyApp (TyB TyStream) (TyB TyStr))) -- stream of str+        , testCase "type of" (tyOfT krakRegex (TyB TyStream :$ TyB TyStr)) -- stream of str+        , testCase "type of" (tyOfT krakCol (TyB TyStream :$ TyB TyStr)) -- stream of str         , testCase "type of (zip)" (tyOfT ",(-) $3:i $6:i" (tyStream tyI))         , testCase "type of (filter)" (tyOfT "(>110) #. #\"$0" (tyStream tyI))         , testCase "typechecks dfn" (tyOfT "[(+)|0 x] $1:i" tyI)@@ -47,6 +46,16 @@         , 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")+        , testGroup "Examples should be well-typed"+            [ testCase (T.unpack s) (tyRight s) |+                s <- [ "(||)|#f {#`0>110}{#t}"+                     , "(&)|#t (>)\\. {|`1:f}"+                     , "[y]|> {|`0~/^$/}"+                     , "(max|_1 #¨$0) > 110"+                     , "(||)|#f {#`0>110}{#t}"+                     , "(+)|0 {`5 ~ /^\\d+$/}{`5:}"+                     ]+            ]         ]  evalTo :: T.Text -> String -> Assertion@@ -62,7 +71,7 @@             (EApp ()                 (UB () Tally)                 (AllField ())))-        (ILit () 72)+        (Lit () (ILit 72))  splitWhitespaceT :: BS.ByteString -> [BS.ByteString] -> TestTree splitWhitespaceT haystack expected =@@ -86,11 +95,14 @@             (EApp ()                 (TB () Fold)                 (BB () Plus))-            (ILit () 0))+            (Lit () (ILit 0)))             (IParseCol () 5)  tyFile :: FilePath -> Assertion tyFile = tcIO [] <=< TIO.readFile++tyRight :: T.Text -> Assertion+tyRight src = assertBool (T.unpack src) (tySrc src `seq` True)  tyOfT :: T.Text -> T -> Assertion tyOfT src expected =
test/examples/evenOdd.jac view
@@ -1,3 +1,5 @@+{. :set rs:=/\n+/;+ fn count(x) ≔   (+)|0 [:1"x; @@ -11,7 +13,7 @@   val iStream := $0   val even := count (isEven #. iStream)   val odd := count (isOdd #. iStream)-  val tens := (+)|> {%/0$/}{1}-  {. val tens := count {%/0$/}{`0}+  {. val tens := (+)|> {%/0$/}{1}+  val tens := count {%/0$/}{`0}   val total := odd + even in (total . even . odd . tens) end