packages feed

jacinda 2.0.2.0 → 3.0.0.0

raw patch · 57 files changed

+1191/−865 lines, 57 filesdep ~bytestring

Dependency ranges changed: bytestring

Files

CHANGELOG.md view
@@ -1,3 +1,22 @@+# 3.0.0.0++  * Rewrite backend to always stream/not blow up memory+  * Better error messages when a field is out of bounds+  * Better error message on empty `|>` (`fold1`)+  * Fix parsing bug in curried binary operators+  * Add `--asv` and `--usv` command-line flags+  * Add `:set asv;` `:set usv;` to language+  * Add `Witherable` instance for `List`+  * Add `subs` builtin++# 2.0.3.0++  * Handle some parsing/currying cases (still hinky)+  * Add `sub1` builtin like AWK's `sub`+  * Better presentation of regex engine errors+  * Faster float printing+  * Rewrite pretty-printer to parenthesize correctly.+ # 2.0.2.0    * Add support for custom record separators
README.md view
@@ -1,5 +1,5 @@-Jacinda is a functional, expression-oriented data processing language,-complementing [AWK](http://www.awklang.org).+Jacinda is a functional pattern sifting language,+a smaller [AWK](http://www.awklang.org).  # Installation @@ -23,13 +23,29 @@  There is a [vim plugin](https://github.com/vmchale/jacinda-vim) and a [VSCode extension](https://marketplace.visualstudio.com/items?itemName=vmchale.jacinda). -# SHOCK & AWE+# Usefulness +Unix uses record separators in many places; we can display one entry in the+`PATH` variable with:+ ```-curl -sL https://raw.githubusercontent.com/nychealth/coronavirus-data/master/latest/now-weekly-breakthrough.csv | \-    ja ',[1.0-x%y] {ix>1}{`5:} {ix>1}{`17:}' -F,+echo $PATH | ja -F: "{|[x+'\n'+y]|>\`$}" ``` +Many Unix tools output much information separated with spaces. We use regular+expressions to match relevant lines and then select the field with the data+itself, viz.++```+otool -l $(locate libpng.dylib) | ja '{`1 ~ /^name/}{`2}'+```++To get the value of a variable (say, `PATH`) from the output of `printenv`:++```+printenv | ja -F= '{%/^PATH/}{`2}'+```+ ## Rosetta  Replace@@ -64,8 +80,8 @@   * No nested dfns   * No list literal syntax   * Postfix `:f` and `:i` are handled poorly-  * Polymorphic functions can't be instantiated with separate types (global-    monomorphism restriction)+  * Streams of functions don't work+  * Higher-order functions are subtly broken  Intentionally missing features: @@ -76,3 +92,7 @@   * [Rust's regular expressions](https://docs.rs/regex/)     - extensively documented with Unicode support   * Deduplicate builtin++# Contributing++Bug reports are welcome contributions.
− app/Main.hs 
@@ -1,101 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Main (main) where--import qualified Data.Text           as T-import qualified Data.Text.IO        as TIO-import qualified Data.Version        as V-import           File-import           Options.Applicative-import qualified Paths_jacinda       as P-import           System.IO           (stdin)--data Command = TypeCheck !FilePath ![FilePath]-             | Run !FilePath !(Maybe FilePath) ![FilePath]-             | Expr !T.Text !(Maybe FilePath) !(Maybe T.Text) !Bool !(Maybe T.Text) ![FilePath]-             | Eval !T.Text--jacFile :: Parser FilePath-jacFile = argument str-    (metavar "JACFILE"-    <> 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'-    <> metavar "REGEXP"-    <> help "Field separator")--jacExpr :: Parser T.Text-jacExpr = argument str-    (metavar "EXPR"-    <> help "Jacinda expression")--inpFile :: Parser (Maybe FilePath)-inpFile = optional $ option str-    (short 'i'-    <> metavar "DATAFILE"-    <> help "Data file")--jacCompletions :: HasCompleter f => Mod f a-jacCompletions = completer . bashCompleter $ "file -X '!*.jac' -o plusdirs"--commandP :: Parser Command-commandP = hsubparser-    (command "tc" (info tcP (progDesc "Type-check file"))-    <> command "e" (info eP (progDesc "Evaluate an expression (no file context)"))-    <> command "run" (info runP (progDesc "Run from file")))-    <|> exprP-    where-        tcP = TypeCheck <$> jacFile <*> includes-        runP = Run <$> jacFile <*> inpFile <*> includes-        exprP = Expr <$> jacExpr <*> inpFile <*> jacFs <*> asv <*> jacRs <*> includes-        eP = Eval <$> jacExpr--includes :: Parser [FilePath]-includes = many $ strOption-    (metavar "DIR"-    <> long "include"-    <> short 'I'-    <> dirCompletions)--dirCompletions :: HasCompleter f => Mod f a-dirCompletions = completer . bashCompleter $ "directory"---wrapper :: ParserInfo Command-wrapper = info (helper <*> versionMod <*> commandP)-    (fullDesc-    <> progDesc "Jacinda language for functional stream processing, filtering, and reports"-    <> header "Jacinda - a functional complement to AWK")--versionMod :: Parser (a -> a)-versionMod = infoOption (V.showVersion P.version) (short 'V' <> long "version" <> help "Show version")--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 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
@@ -12,12 +12,18 @@ main :: IO () main =     defaultMain [ bgroup "eval"-                      [ bench "exprEval" $ nf exprEval "[x+' '+y]|'' split '01-23-1987' /-/"-                      , bench "path" $ nfIO (silence $ runOnFile [] "{|[x+'\\n'+y]|>`$}" (Just ":") Nothing "bench/data/PATH")+                      [ bench "exprEval" $ nf exprEval "[x+' '+y]|'' split '01-23-1987' /-/" ]+                , bgroup "stream"+                      [ 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" })+                      , bench "sedstream.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/sedstream.jac" ; runOnFile [] contents Nothing Nothing "bench/data/lines.txt" })+                      , bench "gnused.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/gnused.jac" ; runOnFile [] contents Nothing Nothing "bench/data/lines.txt" })+                      , bench "fungnused.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/fungnused.jac" ; runOnFile [] contents Nothing Nothing "bench/data/lines.txt" })+                      , bench "hsLibversionMac.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/hsLibversionMac.jac"; runOnFile [] contents Nothing Nothing "bench/data/pandoc-mac" })+                      , bench "sedsmtp.jac" $ nfIO (silence $ do { contents <- TIO.readFile "examples/sedsmtp.jac" ; runOnFile [] contents Nothing Nothing "test/examples/data/2.txt" })                       ]                 ]
doc/guide.pdf view

binary file changed (207341 → 75246 bytes)

− examples/bc.jac 
@@ -1,2 +0,0 @@-{. {#t}{#`0}-#"$0
+ examples/compilerVersion.jac view
@@ -0,0 +1,7 @@+{. readelf -p .comment -p .note.gnu.gold-version $(which ja) | ja run compilerVersion.jac+@include'lib/string.jac'++:set rs:=/String dump of section '[\.a-z\-]*':\n/;+:set fs:=/\s*\[[ a-f0-9]*\]\s*/;++unlines¨{% /[^\s]/}{(λstr. str ~* 1 /([^\n]*)\s*/):?([x ~ /GHC|GCC|clang|mold|rustc|gold/] #. `$)}
+ examples/fungnused.jac view
@@ -0,0 +1,10 @@+{. https://www.gnu.org/software/sed/manual/sed.html#Joining-lines++fn go(acc, line) :=+  let+    val next := option [x] [(x+)] (acc->1)+  in+    option (None . (Some (next line))) [(Some (next x) . None)] (line ~* 1 /([^\\]*)\\/)+  end;++[x->2]:?(go^(None . None) $0)
+ examples/gnused.jac view
@@ -0,0 +1,5 @@+{. https://www.gnu.org/software/sed/manual/sed.html#Joining-lines+fn go(acc, line) :=+  option (acc+'\n'+line) [x+line] (acc ~* 1 /([^\\]*)\\/);++go|>$0
examples/hsLibversion.jac view
@@ -1,1 +1,1 @@-.?{| `0 ~* 1 /(^[A-Za-z][A-Za-z0-9\-]*\-\d+(\.\d+)*)\-[0-9a-f]{64}$/}+~..?{| `0 ~* 1 /(^[A-Za-z][A-Za-z0-9\-]*\-\d+(\.\d+)*)\-([0-9a-f]{64}|[0-9a-f]{4})/}
examples/hsLibversion2.jac view
@@ -1,1 +1,1 @@-[x ~* 1 /(^[A-Za-z][A-Za-z0-9\-]*\-\d+(\.\d+)*)\-[0-9a-f]{64}$/]:? $0+~.[x ~* 1 /(^[A-Za-z][A-Za-z0-9\-]*\-\d+(\.\d+)*)\-([0-9a-f]{64}$|[0-9a-f]{4})/]:? $0
examples/hsLibversionMac.jac view
@@ -1,1 +1,1 @@-~..?{| `0 ~* 1 /(^[A-Za-z][A-Za-z0-9\-]*\-\d+(\.\d+)*)\-[0-9a-zA-Z]{8}$/}+~..?{| `0 ~* 1 /(^[A-Za-z][A-Za-z0-9\-]*\-\d+(\.\d+)*)\-([0-9a-f]{8}|[0-9a-f]{4})$/}
examples/hsLibversionMac2.jac view
@@ -1,1 +1,1 @@-~.[x ~* 1 /(^[A-Za-z][A-Za-z0-9\-]*\-\d+(\.\d+)*)\-[0-9a-zA-Z]{22}$/]:? $0+~.[x ~* 1 /(^[A-Za-z][A-Za-z0-9\-]*\-\d+(\.\d+)*)\-([0-9a-zA-Z]{8}|[0-9a-zA-Z]{4})$/]:? $0
− examples/lc.jac 
@@ -1,3 +0,0 @@-{. (+)|0 {/./}{1} (count nonblank lines)-(+)|0 {#t}{1}-{. (+)|0 #"$0 (count bytes in file)
examples/liblibversion.jac view
@@ -1,3 +1,5 @@ @include'lib/string.jac' -(+)|'' (intercalate '\n')¨{% /-lHS/}{captures `0 1 /-lHS([A-Aa-z][A-Za-z0-9\-]*\d+(\.\d+)*)/}+{. TODO: handle type-equality-1-b4033320810f291878747510666a8cf89d0b44830502670dc4d3746b158afa8++unlines¨{% /-lHS/}{captures `0 1 /-lHS([A-Aa-z][A-Za-z0-9\-]*\d+(\.\d+)*)/}
examples/libversion.jac view
@@ -1,1 +1,1 @@-(+)|> ([x+'\n'+y]|>)¨{%/-lHS/}{captures `0 1 /-lHS([A-Aa-z][A-Za-z0-9\-]*\d+(\.\d+)*)/}+([x+'\n'+y]|>)¨{%/-lHS/}{captures `0 1 /-lHS([A-Aa-z][A-Za-z0-9\-]*\d+(\.\d+)*)/}
examples/nl.jac view
@@ -1,14 +1,11 @@-{. FIXME: figure out @include'lib/string.jac'?? @include'lib/string.jac'  fn step(acc, line) :=-  if empty line-    then (acc->1 . '')-    else (acc->1 + 1 . line);+  ?empty line;+    (acc->1 . '');+    (acc->1 + 1 . line);  fn process(x) :=-  if !empty (x->2)-    then sprintf '    %i\t%s' x-    else '';+  ?!empty (x->2); sprintf '    %i\t%s' x; '';  process"step^(0 . '') $0
examples/nmCtx.jac view
@@ -4,9 +4,7 @@ @include'lib/maybe.jac'  fn mMatch(str, re) :=-  if str ~ re-    then Some str-    else None;+  ?str ~ re; Some str; None;  fn step(ctx, line) :=   let
− examples/sed.jac 
@@ -1,14 +0,0 @@-{. program equiv to s/^(type|interface)/export \1/--@include'prelude/fn.jac'--fn replaceAtWith(line, ixes) :=-  let-    val pre := take (ixes->1) line-    val at := drop (ixes->1) line {. in our case-  in pre + 'export ' + at end;--fn replaceAt(line) :=-  option line (replaceAtWith line) (match line /^(type|interface)/);--replaceAt"$0
− examples/sedreplace.jac 
@@ -1,11 +0,0 @@-{. s/^var/export const/ in sed--@include'prelude/fn.jac'--fn insert(line, str, ixes) :=-  take (ixes->1) line + str + drop (ixes->2) line;--fn replace(re, str, line) :=-  option line (insert line str) (match line re);--(replace /^var/ 'export const')"$0
+ examples/sedsmtp.jac view
@@ -0,0 +1,7 @@+{. https://www.gnu.org/software/sed/manual/sed.html#Joining-lines+{. SMTP example++fn go(acc, line) :=+  option (acc+'\n'+line) [acc+' '+x] (line ~* 1 /^\s+(\.*)/);++go|>$0
+ examples/sedstream.jac view
@@ -0,0 +1,11 @@+{. https://www.gnu.org/software/sed/manual/sed.html#Joining-lines+@include'prelude/fn.jac'++fn go(acc, line) :=+  let+    val accStr := fromMaybe '' (acc->1)+  in+    option (None . Some (accStr+line)) [(Some (accStr+x) . None)] (line ~* 1 /([^\\]*)\\/)+  end;++[x->2]:?(go^(None.None) $0)
+ examples/slow.jac view
@@ -0,0 +1,1 @@+(+)|> ([x+'\n'+y]|>)¨{|captures `0 1 /-lHS([A-Aa-z][A-Za-z0-9\-]*\d+(\.\d+)*)/}
− examples/stripUnprintable.jac 
@@ -1,3 +0,0 @@-@include'lib/string.jac'--(replace /[^[:print:]]/ '')"$0
− examples/sumLs.jac 
@@ -1,2 +0,0 @@-{. ls -l | ja ...-{ix>1}{`5:i}
+ examples/tabularize.jac view
@@ -0,0 +1,5 @@+:set fs:=/\s+\|\s+/;++sprintf '<table>%s</table>'+  ([x+'\n'+y]|>+    {|sprintf '<tr>%s</tr>' ((+)|>((if ix=1 then sprintf '<th>%s</th>' else sprintf '<td>%s</td>')¨`$))})
examples/trailingLine.jac view
@@ -1,1 +1,1 @@-if [y]|>$0 = '' then fp else ''+?[y]|>$0 = ''; fp; ''
− examples/trimwhitespace.jac 
@@ -1,3 +0,0 @@-@include'lib/sed.jac'--(replace1 /\s+$/ '')"$0
examples/uniq.jac view
@@ -1,6 +1,6 @@ fn step(acc, this) :=-  if this = acc->1-    then (this . None)-    else (this . Some this);+  ?this = acc->1;+    (this . None);+    (this . Some this);  (->2):?step^(''.None) $0
− examples/year.jac 
@@ -1,2 +0,0 @@-{. extract year from column of dates in YYYY-MM-DD format-.? {|`1 ~* 1 /(\d{4})-\d{2}-\d{2}/}
jacinda.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               jacinda-version:            2.0.2.0+version:            3.0.0.0 license:            AGPL-3.0-only license-file:       COPYING maintainer:         vamchale@gmail.com@@ -35,7 +35,14 @@     default:     False     manual:      True +common warnings+    ghc-options:+        -Wincomplete-uni-patterns -Wincomplete-record-updates+        -Wredundant-constraints -Widentities -Wcpp-undef+        -Wmissing-export-lists -Wunused-packages+ library jacinda-lib+    import:           warnings     exposed-modules:         Parser         Parser.Rw@@ -57,23 +64,14 @@         Jacinda.Check.Field         Jacinda.Backend.Parse         Jacinda.Backend.Const-        Jacinda.Backend.P+        Jacinda.Backend.T         Jacinda.Backend.Printf         Include         Paths_jacinda      autogen-modules:  Paths_jacinda     default-language: Haskell2010-    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-+    ghc-options:      -Wall -O2 -Wno-missing-signatures -Wno-x-partial     build-depends:         base >=4.11.0.0 && <5,         bytestring >=0.11.0.0,@@ -93,40 +91,44 @@         split,         deepseq +    other-extensions:+        OverloadedStrings+        OverloadedLists+        DeriveFunctor+        FlexibleContexts+        DeriveAnyClass+        DeriveGeneric+        TypeFamilies+     if !flag(cross)         build-tool-depends: alex:alex >=3.5.0.0, happy:happy  executable ja+    import:           warnings     main-is:          Main.hs-    hs-source-dirs:   app+    hs-source-dirs:   x     other-modules:    Paths_jacinda     autogen-modules:  Paths_jacinda     default-language: Haskell2010-    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-+    ghc-options:      -Wall -rtsopts "-with-rtsopts=-A200k -k32k"     build-depends:         base,         jacinda-lib,         optparse-applicative >=0.14.1.0,         text +    ghc-options:+        -Wincomplete-uni-patterns -Wincomplete-record-updates+        -Wredundant-constraints -Widentities -Wcpp-undef+        -Wmissing-export-lists -Wunused-packages+ test-suite jacinda-test+    import:           warnings     type:             exitcode-stdio-1.0     main-is:          Spec.hs     hs-source-dirs:   test     default-language: Haskell2010-    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-+    ghc-options:      -Wall -threaded -rtsopts "-with-rtsopts=-N -K1K" -Wall     build-depends:         base,         jacinda-lib,@@ -136,16 +138,12 @@         tasty-hunit  benchmark jacinda-bench+    import:           warnings     type:             exitcode-stdio-1.0     main-is:          Bench.hs     hs-source-dirs:   bench     default-language: Haskell2010-    ghc-options:-        -Wincomplete-uni-patterns -Wincomplete-record-updates-        -Wredundant-constraints -Widentities -Wcpp-undef-        -Wmissing-export-lists -Wunused-packages -Wall -rtsopts-        "-with-rtsopts=-A200k -k32k"-+    ghc-options:      -Wall -rtsopts "-with-rtsopts=-A200k -k32k"     build-depends:         base,         criterion,
lib/sed.jac view
@@ -1,8 +1,3 @@ @include'prelude/fn.jac' -{. example: (replace /^var/ 'export const')"$0-fn replace1(re, str, line) :=-  let -    val insert := \line. \str. \ixes.-      take (ixes->1) line + str + drop (ixes->2) line-  in option line (insert line str) (match line re) end;+fn replace1(re, str, line) := sub1 re str line;
lib/string.jac view
@@ -4,5 +4,12 @@ fn replace(re, t, str) :=   [x+t+y] |> (split str re); +{. censor, bowlderize, expunge?+fn redact(re, x) :=+  sub1 re '' x;+ fn empty(str) :=   #str = 0;++fn unlines(strs) :=+  intercalate '\n' strs;
man/ja.1 view
@@ -1,4 +1,4 @@-.\" Automatically generated by Pandoc 3.1.12+.\" Automatically generated by Pandoc 3.1.13 .\" .TH "ja (1)" "" "" "" "" .SH NAME@@ -104,6 +104,12 @@ \f[B]substr\f[R] Extract substring Str \-> Int \-> Int \-> Str .TP+\f[B]sub1\f[R] Substitute first occurrence+Regex \-> Str \-> Str \-> Str+.TP+\f[B]subs\f[R] Substitute all occurrences+Regex \-> Str \-> Str \-> Str+.TP \f[B]split\f[R] Split a string by regex Str \-> Regex \-> List Str .TP@@ -132,7 +138,7 @@ Str \-> Int \-> Regex \-> Option Str .TP \f[B]captures\f[R] Return all aptures (nth capture group)-Str \-> Int \-> Regex \-> List Str+Str \-> Int \-> Regex \-> Str .TP \f[B]:?\f[R] mapMaybe Witherable f :=> (a \-> Option b) \-> f a \-> f b@@ -143,6 +149,8 @@ \f[B]fp\f[R] Filename .PP \f[B]nf\f[R] Number of fields+.PP+\f[B]⍬\f[R] Empty string/empty list .SS SYNTAX \f[B]\[ga]n\f[R] nth field .PP@@ -177,6 +185,12 @@ \f[B]{.\f[R] Line comment .PP \f[B]\[at]include\[aq]/path/file.jac\[cq]\f[R] File include+.PP+\f[B]?<expr>; <expr>; <expr>\f[R] If\&...+then\&...+else+.PP+\f[B]<pattern>,,<pattern> <expr>\f[R] Bookend a stream .SS DECLARATIONS \f[B]:set fs=/REGEX/;\f[R] Set field separator .PP@@ -228,9 +242,6 @@ .TP [y]|> {|\[ga]0\[ti]/\[ha]$/} Is the last line blank?-.TP-\&.?{|\[ga]1 \[ti]* 1 /([\[ha]\[rs]?]*)/}-Trim URL .SH BUGS Please report any bugs you may come across to https://github.com/vmchale/jacinda/issues
src/A.hs view
@@ -19,6 +19,7 @@ import qualified Data.ByteString    as BS import qualified Data.IntMap        as IM import           Data.List          (foldl')+import           Data.Maybe         (isJust) import qualified Data.Text          as T import           Data.Text.Encoding (decodeUtf8) import qualified Data.Vector        as V@@ -36,7 +37,7 @@ (<##>) :: Doc a -> Doc a -> Doc a (<##>) x y = x <> hardline <> hardline <> y -data TB = TyInteger | TyFloat | TyStr+data TB = TyI | TyFloat | TyStr         | TyStream | TyVec | TyOption         | TyR | TyBool | TyUnit         deriving (Eq, Ord)@@ -66,7 +67,7 @@        deriving (Eq, Ord)  instance Pretty TB where-    pretty TyInteger = "Integer"; pretty TyStr = "Str"; pretty TyFloat = "Float"+    pretty TyI = "Integer"; pretty TyStr = "Str"; pretty TyFloat = "Float"     pretty TyStream = "Stream"; pretty TyVec = "List"; pretty TyOption = "Optional"     pretty TyBool = "Bool"; pretty TyUnit = "𝟙"; pretty TyR = "Regex" @@ -80,6 +81,8 @@     pretty (TyTup tys)    = jacTup tys     pretty (Rho n fs)     = braces (pretty n <+> pipe <+> prettyFields (IM.toList fs)) +parensp True=parens; parensp False=id+ prettyFields :: [(Int, T)] -> Doc ann prettyFields = mconcat . punctuate "," . fmap g where g (i, t) = pretty i <> ":" <+> pretty t @@ -116,9 +119,10 @@  data BTer = ZipW           | Fold | Scan-          | Substr+          | Substr | Sub1 | Subs           | Option           | Captures | AllCaptures+          | Bookend           deriving (Eq)  instance Pretty BTer where@@ -129,6 +133,9 @@     pretty Option      = "option"     pretty Captures    = "~*"     pretty AllCaptures = "captures"+    pretty Sub1        = "sub1"+    pretty Subs        = "subs"+    pretty Bookend     = "bookend"  -- builtin data BBin = Plus | Times | Div@@ -160,10 +167,12 @@ instance Pretty DfnVar where pretty X = "x"; pretty Y = "y"  -- 0-ary-data N = Ix | Nf | None | Fp deriving (Eq)+data N = Ix | Nf | None | Fp | MZ deriving (Eq)  data L = ILit !Integer | FLit !Double | BLit !Bool | StrLit BS.ByteString deriving (Generic, NFData, Eq) +class PS a where ps :: Int -> a -> Doc ann+ -- expression data E a = Column { eLoc :: a, col :: Int }          | IParseCol { eLoc :: a, col :: Int } | FParseCol { eLoc :: a, col :: Int } | ParseCol { eLoc :: a, col :: Int }@@ -179,6 +188,7 @@          | Let { eLoc :: a, eBind :: (Nm a, E a), eE :: E a }          -- TODO: literals type (make pattern matching easier down the road)          | Var { eLoc :: a, eVar :: !(Nm a) }+         | F { hole :: !(Nm a) }          | Lit { eLoc :: a, lit :: !L }          | RegexLit { eLoc :: a, eRr :: BS.ByteString }          | Lam { eLoc :: a, eBound :: Nm a, lamE :: E a }@@ -195,6 +205,7 @@          | Cond { eLoc :: a, eIf :: E a, eThen :: E a, eElse :: E a }          | In { oop :: E a, ip :: Maybe (E a), mm :: Maybe (E a), istream :: E a }          | RwB { eLoc :: a, eBin :: BBin } | RwT { eLoc :: a, eTer :: BTer }+         -- TODO: "Report" aka $> print stream + display summary expression          deriving (Functor, Generic)  instance Recursive (E a) where@@ -208,6 +219,7 @@             | GuardedF a x x | ImplicitF a x             | LetF a (Nm a, x) x             | VarF a (Nm a)+            | FF (Nm a)             | LitF a !L             | RegexLitF a BS.ByteString             | LamF a (Nm a) x@@ -228,7 +240,7 @@ type instance Base (E a) = (EF a)  instance Pretty N where-    pretty Ix = "⍳"; pretty Nf = "nf"; pretty None = "None"; pretty Fp = "fp"+    pretty Ix="⍳"; pretty Nf="nf"; pretty None="None"; pretty Fp="fp"; pretty MZ="⍬"  instance Pretty L where     pretty (ILit i)     = pretty i@@ -237,70 +249,87 @@     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'-    pretty (EApp _ (EApp _ (BB _ Split) e) e')                    = "split" <+> pretty e <+> pretty e'-    pretty (EApp _ (EApp _ (BB _ Splitc) e) e')                   = "splitc" <+> pretty e <+> pretty e'-    pretty (EApp _ (EApp _ (BB _ Match) e) e')                    = "match" <+> pretty e <+> pretty e'-    pretty (EApp _ (EApp _ (BB _ Sprintf) e) e')                  = "sprintf" <+> pretty e <+> pretty e'-    pretty (EApp _ (EApp _ (BB _ Map) e) e')                      = pretty e <> "¨" <> pretty e'-    pretty (EApp _ (EApp _ (BB _ b) e) e')                        = pretty e <+> pretty b <+> pretty e'-    pretty (EApp _ (BB _ b) e)                                    = parens (pretty e <> pretty b)-    pretty (EApp _ (EApp _ (EApp _ (TB _ Fold) e) e') e'')        = pretty e <> "|" <> pretty e' <+> pretty e''-    pretty (EApp _ (EApp _ (EApp _ (TB _ Scan) e) e') e'')        = pretty e <> "^" <> pretty e' <+> pretty e''-    pretty (EApp _ (EApp _ (EApp _ (TB _ ZipW) op) e') e'')       = "," <> pretty op <+> pretty e' <+> pretty e''-    pretty (EApp _ (EApp _ (EApp _ (TB _ Substr) e) e') e'')      = "substr" <+> pretty e <+> pretty e' <+> pretty e''-    pretty (EApp _ (EApp _ (EApp _ (TB _ Option) e) e') e'')      = "option" <+> pretty e <+> pretty e' <+> pretty e''-    pretty (EApp _ (EApp _ (EApp _ (TB _ AllCaptures) e) e') e'') = "captures" <+> pretty e <+> pretty e' <+> pretty e''-    pretty (EApp _ (EApp _ (EApp _ (TB _ Captures) e) e') e'')    = pretty e <+> "~*" <+> pretty e' <+> pretty e''-    pretty (EApp _ (UB _ (At i)) e)                               = pretty e <> "." <> pretty i-    pretty (EApp _ (UB _ (Select i)) e)                           = pretty e <> "->" <> pretty i-    pretty (EApp _ (UB _ IParse) e')                              = pretty e' <> ":i"-    pretty (EApp _ (UB _ FParse) e')                              = pretty e' <> ":f"-    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 (RegexLit _ rr)                                        = "/" <> pretty (decodeUtf8 rr) <> "/"-    pretty (BB _ b)                                               = parens (pretty b)-    pretty (UB _ u)                                               = pretty u-    pretty (ResVar _ x)                                           = pretty x-    pretty (Tup _ es)                                             = jacTup es-    pretty (Lam _ n e)                                            = parens ("λ" <> pretty n <> "." <+> pretty e)-    pretty (Dfn _ e)                                              = brackets (pretty e)-    pretty (Guarded _ p e)                                        = braces (pretty p) <> braces (pretty e)-    pretty (Implicit _ e)                                         = braces ("|" <+> pretty e)-    pretty (NB _ n)                                               = pretty n-    pretty RC{}                                                   = "(compiled regex)"-    pretty (Let _ (n, b) e)                                       = "let" <+> "val" <+> pretty n <+> ":=" <+> pretty b <+> "in" <+> pretty e <+> "end"-    pretty (Paren _ e)                                            = parens (pretty e)-    pretty (Arr _ es)                                             = tupledByFunky "," (V.toList $ pretty <$> es)-    pretty (Anchor _ es)                                          = "&" <> tupledBy "." (pretty <$> es)-    pretty (OptionVal _ (Just e))                                 = "Some" <+> pretty e-    pretty (OptionVal _ Nothing)                                  = "None"-    pretty (Cond _ e0 e1 e2)                                      = "if" <+> pretty e0 <+> "then" <+> pretty e1 <+> "else" <+> pretty e2-    pretty (RwB _ MapMaybe)                                       = "mapMaybe"-    pretty (RwB _ DedupOn)                                        = "dedupOn"-    pretty (RwB _ Filter)                                         = "filter"-    pretty (RwT _ Fold)                                           = "fold"-    pretty (RwT _ Scan)                                           = "scan"-    pretty (RwB _ Fold1)                                          = "fold1"+mPrec :: BBin -> Maybe Int+mPrec Prior      = Just 5+mPrec DedupOn    = Just 5+mPrec MapMaybe   = Just 5+mPrec Map        = Just 5+mPrec Filter     = Just 5+mPrec Fold1      = Just 5+mPrec Exp        = Just 8+mPrec Plus       = Just 6+mPrec Minus      = Just 6+mPrec Times      = Just 7+mPrec Div        = Just 7+mPrec Eq         = Just 4+mPrec Neq        = Just 4+mPrec Geq        = Just 4+mPrec Gt         = Just 4+mPrec Lt         = Just 4+mPrec Leq        = Just 4+mPrec Matches    = Just 4+mPrec NotMatches = Just 4+mPrec And        = Just 3+mPrec Or         = Just 2+mPrec _          = Nothing +instance PS (E a) where+    ps _ (Column _ i)    = "$" <> pretty i+    ps _ AllColumn{}     = "$0"+    ps _ IParseAllCol{}  = "$0:i"+    ps _ FParseAllCol{}  = "$0:f"+    ps _ ParseAllCol{}   = "$0:"+    ps _ (IParseCol _ i) = "$" <> pretty i <> ":i"+    ps _ (FParseCol _ i) = "$" <> pretty i <> ":f"+    ps _ (ParseCol _ i)  = "$" <> pretty i <> ":"+    ps _ AllField{}      = "`0"+    ps _ (Field _ i)     = "`" <> pretty i+    ps _ LastField{}     = "`*"+    ps _ FieldList{}     = "`$"+    ps d (EApp _ (EApp _ (BB _ op) e0) e1) | Just d' <- mPrec op = parensp (d>d') (ps (d'+1) e0 <+> pretty op <+> ps (d'+1) e1)+    ps _ (EApp _ (BB _ op) e) | isJust (mPrec op) = parens (pretty e <+> pretty op)+    ps d (EApp _ (UB _ (At i)) e)     = parensp (d>0) (ps 1 e) <> "." <> pretty i+    ps d (EApp _ (UB _ (Select i)) e) = parensp (d>0) (ps 1 e) <> "->" <> pretty i+    ps _ (EApp _ (UB _ IParse) e')    = pretty e' <> ":i"+    ps _ (EApp _ (UB _ FParse) e')    = pretty e' <> ":f"+    ps _ (EApp _ (UB _ Parse) e')     = pretty e' <> ":"+    ps d (EApp _ (EApp _ (EApp _ (TB _ Bookend) e) e') e'')  = parensp (d>3) (ps 4 e <> ",," <> ps 4 e' <+> ps 5 e'')+    ps d (EApp _ (EApp _ (EApp _ (TB _ Fold) e) e') e'')     = parensp (d>5) (ps 6 e <> "|" <> ps 6 e' <+> ps 7 e'')+    ps d (EApp _ (EApp _ (EApp _ (TB _ Scan) e) e') e'')     = parensp (d>5) (ps 6 e <> "^" <> ps 6 e' <+> ps 7 e'')+    ps d (EApp _ (EApp _ (EApp _ (TB _ ZipW) op) e') e'')    = parensp (d>5) ("," <> ps 6 op <+> ps 7 e' <+> ps 8 e'')+    ps d (EApp _ (EApp _ (EApp _ (TB _ Captures) e) e') e'') = parensp (d>6) (ps 7 e <+> "~*" <+> ps 7 e' <+> ps 8 e'')+    ps d (EApp _ e0 e1) = parensp (d>10) (ps 10 e0 <+> ps 11 e1)+    ps d (OptionVal _ (Just e)) = parensp (d>10) ("Some" <+> ps 11 e)+    ps _ (OptionVal _ Nothing) = "None"+    ps _ (BB _ op)         = parens (pretty op)+    ps _ (Lit _ l)         = pretty l+    ps _ (Var _ n)         = pretty n+    ps _ (F n)             = pretty n+    ps _ (RegexLit _ rr)   = "/" <> pretty (decodeUtf8 rr) <> "/"+    ps _ (UB _ u)          = pretty u+    ps _ (ResVar _ x)      = pretty x+    ps _ (Dfn _ e)         = brackets (pretty e)+    ps _ (NB _ n)          = pretty n+    ps _ RC{}              = "(compiled regex)"+    ps _ (Guarded _ p e)   = braces (pretty p) <> braces (pretty e)+    ps _ (Implicit _ e)    = braces ("|" <+> pretty e)+    ps _ (Paren _ e)       = parens (pretty e)+    ps _ (RwB _ MapMaybe)  = "mapMaybe"+    ps _ (RwB _ DedupOn)   = "dedupOn"+    ps _ (RwB _ Filter)    = "filter"+    ps _ (RwT _ Fold)      = "fold"+    ps _ (RwT _ Scan)      = "scan"+    ps _ (RwB _ Fold1)     = "fold1"+    ps _ (Cond _ e0 e1 e2) = "?" <> pretty e0 <> ";" <+> pretty e1 <> ";" <+> pretty e2+    ps _ (Tup _ es)        = jacTup es+    ps _ (Arr _ es)        = tupledByFunky "," (V.toList $ pretty <$> es)+    ps _ (Anchor _ es)     = "&" <> tupledBy "." (pretty <$> es)+    ps _ (Let _ (n, b) e)  = "let" <+> "val" <+> pretty n <+> ":=" <+> pretty b <+> "in" <+> pretty e <+> "end"+    ps d (Lam _ n e)       = parensp (d>1) ("λ" <> pretty n <> "." <+> ps 2 e)+    ps _ (TB _ g)          = pretty g++instance Pretty (E a) where pretty=ps 0+ instance Show (E a) where show=show.pretty  -- for tests@@ -338,7 +367,7 @@  data C = IsNum | IsEq | IsOrd        | IsParse | IsPrintf-       | IsSemigroup+       | IsSemigroup | IsMonoid        | Functor -- ^ For map (@"@)        | Foldable | Witherable        deriving (Eq, Ord)@@ -348,6 +377,7 @@     pretty IsParse = "Parseable"; pretty IsSemigroup = "Semigroup"     pretty Functor = "Functor"; pretty Foldable = "Foldable"     pretty IsPrintf = "Printf"; pretty Witherable = "Witherable"+    pretty IsMonoid = "Monoid"  instance Show C where show=show.pretty @@ -355,7 +385,7 @@ data D a = SetFS T.Text | SetRS T.Text          | FunDecl (Nm a) [Nm a] (E a)          | FlushDecl-         | SetAsv+         | SetAsv | SetUsv | SetOFS T.Text | SetORS T.Text          deriving (Functor)  instance Pretty (D a) where@@ -364,6 +394,9 @@     pretty (FunDecl n ns e) = "fn" <+> pretty n <> tupled (pretty <$> ns) <+> ":=" <#> indent 2 (pretty e <> ";")     pretty FlushDecl        = ":flush;"     pretty SetAsv           = ":set asv;"+    pretty SetUsv           = ":set usv;"+    pretty (SetOFS sep)     = ":set ofs :=" <+> "'" <> pretty sep <> "';"+    pretty (SetORS sep)     = ":set ors :=" <+> "'" <> pretty sep <> "';"  data Program a = Program { decls :: [D a], expr :: E a } deriving (Functor) @@ -378,7 +411,8 @@ 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 _ SetAsv           = (Just "\\x1f", Just "\\x1e")+    go _ SetUsv           = (Just "␞",Just "␟")     go (fs, _) (SetRS bs) = (fs, Just bs)     go next _             = next
src/A/I.hs view
@@ -7,7 +7,7 @@            ) where  import           A-import           Control.Monad.State.Strict (State, gets, modify, runState, state)+import           Control.Monad.State.Strict (State, evalState, gets, modify, runState, state) import           Data.Bifunctor             (second) import           Data.Foldable              (traverse_) import qualified Data.IntMap                as IM@@ -28,7 +28,7 @@ bind :: Nm a -> E a -> ISt a -> ISt a bind (Nm _ (U u) _) e (ISt r bs) = ISt r (IM.insert u e bs) -runI i = second (max_.renames) . flip runState (ISt (Renames i mempty) mempty)+runI i = second (max_.renames) . flip runState (ISt (Rs i mempty) mempty)  ib :: Int -> Program T -> (E T, Int) ib i = uncurry (flip β).runI i.iP where iP (Program ds e) = traverse_ iD ds *> iE e@@ -41,7 +41,8 @@  iD :: D T -> RM T () iD (FunDecl n [] e) = do {eI <- iE e; modify (bind n eI)}-iD SetFS{} = pure (); iD SetRS{} = pure (); iD SetAsv = pure (); iD FlushDecl{} = pure ()+iD SetFS{} = pure (); iD SetRS{} = pure (); iD SetAsv = pure (); iD SetUsv = pure ()+iD SetORS{} = pure (); iD SetOFS{} = pure (); iD FlushDecl{} = pure () iD FunDecl{} = desugar  desugar = error "Internal error. Should have been de-sugared in an earlier stage!"
src/File.hs view
@@ -6,12 +6,13 @@             ) where  import           A+import           A.E import           A.I import           Control.Applicative        ((<|>)) import           Control.Exception          (Exception, throw, throwIO) import           Control.Monad              ((<=<)) import           Control.Monad.IO.Class     (liftIO)-import           Control.Monad.State.Strict (StateT, get, put, runStateT)+import           Control.Monad.State.Strict (StateT, get, put, runState, runStateT) import           Control.Recursion          (cata, embed) import           Data.Bifunctor             (second) import qualified Data.ByteString            as BS@@ -25,7 +26,7 @@ import           Data.Tuple                 (swap) import           Include import           Jacinda.Backend.Const-import           Jacinda.Backend.P+import           Jacinda.Backend.T import           Jacinda.Check.Field import           Jacinda.Regex import           L@@ -82,7 +83,7 @@         Right (ast, m) ->             let (typed, i) = yeet $ runTyM m (tyP ast)                 (inlined, j) = ib i typed-            in eB j pure (compileR (error "nf not defined.") inlined)+            in eB j (compileR (error "nf not defined.") inlined)  compileFS :: Maybe T.Text -> RurePtr compileFS = maybe defaultRurePtr tcompile@@ -101,7 +102,8 @@     let (eI, j) = ib i typed     m'Throw $ cF eI     let ~(afs, ars) = getS ast-    cont <- yIO $ runJac (compileFS (cliFS <|> afs)) (flushD typed) j (compileR (encodeUtf8 $ T.pack fp) eI)+        (e', k) = runState (eta eI) j+        cont=run (compileFS (cliFS <|> afs)) (flushD typed) k (compileR (encodeUtf8 $ T.pack fp) e')     case cliRS <|> ars of         Nothing -> cont $ fmap BSL.toStrict (ASCIIL.lines contents)         Just rs -> cont $ lazySplit (tcompile rs) contents
− src/Jacinda/Backend/P.hs 
@@ -1,463 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Jacinda.Backend.P ( EvalErr (..), runJac, eB ) where--import           A-import           A.I-import           Control.Exception          (Exception, throw)-import           Control.Monad              (foldM, (<=<))-import           Control.Monad.State.Strict (State, evalState, get, modify, runState)-import           Data.Bifunctor             (bimap)-import qualified Data.ByteString            as BS-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 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-import           Jacinda.Fuse-import           Jacinda.Regex-import           Nm-import           Prettyprinter              (hardline, pretty)-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 (TyB TyStream:$_) _)) Fold1) = 1-φ1 (EApp _ e0 e1)                                          = φ1 e0+φ1 e1-φ1 (Tup _ es)                                              = sum (φ1<$>es)-φ1 (OptionVal _ (Just e))                                  = φ1 e-φ1 (Cond _ p e0 e1)                                        = φ1 p+φ1 e0+φ1 e1-φ1 (Lam _ _ e)                                             = φ1 e-φ1 _                                                       = 0---φ :: E T -> Int-φ (TB (TyArr _ (TyArr _ (TyArr (TyB TyStream:$_) _))) Fold) = 1-φ (EApp _ e0 e1)                                                   = φ e0+φ e1-φ (Tup _ es)                                                       = sum (φ<$>es)-φ (OptionVal _ (Just e))                                           = φ e-φ (Cond _ p e0 e1)                                                 = φ p+φ e0+φ e1-φ (Lam _ _ e)                                                      = φ e-φ _                                                                = 0--noleak :: E T -> Bool-noleak e = φ e > 1 && φ1 e < 1--runJac :: RurePtr -- ^ Record separator-       -> Bool -- ^ Flush output?-       -> Int-       -> E T-       -> Either StreamError ([BS.ByteString] -> IO ())-runJac re f i e = ϝ (bsProcess re f) (if noleak e then fuse i e else (e, i)) where ϝ = uncurry.flip--data StreamError = NakedField deriving (Show)--instance Exception StreamError where--data EvalErr = EmptyFold-             | IndexOutOfBounds Int-             | InternalCoercionError (E T) TB-             | ExpectedTup (E T)-             | BadHole (Nm T)-             deriving (Show)--instance Exception EvalErr where--(!) :: V.Vector a -> Int -> a-v ! ix = case v V.!? ix of {Just x  -> x; Nothing -> throw $ IndexOutOfBounds ix}--parseAsEInt :: BS.ByteString -> E T-parseAsEInt = mkI.readDigits--parseAsF :: BS.ByteString -> E T-parseAsF = mkF.readFloat--readFloat :: BS.ByteString -> Double-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!"-    Just (c,b) | BS.null b -> c-    Just _                 -> error "Splitc takes only one char!"--asTup :: Maybe RureMatch -> E T-asTup Nothing                = OptionVal undefined Nothing-asTup (Just (RureMatch s e)) = OptionVal undefined (Just (Tup undefined (mkI . fromIntegral <$> [s, e])))--mkFoldVar :: Int -> b -> E b-mkFoldVar i l = Var l (Nm "fold_placeholder" (U i) l)--takeConcatMap :: (a -> [b]) -> [a] -> [b]-takeConcatMap f = concat . transpose . fmap f---- this relies on all streams being the same length stream which in turn relies--- on the fuse step (fold-of-filter->fold)-foldAll :: Int -> RurePtr -> [(Int, E T, E T, E T)] -> [BS.ByteString] -> ([(Int, E T)], Int)-foldAll i r xs bs = runState (foldMultiple seeds streams ctxStream ixStream) i-    where (ns, ops, seeds, es) = unzip4 xs-          mkStream e = eStream i r e bs-          streams = mkStream<$>es-          ctxStream = [(b, splitBy r b) | b <- bs]-          ixStream = [1..]--          foldMultiple seedsϵ esϵ (ctx:ctxes) (ix:ixes) = allHeads esϵ `seq` do {es' <- sequence$zipWith3 (c2Mϵ (pure.eCtx ctx ix)) ops seedsϵ (head<$>esϵ); foldMultiple es' (tail<$>esϵ) ctxes ixes}-          -- TODO: sanity check same length all streams-          foldMultiple seedsϵ _ [] _ = pure$zip ns seedsϵ--          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@(TyB TyStream:$_) <- eLoc stream = do-    (i,_) <- get-    modify (bimap (+1) ((i, op, seed, stream) :))-    pure $ mkFoldVar i t-gf (EApp ty e0 e1) = EApp ty <$> gf e0 <*> gf e1-gf (Tup ty es) = Tup ty <$> traverse gf es-gf (Arr ty es) = Arr ty <$> traverse gf es-gf (OptionVal ty e) = OptionVal ty <$> traverse gf e-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@Lit{} = pure e-gf e@RC{} = pure e; gf e@Var{} = pure e--ug :: IM.IntMap (E T) -> E T -> E T-ug st (Var _ n@(Nm _ (U i) _)) =-    IM.findWithDefault (throw (BadHole n)) i st-ug _ e = e--bsProcess :: RurePtr-          -> Bool -- ^ Flush output?-          -> Int -- ^ Unique context-          -> E T-          -> Either StreamError ([BS.ByteString] -> IO ())-bsProcess _ _ _ AllField{} = Left NakedField-bsProcess _ _ _ Field{}    = Left NakedField-bsProcess _ _ _ (NB _ Ix)  = Left NakedField-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)--pDocLn = putDoc.(<>hardline).pretty--pS p = traverse_ g where g | p = (*>fflush).pDocLn | otherwise = pDocLn-                         fflush = hFlush stdout--scanM :: Monad m => (b -> a -> m b) -> b -> [a] -> m [b]-scanM op seed xs = sequence $-    scanl' go (pure seed) xs where go seedϵ x = do {seedϵ' <- seedϵ; op seedϵ' x}--eF :: Int -> RurePtr -> E T -> [BS.ByteString] -> E T-eF u r e | noleak e = \bs ->-    let (eHoley, (_, folds)) = runState (gf e) (0, [])-        (filledHoles, u') = foldAll u r folds bs-        in eB u' (pure.ug (IM.fromList filledHoles)) eHoley-        | otherwise = \bs ->-        eB u (go bs) e-            where go bb (EApp _ (EApp _ (EApp _ (TB _ Fold) op) seed) xs) = do-                      op' <- eBM pure op-                      seed' <- eBM pure seed-                      let xsϵ=eStream u r xs bb-                      foldM (c2M op') seed' xsϵ-                  go bb (EApp _ (EApp _ (BB _ Fold1) op) xs) = do-                      op' <- eBM pure op-                      let (seed',xsϵ)=case uncons $ eStream u r xs bb of {Just s -> s; Nothing -> throw EmptyFold}-                      foldM (c2M op') seed' xsϵ-                  go _ eϵ = pure eϵ---a1 :: E T -> E T -> UM (E T)-a1 f x | TyArr _ cod <- eLoc f = lβ (EApp cod f x)--a2 :: E T -> E T -> E T -> UM (E T)-a2 op x0 x1 | TyArr _ t@(TyArr _ t') <- eLoc op = lβ (EApp t' (EApp t op x0) x1)--c1 :: Int -> E T -> E T -> E T-c1 i f x = evalState (eBM pure =<< a1 f x) i--c2M op x0 x1 = eBM pure =<< a2 op x0 x1-c2Mϵ f g e e' = eBM f =<< a2 g e e'--c2 :: Int -> E T -> E T -> E T -> E T-c2 i op x0 x1 = evalState (c2M op x0 x1) i--eStream :: Int -> RurePtr -> E T -> [BS.ByteString] -> [E T]-eStream u r (EApp _ (EApp _ (EApp _ (TB _ Scan) op) seed) xs) bs =-    let op'=eB u pure op; seed'=eB u pure seed; xsϵ=eStream u r xs bs-    in evalState (scanM (c2M op') seed' xsϵ) u-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 (_:$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 (_:$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 (_:$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-eStream u r (Guarded _ p e) bs =-    let bss=(\b -> (b, splitBy r b))<$>bs-    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 (Lit _ (StrLit s)) = s; asS e = throw (InternalCoercionError e TyStr)--asI :: E T -> Integer-asI (Lit _ (ILit i)) = i; asI e = throw (InternalCoercionError e TyInteger)--asF :: E T -> Double-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)--asM :: E T -> Maybe (E T)-asM (OptionVal _ e) = e; asM e = throw (InternalCoercionError e TyOption)--asB :: E T -> Bool-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)--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--eB :: Int -> (E T -> UM (E T)) -> E T -> E T-eB i f x = evalState (eBM f x) i--{-# SCC eBM #-}-eBM :: (E T -> UM (E T)) -> E T -> UM (E T)-eBM f (EApp t (EApp _ (EApp _ (TB _ Captures) s) i) r) = do-    s' <- eBM f s; i' <- eBM f i; r' <- eBM f r-    pure $ OptionVal t (mkStr <$> findCapture (asR r') (asS s') (fromIntegral$asI i'))-eBM f (EApp t (EApp _ (EApp _ (TB _ AllCaptures) s) i) r) = do-    s' <- eBM f s; i' <- eBM f i; r' <- eBM f r-    pure $ Arr t (V.fromList (mkStr <$> captures' (asR r') (asS s') (fromIntegral$asI i')))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyInteger) _) Max) x0) x1) = do-    x0' <- asI<$>eBM f x0; x1' <- asI<$>eBM f x1-    pure (mkI (max x0' x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyInteger) _) Min) x0) x1) = do-    x0' <- asI<$>eBM f x0; x1' <- asI<$>eBM f x1-    pure (mkI (min x0' x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) Min) x0) x1) = do-    x0' <- asF<$>eBM f x0; x1' <- asF<$>eBM f x1-    pure (mkF (min x0' x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) Max) x0) x1) = do-    x0' <- asF<$>eBM f x0; x1' <- asF<$>eBM f x1-    pure (mkF (max x0' x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) Min) x0) x1) = do-    x0' <- asS<$>eBM f x0; x1' <- asS<$>eBM f x1-    pure (mkStr (min x0' x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) Max) x0) x1) = do-    x0' <- asS<$>eBM f x0; x1' <- asS<$>eBM f x1-    pure (mkStr (max x0' x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyInteger) _) Plus) x0) x1) = do-    x0' <- asI <$> eBM f x0; x1' <- asI<$>eBM f x1-    pure (mkI (x0'+x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyInteger) _) Minus) x0) x1) = do-    x0' <- asI <$> eBM f x0; x1' <- asI<$>eBM f x1-    pure (mkI (x0'-x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyInteger) _) Times) x0) x1) = do-    x0' <- asI <$> eBM f x0; x1' <- asI<$>eBM f x1-    pure (mkI (x0'*x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) Plus) x0) x1) = do-    x0' <- asF <$> eBM f x0; x1' <- asF<$>eBM f x1-    pure (mkF (x0'+x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) Minus) x0) x1) = do-    x0' <- asF <$> eBM f x0; x1' <- asF<$>eBM f x1-    pure (mkF (x0'-x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) Times) x0) x1) = do-    x0' <- asF <$> eBM f x0; x1' <- asF<$>eBM f x1-    pure (mkF (x0'*x1'))-eBM f (EApp _ (EApp _ (BB _ Div) x0) x1) = do-    x0' <- asF <$> eBM f x0; x1' <- asF<$>eBM f x1-    pure (mkF (x0'/x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyInteger) _) Eq) x0) x1) = do-    x0' <- asI<$>eBM f x0; x1' <- asI<$>eBM f x1-    pure (mkB (x0'==x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyInteger) _) Neq) x0) x1) = do-    x0' <- asI<$>eBM f x0; x1' <- asI<$>eBM f x1-    pure (mkB (x0'/=x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyInteger) _) Gt) x0) x1) = do-    x0' <- asI<$>eBM f x0; x1' <- asI<$>eBM f x1-    pure (mkB (x0'>x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyInteger) _) Lt) x0) x1) = do-    x0' <- asI<$>eBM f x0; x1' <- asI<$>eBM f x1-    pure (mkB (x0'<x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyInteger) _) Leq) x0) x1) = do-    x0' <- asI<$>eBM f x0; x1' <- asI<$>eBM f x1-    pure (mkB (x0'<=x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyInteger) _) Geq) x0) x1) = do-    x0' <- asI<$>eBM f x0; x1' <- asI<$>eBM f x1-    pure (mkB (x0'>=x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) Gt) x0) x1) = do-    x0' <- asF<$>eBM f x0; x1' <- asF<$>eBM f x1-    pure (mkB (x0'>x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) Lt) x0) x1) = do-    x0' <- asF<$>eBM f x0; x1' <- asF<$>eBM f x1-    pure (mkB (x0'<x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) Eq) x0) x1) = do-    x0' <- asF<$>eBM f x0; x1' <- asF<$>eBM f x1-    pure (mkB (x0'==x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) Neq) x0) x1) = do-    x0' <- asF<$>eBM f x0; x1' <- asF<$>eBM f x1-    pure (mkB (x0'/=x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) Geq) x0) x1) = do-    x0' <- asF<$>eBM f x0; x1' <- asF<$>eBM f x1-    pure (mkB (x0'>=x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) Leq) x0) x1) = do-    x0' <- asF<$>eBM f x0; x1' <- asF<$>eBM f x1-    pure (mkB (x0'<=x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) Eq) x0) x1) = do-    x0' <- asS<$>eBM f x0; x1' <- asS<$>eBM f x1-    pure (mkB (x0'==x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) Neq) x0) x1) = do-    x0' <- asS<$>eBM f x0; x1' <- asS<$>eBM f x1-    pure (mkB (x0'/=x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) Gt) x0) x1) = do-    x0' <- asS<$>eBM f x0; x1' <- asS<$>eBM f x1-    pure (mkB (x0'>x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) Geq) x0) x1) = do-    x0' <- asS<$>eBM f x0; x1' <- asS<$>eBM f x1-    pure (mkB (x0'>=x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) Lt) x0) x1) = do-    x0' <- asS<$>eBM f x0; x1' <- asS<$>eBM f x1-    pure (mkB (x0'<x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) Leq) x0) x1) = do-    x0' <- asS<$>eBM f x0; x1' <- asS<$>eBM f x1-    pure (mkB (x0'<=x1'))-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyInteger) _) Exp) x0) x1) = do-    x0' <- asI <$> eBM f x0; x1' <- asI<$>eBM f x1-    pure (mkI (x0'^x1'))-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 (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 (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)-        (Nothing, Just{})  -> pure (mkB False)-        (Just{}, Nothing)  -> pure (mkB False)-        (Just e0, Just e1) -> c2Mϵ f op e0 e1-    where op = BB (TyArr t (TyArr t tyB)) Eq-eBM f (EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) Plus) x0) x1) = do-    x0' <- asS <$> eBM f x0; x1' <- asS<$>eBM f x1-    pure (mkStr (x0'<>x1'))-eBM f (EApp _ (EApp _ (BB _ And) x0) x1) = do-    x0' <- asB<$>eBM f x0; x1' <- asB<$>eBM f x1-    pure (mkB (x0'&&x1'))-eBM f (EApp _ (EApp _ (BB _ Or) x0) x1) = do-    x0' <- asB<$>eBM f x0; x1' <- asB<$>eBM f x1-    pure (mkB (x0'||x1'))-eBM f (EApp _ (UB _ Not) b) = do {b' <- asB<$>eBM f b; pure $ mkB (not b')}-eBM f (EApp _ (EApp _ (BB _ Matches) s) r) = {-# SCC "eBMMatch" #-} do-    s' <- asS<$>eBM f s; r' <- asR<$>eBM f r-    pure $ mkB (isMatch' r' s')-eBM f (EApp _ (EApp _ (BB _ NotMatches) s) r) = do-    s' <- asS<$>eBM f s; r' <- asR<$>eBM f r-    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 (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 (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'))}-eBM f (EApp (TyB TyFloat) (UB _ Parse) x) = do {x' <- eBM f x; pure (parseAsF (asS x'))}-eBM f (EApp _ (UB _ (At i)) v) = do {v' <- eBM f v; pure (asV v'!(i-1))}-eBM f (EApp _ (UB _ (Select i)) x) = do {x' <- eBM f x; pure (asT x' !! (i-1))}-eBM f (EApp _ (UB _ Floor) x) = do {xr <- asF<$>eBM f x; pure $ mkI (floor xr)}-eBM f (EApp _ (UB _ Ceiling) x) = do {xr <- asF<$>eBM f x; pure $ mkI (ceiling xr)}-eBM f (EApp (TyB TyInteger) (UB _ Negate) i) = do {i' <- eBM f i; pure $ mkI (negate (asI i'))}-eBM f (EApp (TyB TyFloat) (UB _ Negate) x) = do {x' <- eBM f x; pure $ mkF (negate (asF x'))}-eBM f (EApp t (UB _ Some) e) = do {e' <- eBM f e; pure (OptionVal t (Just e'))}-eBM _ (NB t None) = pure (OptionVal t Nothing)-eBM f (EApp _ (UB _ Tally) e) = do-    s' <- eBM f e-    let r =fromIntegral (BS.length$asS s')-    pure (mkI r)-eBM f (EApp _ (UB _ TallyList) e) = do-    e' <- eBM f e-    let r=fromIntegral (V.length$asV e')-    pure (mkI r)-eBM f (EApp _ (EApp _ (UB _ Const) e) _) = eBM f e-eBM f (EApp _ (EApp _ (BB _ Sprintf) fs) s) = do-    fs' <- eBM f fs; s' <- eBM f s-    pure $ mkStr (sprintf (asS fs') s')-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) | 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) | 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@(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@(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-    x' <- eBM f x; g' <- eBM f g; y' <- eBM f y-    case asM y' of-        Nothing -> pure x'-        Just yϵ -> eBM f =<< lβ (EApp t g' yϵ)-eBM f (EApp _ (EApp _ (EApp _ (TB _ Substr) s) i0) i1) = do-    i0' <- eBM f i0; i1' <- eBM f i1; s' <- eBM f s-    pure $ mkStr (substr (asS s') (fromIntegral$asI i0') (fromIntegral$asI i1'))-eBM f (Cond _ p e e') = do {p' <- eBM f p; if asB p' then eBM f e else eBM f e'}-eBM f (Tup t es) = Tup t <$> traverse (eBM f) es-eBM f e = f e
src/Jacinda/Backend/Parse.hs view
@@ -1,7 +1,14 @@-module Jacinda.Backend.Parse ( readDigits ) where+module Jacinda.Backend.Parse ( readDigits, readFloat ) where  import qualified Data.ByteString       as BS import qualified Data.ByteString.Char8 as ASCII+import           Foreign.C.String      (CString)+import           System.IO.Unsafe      (unsafeDupablePerformIO)++readFloat :: BS.ByteString -> Double+readFloat = unsafeDupablePerformIO . (`BS.useAsCString` atof)++foreign import ccall unsafe atof :: CString -> IO Double  readDigits :: BS.ByteString -> Integer readDigits b | Just (45, bs) <- BS.uncons b = negate $ readDigits bs
src/Jacinda/Backend/Printf.hs view
@@ -4,23 +4,27 @@                               ) where  import           A-import qualified Data.ByteString    as BS-import qualified Data.Text          as T-import           Data.Text.Encoding (decodeUtf8, encodeUtf8)+import qualified Data.ByteString                   as BS+import           Data.ByteString.Builder           (toLazyByteString)+import           Data.ByteString.Builder.RealFloat (doubleDec)+import qualified Data.ByteString.Lazy              as BSL+import qualified Data.Text                         as T+import           Data.Text.Encoding                (decodeUtf8, encodeUtf8)  sprintf :: BS.ByteString -- ^ Format string         -> E a         -> BS.ByteString sprintf fmt e = encodeUtf8 (sprintf' (decodeUtf8 fmt) e) --- TODO: https://hackage.haskell.org/package/floatshow---+pf :: Double -> T.Text+pf = decodeUtf8 . BSL.toStrict . toLazyByteString . doubleDec+ -- TODO: interpret precision, like %0.6f %.6  sprintf' :: T.Text -> E a -> T.Text sprintf' fmt (Lit _ (FLit f)) =     let (prefix, fmt') = T.breakOn "%f" fmt-        in prefix <> T.pack (show f) <> T.drop 2 fmt'+        in prefix <> pf f <> T.drop 2 fmt' sprintf' fmt (Lit _ (ILit i)) =     let (prefix, fmt') = T.breakOn "%i" fmt         in prefix <> T.pack (show i) <> T.drop 2 fmt'
+ src/Jacinda/Backend/T.hs view
@@ -0,0 +1,605 @@+{-# LANGUAGE OverloadedStrings #-}++module Jacinda.Backend.T ( run, eB ) where++import           A+import           A.I+import           Control.Exception                 (Exception, throw)+import           Control.Monad                     ((<=<))+import           Control.Monad.State.Strict        (State, evalState, runState, state)+import qualified Data.ByteString                   as BS+import           Data.ByteString.Builder           (hPutBuilder)+import           Data.ByteString.Builder.RealFloat (doubleDec)+import           Data.Foldable                     (fold, traverse_)+import           Data.Function                     ((&))+import qualified Data.IntMap.Strict                as IM+import qualified Data.IntSet                       as IS+import           Data.List                         (foldl', scanl')+import           Data.Maybe                        (fromMaybe)+import qualified Data.Set                          as S+import qualified Data.Vector                       as V+import           Data.Word                         (Word8)+import           Jacinda.Backend.Const+import           Jacinda.Backend.Parse+import           Jacinda.Backend.Printf+import           Jacinda.Regex+import           Nm+import           Prettyprinter                     (hardline, pretty)+import           Prettyprinter.Render.Text         (putDoc)+import           Regex.Rure                        (RureMatch (RureMatch), RurePtr)+import           System.IO                         (hFlush, stdout)+import           Ty.Const+import           U++data EvalErr = EmptyFold+             | IndexOutOfBounds Int+             | NoSuchField Int BS.ByteString+             | InternalCoercionError (E T) TB+             | ExpectedTup (E T)+             | InternalTmp Tmp+             | InternalNm (Nm T)+             | InternalArityOrEta Int (E T)+             deriving (Show)++instance Exception EvalErr where++data StreamError = NakedField deriving (Show)++instance Exception StreamError where++-- TODO: dedup... tracking env!+type Env = IM.IntMap (Maybe (E T)); type I=Int+data Σ = Σ !I Env (IM.IntMap (S.Set BS.ByteString)) (IM.IntMap IS.IntSet) (IM.IntMap (S.Set Double))+type Tmp = Int+type Β = IM.IntMap (E T)++mE :: (Env -> Env) -> Σ -> Σ+mE f (Σ i e d di df) = Σ i (f e) d di df+gE (Σ _ e _ _ _) = e++at :: V.Vector a -> Int -> a+v `at` ix = case v V.!? (ix-1) of {Just x -> x; Nothing -> throw $ IndexOutOfBounds ix}++fieldOf :: V.Vector BS.ByteString -> BS.ByteString -> Int -> BS.ByteString+fieldOf fs b n = case fs V.!? (n-1) of {Just x -> x; Nothing -> throw $ NoSuchField n b}++parseAsEInt :: BS.ByteString -> E T+parseAsEInt = mkI.readDigits++parseAsF :: BS.ByteString -> E T+parseAsF = mkF.readFloat++(!) :: Env -> Tmp -> Maybe (E T)+(!) m r = IM.findWithDefault (throw$InternalTmp r) r m++foldSeq x = foldr seq () x `seq` x++type MM = State Int++nI :: MM Int+nI = state (\i -> (i, i+1))++nN :: T -> MM (Nm T)+nN t = do {u <- nI; pure (Nm "fold_hole" (U u) t)}++run :: RurePtr -> Bool -> Int -> E T -> [BS.ByteString] -> IO ()+run _ _ _ e _ | TyB TyUnit <- eLoc e = undefined+run r flush j e bs | TyB TyStream:$_ <- eLoc e = traverse_ (traverse_ (pS flush)).flip evalState j $ do+    t <- nI+    (iEnv, μ) <- ctx e t+    u <- nI+    let ctxs=zipWith (\ ~(x,y) z -> (x,y,z)) [(b, splitBy r b) | b <- bs] [1..]+        outs=μ<$>ctxs; es=scanl' (&) (Σ u iEnv IM.empty IM.empty IM.empty) outs+    pure ((! t).gE<$>es)+run r _ j e bs = pDocLn $ evalState (summar r e bs) j++pS p = if p then (*>fflush).pDocLn else pDocLn where fflush = hFlush stdout++pDocLn :: E T -> IO ()+pDocLn (Lit _ (FLit f)) = hPutBuilder stdout (doubleDec f <> "\n")+pDocLn e                = putDoc (pretty e <> hardline)++summar :: RurePtr -> E T -> [BS.ByteString] -> MM (E T)+summar r e bs = do+    (iEnv, g, e0) <- collect e+    u <- nI+    let ctxs=zipWith (\ ~(x,y) z -> (x,y,z)) [(b, splitBy r b) | b <- bs] [1..]+        updates=g<$>ctxs+        finEnv=foldl' (&) (Σ u iEnv IM.empty IM.empty IM.empty) updates+    e0@>(fromMaybe (throw EmptyFold)<$>gE finEnv)++collect :: E T -> MM (Env, LineCtx -> Σ -> Σ, E T)+collect e@(EApp ty (EApp _ (EApp _ (TB _ Fold) _) _) _) = do+    v <- nN ty+    (iEnv, g) <- φ e (unU$unique v)+    pure (iEnv, g, F v)+collect e@(EApp ty (EApp _ (BB _ Fold1) _) _) = do+    v <- nN ty+    (iEnv, g) <- φ e (unU$unique v)+    pure (iEnv, g, F v)+collect (Tup ty es) = do+    (seedEnvs, updates, es') <- unzip3 <$> traverse collect es+    pure (fold seedEnvs, ts updates, Tup ty es')+collect (EApp ty0 (EApp ty1 op@BB{} e0) e1) = do+    (env0, f0, e0') <- collect e0+    (env1, f1, e1') <- collect e1+    pure (env0<>env1, \l -> f1 l.f0 l, EApp ty0 (EApp ty1 op e0') e1')+collect (EApp ty f@UB{} e) = do+    (env, fϵ, eϵ) <- collect e+    pure (env, fϵ, EApp ty f eϵ)+collect e@Lit{} = pure (IM.empty, const id, e)++ts :: [LineCtx -> Σ -> Σ] -> LineCtx -> Σ -> Σ+ts = foldl' (\f g l -> f l.g l) (const id)++φ :: E T -> Tmp -> MM (Env, LineCtx -> Σ -> Σ)+φ (EApp _ (EApp _ (EApp _ (TB _ Fold) op) seed) xs) tgt = do+    t <- nI+    seed' <- seed @> mempty+    let iEnv=IM.singleton tgt (Just$!seed')+    (env, f) <- ctx xs t+    let g=wF op t tgt+    pure (env<>iEnv, (g.).f)+φ (EApp _ (EApp _ (EApp _ (TB _ Scan) op) seed) xs) tgt = do+    t <- nI+    seed' <- seed @> mempty+    let iEnv=IM.singleton tgt (Just$!seed')+    (env, f) <- ctx xs t+    let g=wF op t tgt+    pure (env<>iEnv, (g.).f)+φ (EApp _ (EApp _ (BB _ Fold1) op) xs) tgt = do+    let iEnv=IM.singleton tgt Nothing+    t <- nI+    (env, f) <- ctx xs t+    let g=wF op t tgt+    pure (env<>iEnv, (g.).f)++κ :: E T -> LineCtx -> E T+κ AllField{} ~(b, _, _)   = mkStr b+κ (Field _ i) ~(_, bs, _) = mkStr $ bs `at` i+κ LastField{} ~(_, bs, _) = mkStr $ V.last bs+κ FieldList{} ~(_, bs, _) = vS bs+κ (EApp ty e0 e1) line    = EApp ty (e0 `κ` line) (e1 `κ` line)+κ (NB _ Ix) ~(_, _, fp)   = mkI fp+κ (NB _ Nf) ~(_, bs, _)   = mkI$fromIntegral (length bs)+κ e@BB{} _                = e+κ e@UB{} _                = e+κ e@TB{} _                = e+κ e@NB{} _                = e+κ e@Lit{} _               = e+κ e@RC{} _                = e+κ e@Var{} _               = e+κ (Lam t n e) line        = Lam t n (κ e line)++ni t=IM.singleton t Nothing+na=IM.alter go where go Nothing = Just Nothing; go x@Just{} = x++ctx :: E T -> Tmp -> MM (Env, LineCtx -> Σ -> Σ)+ctx AllColumn{} res                                     = pure (ni res, \ ~(b, _, _) -> mE$IM.insert res (Just$!mkStr b))+ctx (ParseAllCol (_:$TyB TyI)) res                      = pure (ni res, \ ~(b, _, _) -> mE$IM.insert res (Just$!parseAsEInt b))+ctx (ParseAllCol (_:$TyB TyFloat)) res                  = pure (ni res, \ ~(b, _, _) -> mE$IM.insert res (Just$!parseAsF b))+ctx FParseAllCol{} res                                  = pure (ni res, \ ~(b, _, _) -> mE$IM.insert res (Just$!parseAsF b))+ctx IParseAllCol{} res                                  = pure (ni res, \ ~(b, _, _) -> mE$IM.insert res (Just$!parseAsEInt b))+ctx (Column _ i) res                                    = pure (ni res, \ ~(b, bs, _) -> mE$IM.insert res (Just$mkStr (fieldOf bs b i)))+ctx (FParseCol _ i) res                                 = pure (ni res, \ ~(b, bs, _) -> mE$IM.insert res (Just$!parseAsF (fieldOf bs b i)))+ctx (IParseCol _ i) res                                 = pure (ni res, \ ~(b, bs, _) -> mE$IM.insert res (Just$!parseAsEInt (fieldOf bs b i)))+ctx (ParseCol (_:$TyB TyFloat) i) res                   = pure (ni res, \ ~(b, bs, _) -> mE$IM.insert res (Just$!parseAsF (fieldOf bs b i)))+ctx (ParseCol (_:$TyB TyI) i) res                       = pure (ni res, \ ~(b, bs, _) -> mE$IM.insert res (Just$!parseAsEInt (fieldOf bs b i)))+ctx (EApp _ (EApp _ (BB _ Map) f) xs) o                 = do {t <- nI; (env, sb) <- ctx xs t; pure (na o env, \l->wM f t o.sb l)}+ctx (EApp _ (EApp _ (BB _ MapMaybe) f) xs) o            = do {t <- nI; (env, sb) <- ctx xs t; pure (na o env, \l->wMM f t o.sb l)}+ctx (EApp _ (UB _ CatMaybes) xs) o                      = do {t <- nI; (env, sb) <- ctx xs t; pure (na o env, \l->wCM t o.sb l)}+ctx (EApp _ (EApp _ (BB _ Filter) p) xs) o              = do {t <- nI; (env, sb) <- ctx xs t; pure (na o env, \l->wP p t o.sb l)}+ctx (Guarded _ p e) o                                   = pure (ni o, wG (p, e) o)+ctx (Implicit _ e) o                                    = pure (ni o, wI e o)+ctx (EApp _ (EApp _ (EApp _ (TB _ Scan) op) seed) xs) o = do {t <- nI; (env, sb) <- ctx xs t; seed' <- seed@>mempty; pure (IM.insert o (Just$!seed') env, \l->wF op t o.sb l)}+ctx (EApp _ (EApp _ (EApp _ (TB _ ZipW) op) xs) ys) o   = do {t0 <- nI; t1 <- nI; (env0, sb0) <- ctx xs t0; (env1, sb1) <- ctx ys t1; pure (na o (env0<>env1), \l->wZ op t0 t1 o.sb0 l.sb1 l)}+ctx (EApp _ (EApp _ (BB _ Prior) op) xs) o              = do {t <- nI; (env, sb) <- ctx xs t; pt <- nI; pure (na o (IM.insert pt Nothing env), \l -> wΠ op pt t o.sb l)}+ctx (EApp (_:$TyB ty) (UB _ Dedup) xs) o                = do {k <- nI; t <- nI; (env, sb) <- ctx xs t; pure (na o env, \l->wD ty k t o.sb l)}+ctx (EApp _ (EApp _ (BB _ DedupOn) f) xs) o             = do {k <- nI; t <- nI; (env, sb) <- ctx xs t; pure (na o env, \l->wDOp f k t o.sb l)}++type LineCtx = (BS.ByteString, V.Vector BS.ByteString, Integer) -- line number++asS :: E T -> BS.ByteString+asS (Lit _ (StrLit s)) = s; asS e = throw (InternalCoercionError e TyStr)++asI :: E T -> Integer+asI (Lit _ (ILit i)) = i; asI e = throw (InternalCoercionError e TyI)++asF :: E T -> Double+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)++asM :: E T -> Maybe (E T)+asM (OptionVal _ e) = e; asM e = throw (InternalCoercionError e TyOption)++asB :: E T -> Bool+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)++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++the :: BS.ByteString -> Word8+the bs = case BS.uncons bs of+    Nothing                -> error "Empty splitc char!"+    Just (c,b) | BS.null b -> c+    Just _                 -> error "Splitc takes only one char!"++asTup :: Maybe RureMatch -> E T+asTup Nothing                = OptionVal undefined Nothing+asTup (Just (RureMatch s e)) = OptionVal undefined (Just (Tup undefined (mkI . fromIntegral <$> [s, e])))++{-# SCC (!>) #-}+(!>) :: Β -> Nm T -> E T+(!>) m n = IM.findWithDefault (throw$InternalNm n) (unU$unique n) m++a2e :: Β -> E T -> E T -> E T -> UM (E T)+a2e b op e0 e1 = (@>b) =<< a2 op e0 e1++a1e :: Β -> E T -> E T -> UM (E T)+a1e b f x = (@>b) =<< a1 f x++eB :: Int ->E T -> E T+eB j = flip evalState j.((@>mempty) <=< lβ)++a1 :: E T -> E T -> UM (E T)+a1 f x | TyArr _ cod <- eLoc f = lβ (EApp cod f x)++a2 :: E T -> E T -> E T -> UM (E T)+a2 op x0 x1 | TyArr _ t@(TyArr _ t') <- eLoc op = lβ (EApp t' (EApp t op x0) x1)++num :: Num a => BBin -> Maybe (a -> a -> a)+num Plus = Just (+); num Minus = Just (-); num Times = Just (*); num _ = Nothing++binRel :: Ord a => BBin -> Maybe (a -> a -> Bool)+binRel Lt = Just (<); binRel Gt = Just (>); binRel Eq = Just (==)+binRel Neq = Just (/=); binRel Geq = Just (>=); binRel Leq = Just (<=)+binRel _   = Nothing++($@) :: E T -> Int -> (E T, Int)+e $@ j = e@!(j,mempty)++(@!) :: E T -> (Int, Β) -> (E T, Int)+(@!) e (j,ϵ) = runState (e@>ϵ) j++{-# SCC (@>) #-}+(@>) :: E T -> Β -> UM (E T)+e@Lit{} @> _     = pure e+e@RC{} @> _      = pure e+(F n) @> b       = pure $ b!>n+e@(Var _ n) @> b = pure $ case IM.lookup (unU$unique n) b of {Just y -> y; Nothing -> e}+(EApp _ (EApp _ (BB (TyArr (TyB TyI) _) Max) x0) x1) @> b = do+    x0' <- asI<$>(x0@>b); x1' <- asI<$>(x1@>b)+    pure $ mkI (max x0' x1')+(EApp _ (EApp _ (BB (TyArr (TyB TyI) _) Min) x0) x1) @> b = do+    x0' <- asI <$> (x0@>b); x1' <- asI <$> (x1@>b)+    pure $ mkI (min x0' x1')+(EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) Max) x0) x1) @> b = do+    x0' <- asF<$>(x0@>b); x1' <- asF<$>(x1@>b)+    pure $ mkF (max x0' x1')+(EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) Min) x0) x1) @> b = do+    x0' <- asF<$>(x0@>b); x1' <- asF<$>(x1@>b)+    pure $ mkF (min x0' x1')+(EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) Max) x0) x1) @> b = do+    x0' <- asS<$>(x0@>b); x1' <- asS<$>(x1@>b)+    pure $ mkStr (max x0' x1')+(EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) Min) x0) x1) @> b = do+    x0' <- asS<$>(x0@>b); x1'<-asS<$>(x1@>b)+    pure $ mkStr (min x0' x1')+(EApp _ (EApp _ (BB (TyArr (TyB TyI) _) op) x0) x1) @> b | Just op' <- num op = do+    x0e <- asI<$>(x0@>b); x1e <- asI<$>(x1@>b)+    pure $ mkI (op' x0e x1e)+(EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) op) x0) x1) @> b | Just op' <- num op = do+    x0e <- asF<$>(x0@>b); x1e <- asF<$>(x1@>b)+    pure $ mkF (op' x0e x1e)+(EApp _ (EApp _ (BB _ Div) x0) x1) @> b = do+    x0e <- x0@>b; x1e <- x1@>b+    pure (mkF (asF x0e/asF x1e))+(EApp _ (EApp _ (BB (TyArr (TyB TyI) _) op) x0) x1) @> b | Just rel <- binRel op = do+    x0e<-asI<$>(x0@>b); x1e<-asI<$>(x1@>b)+    pure (mkB (rel x0e x1e))+(EApp _ (EApp _ (BB (TyArr (TyB TyFloat) _) op) x0) x1) @> b | Just rel <- binRel op = do+    x0e <- asF<$>(x0@>b); x1e <- asF<$>(x1@>b)+    pure (mkB (rel x0e x1e))+(EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) op) x0) x1) @> b | Just rel <- binRel op = do+    x0e <- asS<$>(x0@>b); x1e <- asS<$>(x1@>b)+    pure (mkB (rel x0e x1e))+(EApp _ (EApp _ (BB (TyArr (TyB TyStr) _) Plus) x0) x1) @> b = do+    x0e <- x0@>b; x1e <- x1@>b+    pure (mkStr (asS x0e<>asS x1e))+(EApp _ (EApp _ (BB _ And) x0) x1) @> b = do+    x0e <- x0@>b; x1e <- x1@>b+    pure (mkB (asB x0e&&asB x1e))+(EApp _ (EApp _ (BB _ Or) x0) x1) @> b = do+    x0e <- x0@>b; x1e <- x1@>b+    pure (mkB (asB x0e||asB x1e))+(EApp _ (EApp _ (UB _ Const) x) _) @> b = x@>b+(EApp _ (EApp _ (BB _ Match) s) r) @> b = do+    s' <- s@>b; r' <- r@>b+    pure (asTup (find' (asR r') (asS s')))+(EApp _ (EApp _ (BB _ Matches) s) r) @> b = do+    se <- s@>b; re <- r@>b+    pure (mkB (isMatch' (asR re) (asS se)))+(EApp _ (EApp _ (BB _ NotMatches) s) r) @> b = do+    se <- s@>b; re <- r@>b+    pure (mkB (not$isMatch' (asR re) (asS se)))+(Tup ty es) @> b = Tup ty.foldSeq <$> traverse (@>b) es+(EApp _ (UB _ Tally) e) @> b = do+    e' <- e@>b+    let r=fromIntegral (BS.length$asS e')+    pure (mkI r)+(EApp _ (UB _ TallyList) e) @> b = do+    e' <- e@>b+    let r=fromIntegral (V.length$asV e')+    pure (mkI r)+(EApp _ (EApp _ (BB _ Sprintf) fs) s) @> b = do+    fs' <- fs@>b; s' <- s@>b+    pure (mkStr (sprintf (asS fs') s'))+(Cond _ p e e') @> b = do {p' <- p@>b; if asB p' then e@>b else e'@>b}+(EApp ty (EApp _ (EApp _ (TB _ Captures) s) i) r) @> b = do+    s' <- s@>b; i' <- i@>b; r' <- r@>b+    pure $ OptionVal ty (mkStr <$> findCapture (asR r') (asS s') (fromIntegral$asI i'))+(EApp ty (EApp _ (EApp _ (TB _ AllCaptures) s) i) r) @> b = do+    s' <- s@>b; i' <- i@>b; r' <- r@>b+    pure $ Arr ty (V.fromList (mkStr <$> captures' (asR r') (asS s') (fromIntegral$asI i')))+(NB (TyB TyStr) MZ) @> _ = pure $ mkStr BS.empty+(NB ty@(TyB TyVec:$_) MZ) @> _ = pure $ Arr ty V.empty+(EApp _ (UB _ Not) e) @> b = do {e' <- e@> b; pure$mkB (not (asB e'))}+(EApp _ (EApp _ (BB _ Split) s) r) @> b = do+    s' <- s@>b; r' <- r@>b+    pure $ vS (splitBy (asR r') (asS s'))+(EApp _ (EApp _ (BB _ Splitc) s) c) @> b = do+    s' <- s@>b; c' <- c@>b+    pure $ vS (V.fromList (BS.split (the$asS c') (asS s')))+(EApp _ (UB _ FParse) x) @> b = do {x' <- x@>b; pure (parseAsF (asS x'))}+(EApp _ (UB _ IParse) x) @> b = do {x' <- x@>b; pure (parseAsEInt (asS x'))}+(EApp (TyB TyI) (UB _ Parse) x) @> b = do {x' <- x@>b; pure (parseAsEInt (asS x'))}+(EApp (TyB TyFloat) (UB _ Parse) x) @> b = do {x' <- x@>b; pure (parseAsF (asS x'))}+(EApp _ (UB _ (At i)) v) @> b = do {v' <- v@>b; pure (asV v' `at` (i-1))}+(EApp _ (UB _ (Select i)) x) @> b = do {x' <- x@>b; pure (asT x' !! (i-1))}+(EApp _ (UB _ Floor) x) @> b = mkI.floor.asF<$>(x@>b)+(EApp _ (UB _ Ceiling) x) @> b = mkI.ceiling.asF<$>(x@>b)+(EApp (TyB TyI) (UB _ Negate) i) @> b = mkI.negate.asI<$>(i@>b)+(EApp (TyB TyFloat) (UB _ Negate) x) @> b = mkF.negate.asF<$>(x@>b)+(EApp ty (UB _ Some) e) @> b = OptionVal ty.Just<$>(e@>b)+(NB ty None) @> _ = pure $ OptionVal ty Nothing+(EApp _ (EApp _ (EApp _ (TB _ Substr) s) i0) i1) @> b = do+    i0' <- i0@>b; i1' <- i1@>b; s' <- s@>b+    pure $ mkStr (substr (asS s') (fromIntegral$asI i0') (fromIntegral$asI i1'))+(EApp _ (EApp _ (EApp _ (TB _ Sub1) r) s0) s1) @> b = do+    r' <- r@>b; s0' <- s0@>b; s1' <- s1@>b+    pure $ mkStr (sub1 (asR r') (asS s1') (asS s0'))+(EApp _ (EApp _ (EApp _ (TB _ Subs) r) s0) s1) @> b = do+    r' <- r@>b; s0' <- s0@>b; s1' <- s1@>b+    pure $ mkStr (subs (asR r') (asS s1') (asS s0'))+(EApp _ (EApp _ (EApp _ (TB _ Fold) op) seed) xs) @> b | TyB TyVec:$_ <- eLoc xs = do+    seed' <- seed@>b; xs' <- xs@>b+    V.foldM (a2e b op) seed' (asV xs')+(EApp _ (EApp _ (BB _ Fold1) op) xs) @> b | TyB TyVec:$_ <- eLoc xs = do+    xs' <- xs@>b+    let xsV=asV xs'+        (seed, xs'') = case V.uncons xsV of+            Just v  -> v+            Nothing -> throw EmptyFold+    V.foldM (a2e b op) seed xs''+(EApp yT@(TyB TyVec:$_) (EApp _ (BB _ Filter) p) xs) @> b = do+    xs' <- xs@>b+    Arr yT <$> V.filterM (fmap asB.a1e b p) (asV xs')+(EApp yT@(TyB TyVec:$_) (EApp _ (BB _ Map) f) xs) @> b = do+    xs' <- xs@>b+    Arr yT <$> traverse (a1e b f) (asV xs')+(EApp yT@(TyB TyOption:$_) (EApp _ (BB _ Map) f) x) @> b = do+    x' <- x@>b+    OptionVal yT <$> traverse (a1e b f) (asM x')+(EApp yT@(TyB TyVec:$_) (EApp _ (BB _ MapMaybe) g) x) @> b = do+    x' <- x@>b+    Arr yT <$> V.mapMaybeM (fmap asM.a1e b g) (asV x')+(EApp yT@(TyB TyVec:$_) (UB _ CatMaybes) x) @> b = do+    x' <- x@>b+    pure $ Arr yT (V.catMaybes (asM<$>asV x'))+(EApp t (EApp _ (EApp _ (TB _ Option) x) g) y) @> b = do+    x' <- x@>b; y' <- y@>b+    case asM y' of+        Nothing -> pure x'+        Just yϵ -> (@>b) =<< lβ (EApp t g yϵ)+(Arr t es) @> b = Arr t <$> traverse (@>b) es+e@BB{} @> _ = pure e+e@TB{} @> _ = pure e+e@UB{} @> _ = pure e+(Lam t n e) @> b = Lam t n <$> (e@>b)+-- basically an option can evaluate to a function... so ((option ...) x)+-- needs to be reduced! but nothing will detect that...+-- (when can a builtin etc. return a FUNCTION? if...then...else could!)+--+-- Question: would (f x) ever need for x to be inspected in order for things+-- to proceed?? I think no...+--+-- thabove returns g'=(and another +) e=line (should be further reduced!)+-- but g'=(+) and e=... will trip up++me :: [(Nm T, E T)] -> Β+me xs = IM.fromList [(unU$unique nm, e) | (nm, e) <- xs]++ms :: Nm T -> E T -> Β+ms (Nm _ (U i) _) = IM.singleton i++wCM :: Tmp -> Tmp -> Σ -> Σ+wCM src tgt (Σ u env d di df) =+    let xϵ=env!src+    in Σ u (case xϵ of+        Just y  -> case asM y of {Nothing -> IM.insert tgt Nothing env; Just yϵ -> IM.insert tgt (Just$!yϵ) env}+        Nothing -> IM.insert tgt Nothing env) d di df++wMM :: E T -> Tmp -> Tmp -> Σ -> Σ+wMM (Lam _ n e) src tgt (Σ j env d di df) =+    let xϵ=env!src+    in case xϵ of+        Just x ->+            let be=ms n x; (y,k)=e@!(j,be)+            in Σ k (case asM y of+                Just yϵ -> IM.insert tgt (Just$!yϵ) env+                Nothing -> IM.insert tgt Nothing env) d di df+        Nothing -> Σ j (IM.insert tgt Nothing env) d di df+wMM e _ _ _ = throw$InternalArityOrEta 1 e++wZ :: E T -> Tmp -> Tmp -> Tmp -> Σ -> Σ+wZ (Lam _ n0 (Lam _ n1 e)) src0 src1 tgt (Σ j env d di df) =+    let x0ϵ=env!src0; x1ϵ=env!src1+    in (case (x0ϵ, x1ϵ) of+        (Just x, Just y) ->+            let be=me [(n0, x), (n1, y)]; (z,k)=e@!(j,be)+            in Σ k (IM.insert tgt (Just$!z) env)+        (Nothing, Nothing) -> Σ j (IM.insert tgt Nothing env)) d di df+wZ e _ _ _ _ = throw$InternalArityOrEta 2 e++wM :: E T -> Tmp -> Tmp -> Σ -> Σ+wM (Lam _ n e) src tgt (Σ j env d di df) =+    let xϵ=env!src+    in case xϵ of+        Just x ->+            let be=ms n x; (y,k)=e@!(j,be)+            in Σ k (IM.insert tgt (Just$!y) env) d di df+        Nothing -> Σ j (IM.insert tgt Nothing env) d di df+wM e _ _ _ = throw$InternalArityOrEta 1 e++wI :: E T -> Tmp -> LineCtx -> Σ -> Σ+wI e tgt line (Σ j env d di df) =+    let e'=e `κ` line; (e'',k)=e'$@j in Σ k (IM.insert tgt (Just$!e'') env) d di df++wG :: (E T, E T) -> Tmp -> LineCtx -> Σ -> Σ+wG (p, e) tgt line (Σ j env d di df) =+    let p'=p `κ` line; (p'',k)=p'$@j+    in if asB p''+        then let e'=e `κ` line; (e'',u) =e'$@k in Σ u (IM.insert tgt (Just$!e'') env) d di df+        else Σ k (IM.insert tgt Nothing env) d di df++wDOp :: E T -> Int -> Tmp -> Tmp -> Σ -> Σ+wDOp (Lam (TyArr _ (TyB TyStr)) n e) key src tgt (Σ i env d di df) =+    let x=env!src+    in case x of+        Nothing -> Σ i (IM.insert tgt Nothing env) d di df+        Just xϵ ->+            case IM.lookup key d of+                Nothing -> Σ k (IM.insert tgt (Just$!y) env) (IM.insert key (S.singleton e') d) di df+                Just ss -> (if e' `S.member` ss then Σ k (IM.insert tgt Nothing env) d else Σ k (IM.insert tgt (Just$!y) env) (IM.alter go key d)) di df+              where+                (y,k)=e@!(i,be); be=ms n xϵ+                e'=asS y++                go Nothing  = Just$!S.singleton e'+                go (Just s) = Just$!S.insert e' s+wDOp (Lam (TyArr _ (TyB TyI)) n e) key src tgt (Σ i env d di df) =+    let x=env!src+    in case x of+        Nothing -> Σ i (IM.insert tgt Nothing env) d di df+        Just xϵ ->+            case IM.lookup key di of+                Nothing -> Σ k (IM.insert tgt (Just$!y) env) d (IM.insert key (IS.singleton e') di) df+                Just ds -> (if e' `IS.member` ds then Σ k (IM.insert tgt Nothing env) d di else Σ k (IM.insert tgt (Just$!y) env) d (IM.alter go key di)) df++              where+                (y,k)=e@!(i,be); be=ms n xϵ+                e'=fromIntegral$asI y++                go Nothing  = Just$!IS.singleton e'+                go (Just s) = Just$!IS.insert e' s+wDOp (Lam (TyArr _ (TyB TyFloat)) n e) key src tgt (Σ i env d di df) =+    let x=env!src+    in case x of+        Nothing -> Σ i (IM.insert tgt Nothing env) d di df+        Just xϵ ->+            case IM.lookup key df of+                Nothing -> Σ k (IM.insert tgt (Just$!y) env) d di (IM.insert key (S.singleton e') df)+                Just ds -> if e' `S.member` ds then Σ k (IM.insert tgt Nothing env) d di df else Σ k (IM.insert tgt (Just$!y) env) d di (IM.alter go key df)+              where+                (y,k)=e@!(i,be); be=ms n xϵ+                e'=asF y++                go Nothing = Just$!S.singleton e'+                go (Just s) = Just$!S.insert e' s+wDOp e _ _ _ _ = throw $ InternalArityOrEta 1 e++wD :: TB -> Int -> Tmp -> Tmp -> Σ -> Σ+wD TyStr key src tgt (Σ i env d di df) =+    let x=env!src+    in case x of+        Nothing -> Σ i (IM.insert tgt Nothing env) d di df+        Just e ->+            case IM.lookup key d of+                Nothing -> Σ i (IM.insert tgt (Just$!e) env) (IM.insert key (S.singleton e') d) di df+                Just ds -> (if e' `S.member` ds then Σ i (IM.insert tgt Nothing env) d else Σ i (IM.insert tgt (Just$!e) env) (IM.alter go key d)) di df+              where+                go Nothing  = Just$!S.singleton e'+                go (Just s) = Just$!S.insert e' s++                e'=asS e+wD TyI key src tgt (Σ i env d di df) =+    let x=env!src+    in case x of+        Nothing -> Σ i (IM.insert tgt Nothing env) d di df+        Just e ->+            case IM.lookup key di of+                Nothing -> Σ i (IM.insert tgt (Just$!e) env) d (IM.insert key (IS.singleton e') di) df+                Just ds -> (if e' `IS.member` ds then Σ i (IM.insert tgt Nothing env) d di else Σ i (IM.insert tgt (Just$!e) env) d (IM.alter go key di)) df+              where+                e'=fromIntegral$asI e++                go Nothing  = Just$!IS.singleton e'+                go (Just s) = Just$!IS.insert e' s+wD TyFloat key src tgt (Σ i env d di df) =+    let x=env!src+    in case x of+        Nothing -> Σ i (IM.insert tgt Nothing env) d di df+        Just e ->+            case IM.lookup key df of+                Nothing -> Σ i (IM.insert tgt (Just$!e) env) d di (IM.insert key (S.singleton e') df)+                Just ds -> if e' `S.member` ds then Σ i (IM.insert tgt Nothing env) d di df else Σ i (IM.insert tgt (Just$!e) env) d di (IM.alter go key df)+              where+                e'=asF e++                go Nothing = Just$!S.singleton e'+                go (Just s) = Just$!S.insert e' s+++wP :: E T -> Tmp -> Tmp -> Σ -> Σ+wP (Lam _ n e) src tgt (Σ j env d di df) =+    let xϵ=env!src+    in case xϵ of+        Just x ->+            let be=ms n x; (p,k)=e@!(j,be)+            in Σ k (IM.insert tgt (if asB p then Just$!x else Nothing) env) d di df+        Nothing -> Σ j (IM.insert tgt Nothing env) d di df+wP e _ _ _ = throw $ InternalArityOrEta 1 e++wΠ :: E T -> Tmp -> Tmp -> Tmp -> Σ -> Σ+wΠ (Lam _ nn (Lam _ nprev e)) pt src tgt (Σ j env d di df) =+    let prevϵ=env!pt; xϵ=env!src+    in (case (prevϵ, xϵ) of+        (Just prev, Just x) ->+            let be=me [(nprev, prev), (nn, x)]+                (res,u)=e@!(j,be)+            in Σ u (IM.insert pt (Just$!x) (IM.insert tgt (Just$!res) env))+        (Nothing, Nothing) -> Σ j (IM.insert tgt Nothing env)+        (Nothing, Just x) -> Σ j (IM.insert pt (Just$!x) (IM.insert tgt Nothing env))+        (Just{}, Nothing) -> Σ j (IM.insert tgt Nothing env)) d di df+wΠ e _ _ _ _ = throw $ InternalArityOrEta 2 e++wF :: E T -> Tmp -> Tmp -> Σ -> Σ+wF (Lam _ nacc (Lam _ nn e)) src tgt (Σ j env d di df) =+    let accϵ = env!tgt; xϵ = env!src+    in (case (accϵ, xϵ) of+        (Just acc, Just x) ->+            let be=me [(nacc, acc), (nn, x)]+                (res, u)=e@!(j, be)+            in Σ u (IM.insert tgt (Just$!res) env)+        (Just acc, Nothing) -> Σ j (IM.insert tgt (Just$!acc) env)+        (Nothing, Nothing) -> Σ j (IM.insert tgt Nothing env)+        (Nothing, Just x) -> Σ j (IM.insert tgt (Just$!x) env)) d di df+wF e _ _ _ = throw $ InternalArityOrEta 2 e
src/Jacinda/Fuse.hs view
@@ -10,9 +10,6 @@ fuse :: Int -> E T -> (E T, Int) fuse i = flip runState i.fM --- fold1: needs a special "form" for fold1-of-map (pick seed through map)--- 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) | TyB TyStream :$ _ <- eLoc stream = do     stream' <- fM stream
src/Jacinda/Regex.hs view
@@ -6,6 +6,7 @@                      , defaultRurePtr                      , isMatch'                      , find'+                     , sub1, subs                      , compileDefault                      , substr                      , findCapture@@ -14,6 +15,7 @@  import           Control.Exception        (Exception, throwIO) import           Control.Monad            ((<=<))+import qualified Data.ByteString          as BS import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Lazy     as BSL import qualified Data.Vector              as V@@ -52,6 +54,19 @@                 s' = fromIntegral s                 in BS.BS (fp `plusForeignPtr` s') (e'-s') +{-# NOINLINE subs #-}+subs :: RurePtr -> BS.ByteString -> BS.ByteString -> BS.ByteString+subs re haystack = let ms = unsafeDupablePerformIO $ matches' re haystack in go Nothing ms+    where go _ [] _                                         = haystack+          go (Just (RureMatch _ pe)) ((RureMatch ms _):_) _ | pe > ms = error "Overlapping matches."+          go _ (m@(RureMatch ms me):s) substituend          = let next=go (Just m) s substituend in BS.take (fromIntegral ms) next <> substituend <> BS.drop (fromIntegral me) next++sub1 :: RurePtr -> BS.ByteString -> BS.ByteString -> BS.ByteString+sub1 re bs ss =+    case find' re bs of+        Nothing              -> bs+        Just (RureMatch s e) -> BS.take (fromIntegral s) bs <> ss <> BS.drop (fromIntegral e) bs+ {-# NOINLINE find' #-} find' :: RurePtr -> BS.ByteString -> Maybe RureMatch find' re str = unsafeDupablePerformIO $ find re str 0@@ -77,8 +92,8 @@  {-# NOINLINE splitBy #-} splitByA :: RurePtr-        -> BS.ByteString-        -> [BS.ByteString]+         -> BS.ByteString+         -> [BS.ByteString] splitByA _ "" = mempty splitByA re haystack@(BS.BS fp l) =     [BS.BS (fp `plusForeignPtr` s) (e-s) | (s, e) <- slicePairs]@@ -97,7 +112,9 @@ compileDefault :: BS.ByteString -> RurePtr compileDefault = unsafeDupablePerformIO . (yIO <=< compile genFlags) -newtype RureExe = RegexCompile String deriving (Show)+newtype RureExe = RegexCompile String++instance Show RureExe where show (RegexCompile str) = str  instance Exception RureExe where
src/L.x view
@@ -86,6 +86,7 @@         \"                       { mkSym Quot }         "^"                      { mkSym Caret }         "|>"                     { mkSym Fold1Tok }+        ⍬                        { mkSym Zilde }          "="                      { mkSym EqTok }         "!="                     { mkSym NeqTok }@@ -98,12 +99,14 @@         "("                      { mkSym LParen }         ")"                      { mkSym RParen }         "&("                     { mkSym LAnchor }+        "$>"                     { mkSym IceCreamCone }         "{%"                     { mkSym LBracePercent }         "{|"                     { mkSym LBraceBar }         "]"                      { mkSym RSqBracket `andBegin` 0 }         "~"                      { mkSym Tilde }         "!~"                     { mkSym NotMatchTok }         ","                      { mkSym Comma }+        ",,"                     { mkSym DoubleComma }         "."                      { mkSym Dot }         "#"                      { mkSym TallyTok }         "#*"                     { mkSym LengthTok }@@ -128,6 +131,7 @@         "-."                     { mkSym NegTok }         "`*"                     { mkSym LastFieldTok }         "`$"                     { mkSym FieldListTok }+        \?                       { mkSym QuestionMark }          in                       { mkKw KwIn }         let                      { mkKw KwLet }@@ -140,6 +144,8 @@         if                       { mkKw KwIf }         then                     { mkKw KwThen }         else                     { mkKw KwElse }+        asv                      { mkKw KwAsv }+        usv                      { mkKw KwUsv }          fs                       { mkRes VarFs }         rs                       { mkRes VarRs }@@ -168,6 +174,8 @@         fold                     { mkBuiltin BuiltinFold }         fold1                    { mkBuiltin BuiltinFold1 }         scan                     { mkBuiltin BuiltinScan }+        "sub1"                   { mkBuiltin BuiltinSub1 }+        subs                     { mkBuiltin BuiltinSubs }          ":i"                     { mkBuiltin BuiltinIParse }         ":f"                     { mkBuiltin BuiltinFParse }@@ -248,31 +256,26 @@          | PercentTok          | ExpTok          | FoldTok+         | IceCreamCone          | Fold1Tok          | Quot          | TimesTok          | DefEq          | Colon-         | LBrace-         | RBrace+         | LBrace | RBrace          | LParen          | LAnchor          | RParen-         | LSqBracket-         | RSqBracket+         | LSqBracket | RSqBracket          | Semicolon          | Underscore-         | EqTok-         | LeqTok-         | LtTok-         | NeqTok-         | GeqTok-         | GtTok-         | AndTok-         | OrTok-         | Tilde-         | NotMatchTok+         | EqTok | NeqTok+         | GtTok | GeqTok+         | LtTok | LeqTok+         | AndTok | OrTok+         | Tilde | NotMatchTok          | Comma+         | DoubleComma          | Dot          | TallyTok          | LengthTok@@ -281,8 +284,10 @@          | LBraceBar          | Exclamation          | Caret+         | Zilde          | Backslash          | BackslashDot+         | QuestionMark          | FilterTok          | FloorSym          | CeilSym@@ -325,8 +330,10 @@     pretty Tilde         = "~"     pretty NotMatchTok   = "!~"     pretty Comma         = ","+    pretty DoubleComma   = ",,"     pretty Dot           = "."     pretty TallyTok      = "#"+    pretty Zilde         = "⍬"     pretty LengthTok     = "#*"     pretty Quot          = "¨"     pretty Caret         = "^"@@ -347,6 +354,8 @@     pretty NegTok        = "-."     pretty LastFieldTok  = "`*"     pretty FieldListTok  = "`$"+    pretty IceCreamCone  = "$>"+    pretty QuestionMark  = "?"  data Keyword = KwLet              | KwIn@@ -356,15 +365,14 @@              | KwFlush              | KwFn              | KwInclude-             | KwIf-             | KwThen-             | KwElse+             | KwIf | KwThen | KwElse+             | KwAsv | KwUsv  -- | Reserved/special variables data Var = VarX          | VarY-         | VarFs-         | VarRs+         | VarFs | VarRs+         | VarOfs | VarOrs          | VarIx          | VarMin          | VarMax@@ -375,6 +383,8 @@     pretty VarY     = "y"     pretty VarFs    = "fs"     pretty VarRs    = "rs"+    pretty VarOrs   = "ors"+    pretty VarOfs   = "ofs"     pretty VarIx    = "⍳"     pretty VarNf    = "nf"     pretty VarMin   = "min"@@ -392,27 +402,25 @@     pretty KwIf      = "if"     pretty KwThen    = "then"     pretty KwElse    = "else"+    pretty KwUsv     = "usv"+    pretty KwAsv     = "asv" -data Builtin = BuiltinIParse-             | BuiltinFParse+data Builtin = BuiltinIParse | BuiltinFParse              | BuiltinSubstr-             | BuiltinSplit-             | BuiltinSplitc+             | BuiltinSplit | BuiltinSplitc              | BuiltinOption              | BuiltinSprintf-             | BuiltinFloor-             | BuiltinCeil+             | BuiltinFloor | BuiltinCeil              | BuiltinMatch              | BuiltinCaptures-             | BuiltinSome-             | BuiltinNone+             | BuiltinSome | BuiltinNone              | BuiltinFp              | BuiltinMapMaybe              | BuiltinDedupOn              | BuiltinFilt-             | BuiltinFold-             | BuiltinFold1+             | BuiltinFold | BuiltinFold1              | BuiltinScan+             | BuiltinSub1 | BuiltinSubs  instance Pretty Builtin where     pretty BuiltinIParse   = ":i"@@ -435,6 +443,8 @@     pretty BuiltinFold     = "fold"     pretty BuiltinFold1    = "fold1"     pretty BuiltinScan     = "scan"+    pretty BuiltinSub1     = "sub1"+    pretty BuiltinSubs     = "subs"  data Token a = EOF { loc :: a }              | TokSym { loc :: a, _sym :: Sym }@@ -475,13 +485,20 @@ freshName :: T.Text -> Alex (Nm AlexPosn) freshName t = do     pos <- get_pos-    newIdentAlex pos t+    (i, ns, us) <- alexGetUserState+    let (j, n) = freshIdent pos t i+    alexSetUserState (j, ns, us) $> (n$>pos)  newIdentAlex :: AlexPosn -> T.Text -> Alex (Nm AlexPosn) newIdentAlex pos t = do     st <- alexGetUserState     let (st', n) = newIdent pos t st     alexSetUserState st' $> (n $> pos)++freshIdent :: AlexPosn -> T.Text -> Int -> (Int, Nm AlexPosn)+freshIdent pos t max' =+    let i=max'+1; nm=Nm t (U i) pos+        in (i, nm)  newIdent :: AlexPosn -> T.Text -> AlexUserState -> (AlexUserState, Nm AlexPosn) newIdent pos t pre@(max', names, uniqs) =
src/Parser.y view
@@ -47,6 +47,7 @@     rparen { TokSym $$ RParen }     semicolon { TokSym $$ Semicolon }     backslash { TokSym $$ Backslash }+    questionMark { TokSym $$ QuestionMark }     tilde { TokSym $$ Tilde }     notMatch { TokSym $$ NotMatchTok }     dot { TokSym $$ Dot }@@ -72,9 +73,11 @@     exp { TokSym $$ ExpTok }      comma { TokSym $$ Comma }+    doubleComma { TokSym $$ DoubleComma }     fold { TokSym $$ FoldTok }     fold1 { TokSym $$ Fold1Tok }     caret { TokSym $$ Caret }+    z { TokSym $$ Zilde }     quot { TokSym $$ Quot }     mapMaybe { TokSym $$ MapMaybeTok }     catMaybes { TokSym $$ CatMaybesTok }@@ -116,6 +119,8 @@     if { TokKeyword $$ KwIf }     then { TokKeyword $$ KwThen }     else { TokKeyword $$ KwElse }+    usv { TokKeyword $$ KwUsv }+    asv { TokKeyword $$ KwAsv }      x { TokResVar $$ VarX }     y { TokResVar $$ VarY }@@ -126,10 +131,14 @@     nf { TokResVar $$ VarNf }     fs { TokResVar $$ VarFs }     rs { TokResVar $$ VarRs }+    ofs { TokResVar $$ VarOfs }+    ors { TokResVar $$ VarOrs }      split { TokBuiltin $$ BuiltinSplit }     splitc { TokBuiltin $$ BuiltinSplitc }     substr { TokBuiltin $$ BuiltinSubstr }+    sub1 { TokBuiltin $$ BuiltinSub1 }+    subs { TokBuiltin $$ BuiltinSubs }     sprintf { TokBuiltin $$ BuiltinSprintf }     floor { TokBuiltin $$ BuiltinFloor }     ceil { TokBuiltin $$ BuiltinCeil }@@ -209,6 +218,10 @@ D :: { D AlexPosn }   : set fs defEq rr semicolon { SetFS (rr $4) }   | set rs defEq rr semicolon { SetRS (rr $4) }+  | set ofs defEq strLit semicolon { SetOFS (strTok $4) }+  | set ors defEq strLit semicolon { SetORS (strTok $4) }+  | set asv semicolon { SetAsv }+  | set usv semicolon { SetUsv }   | flush semicolon { FlushDecl }   | fn name Args defEq E semicolon { FunDecl $2 $3 $5 }   | fn name defEq E semicolon { FunDecl $2 [] $4 }@@ -224,8 +237,8 @@  Program :: { Program AlexPosn }         : many(D) E { Program (reverse $1) $2 }-         + E :: { E AlexPosn }   : name { Var (Nm.loc $1) $1 }   | intLit { Lit (loc $1) (ILit (int $1)) }@@ -280,6 +293,7 @@   | lparen sepBy(E, dot) rparen { Tup $1 (reverse $2) }   | lanchor sepBy(E, dot) rparen { Anchor $1 (reverse $2) }   | E E { EApp (eLoc $1) $1 $2 }+  | E doubleComma E E { EApp (eLoc $1) (EApp (eLoc $1) (EApp $2 (TB $2 Bookend) $1) $3) $4 }   | tally { UB $1 Tally }   | tallyL { UB $1 TallyList }   | const { UB $1 Const }@@ -300,6 +314,8 @@   | match { BB $1 Match }   | splitc { BB $1 Splitc }   | substr { TB $1 Substr }+  | sub1 { TB $1 Sub1 }+  | subs { TB $1 Subs }   | sprintf { BB $1 Sprintf }   | option { TB $1 Option }   | captures { TB $1 AllCaptures }@@ -312,6 +328,7 @@   | catMaybes { UB $1 CatMaybes }   | neg { UB $1 Negate }   | ix { NB $1 Ix }+  | z { NB $1 MZ }   | nf { NB $1 Nf }   | none { NB $1 None }   | fp { NB $1 Fp }@@ -322,6 +339,7 @@   | backslash name dot E { Lam $1 $2 $4 }   | parens(E) { Paren (eLoc $1) $1 }   | if E then E else E { Cond $1 $2 $4 $6 }+  | questionMark E semicolon E semicolon E { Cond $1 $2 $4 $6 }  {
src/Parser/Rw.hs view
@@ -66,15 +66,24 @@     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 _ op) (EApp lϵ e1 e2)) | Nothing <- mFi op                        = EApp l (EApp lϵ e0 e1) e2+    a (EAppF l e0@(TB _ Sub1) (EApp lϵ (EApp lϵϵ e1 e2) e3))                            = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3+    a (EAppF l e0@(TB _ Sub1) (EApp lϵ e1 (EApp lϵϵ e2 e3)))                            = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3+    a (EAppF l e0@(TB _ Sub1) (EApp lϵ e1 e2))                                          = EApp l (EApp lϵ e0 e1) e2+    a (EAppF l e0@(TB _ Subs) (EApp lϵ (EApp lϵϵ e1 e2) e3))                            = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3+    a (EAppF l e0@(TB _ Subs) (EApp lϵ e1 (EApp lϵϵ e2 e3)))                            = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3+    a (EAppF l e0@(TB _ Subs) (EApp lϵ e1 e2))                                          = 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 _ Substr) (EApp lϵ e1 e2))                                        = EApp l (EApp lϵ e0 e1) e2     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 _ Captures) (EApp lϵ e1 e2))                                      = EApp l (EApp lϵ e0 e1) e2     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 e0@(TB _ AllCaptures) (EApp lϵ e1 e2))                                   = EApp l (EApp lϵ e0 e1) e2     a (EAppF l (RwB l0 b) (EApp lϵ e1 e2))                                              = EApp l (EApp lϵ (BB l0 b) e1) e2     a (EAppF l (RwT l0 t) (EApp lϵ (EApp lϵϵ e1 e2) e3))                                = EApp l (EApp lϵ (EApp lϵϵ (TB l0 t) e1) e2) e3     a (EAppF l (RwT l0 t) (EApp lϵ e1 (EApp lϵϵ e2 e3)))                                = EApp l (EApp lϵ (EApp lϵϵ (TB l0 t) e1) e2) e3
src/R.hs view
@@ -18,7 +18,7 @@ import           Nm import           U -data Renames = Renames { max_ :: Int, bound :: IM.IntMap Int }+data Renames = Rs { max_ :: Int, bound :: IM.IntMap Int }  class HasRenames a where     rename :: Lens' a Renames@@ -38,7 +38,7 @@ rP i = runRM i . renameProgram  runRM :: Int -> RenameM x -> (x, Int)-runRM i act = second max_ (runState act (Renames i IM.empty))+runRM i act = second max_ (runState act (Rs i IM.empty))  replaceUnique :: (MonadState s m, HasRenames s) => U -> m U replaceUnique u@(U i) = do@@ -80,7 +80,7 @@     pure res  setMax :: Int -> Renames -> Renames-setMax i (Renames _ b) = Renames i b+setMax i (Rs _ b) = Rs i b  -- | Desguar top-level functions as lambdas mkLam :: [Nm a] -> E a -> E a
src/Ty.hs view
@@ -193,38 +193,41 @@           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 (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+checkType TyVar{} _                      = pure ()+checkType (TyB TyStr) (IsSemigroup, _)   = pure ()+checkType (TyB TyI) (IsSemigroup, _)     = pure ()+checkType (TyB TyFloat) (IsSemigroup, _) = pure ()+checkType (TyB TyI) (IsNum, _)           = pure ()+checkType (TyB TyFloat) (IsNum, _)       = pure ()+checkType (TyB TyI) (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 TyI) (IsParse, _)         = pure ()+checkType (TyB TyFloat) (IsParse, _)     = pure ()+checkType (TyB TyFloat) (IsOrd, _)       = pure ()+checkType (TyB TyI) (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) (Witherable, _)    = pure ()+checkType (TyB TyVec) (Foldable, _)      = pure ()+checkType (TyB TyStream) (Foldable, _)   = pure ()+checkType (TyB TyStr) (IsMonoid, _)      = pure ()+checkType (TyB TyVec:$_) (IsMonoid, _)   = pure ()+checkType (TyB TyStr) (IsPrintf, _)      = pure ()+checkType (TyB TyFloat) (IsPrintf, _)    = pure ()+checkType (TyB TyI) (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@@ -247,10 +250,13 @@ tyOf = fmap eLoc . tyE  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 (SetFS bs)  = pure (SetFS bs, s)+tyDS s (SetRS bs)  = pure (SetRS bs, s)+tyDS s (SetOFS bs) = pure (SetOFS bs, s)+tyDS s (SetORS bs) = pure (SetORS bs, s)+tyDS s SetAsv      = pure (SetAsv, s)+tyDS s SetUsv      = pure (SetUsv, s)+tyDS s FlushDecl   = pure (FlushDecl, s) tyDS s (FunDecl n@(Nm _ (U i) _) [] e) = do     (e', s') <- tyES s e     let t=eLoc e'@@ -356,6 +362,7 @@ 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 l MZ)    = do {m <- freshN "m"; modify (mapCV (addC m (IsMonoid, l))); pure (NB (var m) MZ, 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)@@ -381,7 +388,9 @@ 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 (TB _ Substr) = pure (TB (tyStr ~> tyI ~> tyI ~> tyStr) Substr, s)+tyES s (TB _ Sub1) = pure (TB (tyR ~> tyStr ~> tyStr ~> tyStr) Sub1, s)+tyES s (TB _ Subs) = pure (TB (tyR ~> tyStr ~> tyStr ~> tyStr) Subs, 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)@@ -391,14 +400,14 @@ 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 (UB l Parse) = do {a <- freshN "a"; modify (mapCV (addC a (IsParse, l))); pure (UB (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 _ (At i)) = do {a <- var <$> freshN "a"; pure (UB (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 _ 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 (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 ((a' ~> tyB) ~> w ~> w) Filter, s)} tyES s (UB _ (Select i)) = do     ρ <- freshN "ρ"; a <- var <$> freshN "a"     pure (UB (Rho ρ (IM.singleton i a) ~> a) (Select i), s)@@ -419,27 +428,28 @@     f <- freshN "f"     let f'=var f     modify (mapCV (addC f (Foldable, l)))-    pure (TB ((b ~> (a ~> b)) ~> (b ~> (f':$a) ~> b)) Fold, s)+    pure (TB ((b ~> a ~> b) ~> (b ~> (f':$a) ~> b)) Fold, s) tyES s (BB l Fold1) = do     a <- var <$> freshN "a"     f <- freshN "f"     let f'=var f     modify (mapCV (addC f (Foldable, l)))-    pure (BB ((a ~> (a ~> a)) ~> ((f':$a) ~> a)) Fold1, s)-tyES s (TB _ Captures) = pure (TB (tyStr ~> (tyI ~> (tyR ~> tyOpt tyStr))) Captures, s)+    pure (BB ((a ~> a ~> a) ~> ((f':$a) ~> a)) Fold1, s)+tyES s (TB _ Bookend) = pure (TB (tyR ~> tyR ~> tyStream tyStr ~> tyStream tyStr) Bookend, s)+tyES s (TB _ Captures) = pure (TB (tyStr ~> tyI ~> tyR ~> tyOpt tyStr) Captures, s) tyES s (BB _ Prior) = do     a <- var <$> freshN "a"; b <- var <$> freshN "b"-    pure (BB (tyArr (a ~> (a ~> b)) (tyStream a ~> tyStream b)) Prior, s)+    pure (BB (tyArr (a ~> a ~> b) (tyStream a ~> tyStream b)) Prior, s) tyES s (TB _ ZipW) = do     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)+    pure (TB (tyArr (a ~> b ~> c) (tyStream a ~> tyStream b ~> tyStream c)) ZipW, s) tyES s (TB _ Scan) = do     a <- var <$> freshN "a"; b <- var <$> freshN "b"-    pure (TB (tyArr (b ~> (a ~> b)) (b ~> tyStream a ~> tyStream b)) Scan, s)+    pure (TB (tyArr (b ~> a ~> b) (b ~> tyStream a ~> tyStream b)) Scan, s) tyES s (TB _ Option) = do     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)+    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
src/Ty/Const.hs view
@@ -9,7 +9,7 @@ tyStream = (TyB TyStream :$)  tyB, tyI, tyF, tyStr, tyR :: T-tyB=TyB TyBool; tyI=TyB TyInteger; tyF=TyB TyFloat; tyStr=TyB TyStr; tyR=TyB TyR+tyB=TyB TyBool; tyI=TyB TyI; tyF=TyB TyFloat; tyStr=TyB TyStr; tyR=TyB TyR  tyOpt :: T -> T tyOpt = (TyB TyOption :$)
test/Spec.hs view
@@ -28,9 +28,12 @@             "drwxr-xr-x  12 vanessa  staff   384 Dec 26 19:43 _darcs"             ["drwxr-xr-x","12","vanessa","staff","384","Dec","26","19:43","_darcs"]         , splitWhitespaceT "      55 ./src/Jacinda/File.hs" ["55", "./src/Jacinda/File.hs"]+        , testCase "subs" $+            let actual = subs (compileDefault "zi") "vectorzm0zi13zi1zi0zmc80ea02f780be2984f831df2de071f6e6040c0f670b3dd2428e80f5d111d7f72_DataziVectorziGeneric_partition_closure" "."+            in actual @?= "vectorzm0.13.1.0zmc80ea02f780be2984f831df2de071f6e6040c0f670b3dd2428e80f5d111d7f72_Data.Vector.Generic_partition_closure"         , splitWhitespaceT "" []         , splitWhitespaceT "5" ["5"]-        , testCase "type of" (tyOfT sumBytes (TyB TyInteger))+        , testCase "type of" (tyOfT sumBytes (TyB TyI))         , 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))
+ test/examples/bookend.jac view
@@ -0,0 +1,1 @@+/Disassembly of section \.text:/,,/Disassembly of section/$0
test/examples/evenOdd.jac view
@@ -1,5 +1,3 @@-{. :set rs:=/\n+/;- fn count(x) ≔   (+)|0 [:1"x; @@ -13,7 +11,6 @@   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 total := odd + even in (total . even . odd . tens) end
+ test/examples/foldFilter.jac view
@@ -0,0 +1,4 @@+fn count(x) ≔+  (+)|0 [:1"x;++count ((~/(0|2|4|6|8)$/) #. $0)
− test/examples/sillyPragmas.jac 
@@ -1,2 +0,0 @@-{. run ja run test/examples/sillyPragmas.jac -i src/A.hs-[x+', '+y]|'' .?{|`0 ~* 1 /\{-#\s*LANGUAGE\s*([^\s]*)\s*#-\}/}
− test/examples/sillyPragmas2.jac 
@@ -1,1 +0,0 @@-[x+', '+y]|'' [x ~* 1 /\{-#\s*LANGUAGE\s*([^\s]*)\s*#-\}/]:?$0
− test/examples/ty.jac 
@@ -1,4 +0,0 @@-fn count(x) :=-  (+)|0 [:1"x;--1
+ x/Main.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import qualified Data.Text           as T+import qualified Data.Text.IO        as TIO+import qualified Data.Version        as V+import           File+import           Options.Applicative+import qualified Paths_jacinda       as P+import           System.IO           (stdin)++data Command = TypeCheck !FilePath ![FilePath]+             | Run !FilePath !(Maybe T.Text) !(Maybe T.Text) !(Maybe FilePath) ![FilePath]+             | Expr !T.Text !(Maybe FilePath) !(Maybe T.Text) !Bool !Bool !(Maybe T.Text) ![FilePath]+             | Eval !T.Text++jacFile :: Parser FilePath+jacFile = argument str+    (metavar "JACFILE"+    <> help "Source code"+    <> jacCompletions)++asv :: Parser Bool+asv = switch+    (long "asv"+    <> help "Process as ASV")++usv :: Parser Bool+usv = switch+    (long "usv"+    <> short 'u'+    <> help "Process as USV")++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'+    <> metavar "REGEXP"+    <> help "Field separator")++jacExpr :: Parser T.Text+jacExpr = argument str+    (metavar "EXPR"+    <> help "Jacinda expression")++inpFile :: Parser (Maybe FilePath)+inpFile = optional $ option str+    (short 'i'+    <> metavar "DATAFILE"+    <> help "Data file")++jacCompletions :: HasCompleter f => Mod f a+jacCompletions = completer . bashCompleter $ "file -X '!*.jac' -o plusdirs"++commandP :: Parser Command+commandP = hsubparser+    (command "tc" (info tcP (progDesc "Type-check file"))+    <> command "e" (info eP (progDesc "Evaluate an expression (no file context)"))+    <> command "run" (info runP (progDesc "Run from file")))+    <|> exprP+    where+        tcP = TypeCheck <$> jacFile <*> includes+        runP = Run <$> jacFile <*> jacFs <*> jacRs <*> inpFile <*> includes+        exprP = Expr <$> jacExpr <*> inpFile <*> jacFs <*> asv <*> usv <*> jacRs <*> includes+        eP = Eval <$> jacExpr++includes :: Parser [FilePath]+includes = many $ strOption+    (metavar "DIR"+    <> long "include"+    <> short 'I'+    <> dirCompletions)++dirCompletions :: HasCompleter f => Mod f a+dirCompletions = completer . bashCompleter $ "directory"+++wrapper :: ParserInfo Command+wrapper = info (helper <*> versionMod <*> commandP)+    (fullDesc+    <> progDesc "Jacinda language for functional stream processing, filtering, and reports"+    <> header "Jacinda - a functional complement to AWK")++versionMod :: Parser (a -> a)+versionMod = infoOption (V.showVersion P.version) (short 'V' <> long "version" <> help "Show version")++main :: IO ()+main = run =<< execParser wrapper++ap :: Bool -> Bool -> Maybe T.Text -> Maybe T.Text -> (Maybe T.Text, Maybe T.Text)+ap True True _ _          = errorWithoutStackTrace "--asv and --usv both specified."+ap _ True Just{} _        = errorWithoutStackTrace "--usv and field separator both speficied."+ap _ True _ Just{}        = errorWithoutStackTrace "--usv and record separator both speficied."+ap True _ Just{} _        = errorWithoutStackTrace "--asv and field separator both speficied."+ap True _ _ Just{}        = errorWithoutStackTrace "--asv and record separator both speficied."+ap True _ Nothing Nothing = (Just "\\x1f", Just "\\x1e")+ap _ True Nothing Nothing = (Just "␟", Just "␞")+ap _ _ fs rs              = (fs,rs)++run :: Command -> IO ()+run (TypeCheck fp is)                = tcIO is =<< TIO.readFile fp+run (Run fp fs rs Nothing is)        = do { contents <- TIO.readFile fp ; runOnHandle is contents fs rs stdin }+run (Run fp fs rs (Just dat) is)     = do { contents <- TIO.readFile fp ; runOnFile is contents fs rs dat }+run (Expr eb Nothing fs a u rs is)   = let (fs',rs') = ap a u fs rs in runOnHandle is eb fs' rs' stdin+run (Expr eb (Just fp) fs a u rs is) = let (fs',rs') = ap a u fs rs in runOnFile is eb fs' rs' fp+run (Eval e)                         = print (exprEval e)