jacinda 0.3.1.0 → 1.0.0.0
raw patch · 25 files changed
+367/−206 lines, 25 filesdep +silentlydep ~bytestring
Dependencies added: silently
Dependency ranges changed: bytestring
Files
- CHANGELOG.md +8/−0
- README.md +6/−51
- bench/Bench.hs +6/−1
- doc/guide.pdf binary
- examples/avg.jac +4/−0
- examples/cloc.jac +38/−0
- examples/diffctx.jac +23/−0
- examples/fields.jac +1/−0
- examples/hsExtensions.jac +9/−0
- examples/inc.jac +4/−0
- examples/nmCtx.jac +23/−0
- examples/wc.jac +7/−0
- jacinda.cabal +4/−2
- lib/csv.jac +6/−0
- lib/maybe.jac +4/−0
- man/ja.1 +7/−1
- src/Data/List/Ext.hs +1/−1
- src/Jacinda/Backend/Normalize.hs +41/−106
- src/Jacinda/Backend/TreeWalk.hs +126/−22
- src/Jacinda/Lexer.x +3/−0
- src/Jacinda/Parser/Rewrite.hs +1/−0
- src/Jacinda/Regex.hs +2/−4
- src/Jacinda/Ty.hs +21/−17
- test/Spec.hs +2/−1
- test/examples/evenOdd.jac +20/−0
CHANGELOG.md view
@@ -1,3 +1,11 @@+# 1.0.0.0++ * Generalize type of `\.` (prior)+ * Reintroduce monomorphism restriction (oops)+ * Better errors for ambiguous types+ * Multiple folds no longer blow up memory in some cases+ * `option` can be curried (parse bug fixed)+ # 0.3.1.0 * Performance improvements
README.md view
@@ -24,12 +24,8 @@ # SHOCK & AWE ```-ls -l | ja '(+)|0 {ix>1}{`5:}'-```--``` 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}{`11:}' -F,+ ja ',[1.0-x%y] {ix>1}{`5:} {ix>1}{`17:}' -F, ``` ## Rosetta@@ -61,7 +57,7 @@ # Status -The project is in alpha stage, it doesn't necessarily work and there are many+The project is in beta, it doesn't necessarily work and there are many missing features, but the language will remain stable. It is worse than awk but it has its place and it avoids some of the painful@@ -69,63 +65,22 @@ ## Missing Features & Bugs - * `sub`/`gsub` function equivalents * No nested dfns * Obscure renamer edge cases during evaluation- * Multiple folds are criminally inefficient- * Documentation for tuples, `Option` type * `printf` formatting for floats * No list literal syntax * Typeclasses are not documented- * Type system is questionable * Postfix `:f` and `:i` are handled poorly- * Various bugs in evaluation with regular expressions+ * Polymorphic functions can't be instantiated with separate types (global+ monomorphism restriction)+ * Expressions with multiple folds blow up in memory sometimes Intentionally missing features: * No loops -# Further Advantages+# Advantages * [Rust's regular expressions](https://docs.rs/regex/) - extensively documented with Unicode support * Deduplicate builtin--# PERFORMANCE--## Linux + x64--```-benchmarking bench/ja '(+)|0 {%/Bloom/}{1}' -i /tmp/ulysses.txt-time 8.110 ms (7.926 ms .. 8.304 ms)- 0.996 R² (0.993 R² .. 0.998 R²)-mean 8.470 ms (8.278 ms .. 8.771 ms)-std dev 693.0 μs (437.4 μs .. 1.008 ms)-variance introduced by outliers: 47% (moderately inflated)--benchmarking bench/original-awk '/Bloom/ { total += 1; } END { print total }' /tmp/ulysses.txt-time 13.24 ms (13.04 ms .. 13.39 ms)- 0.999 R² (0.998 R² .. 1.000 R²)-mean 13.39 ms (13.29 ms .. 13.49 ms)-std dev 256.0 μs (197.8 μs .. 380.7 μs)--benchmarking bench/gawk '/Bloom/ { total += 1; } END { print total }' /tmp/ulysses.txt-time 7.804 ms (7.706 ms .. 7.931 ms)- 0.996 R² (0.991 R² .. 0.999 R²)-mean 7.668 ms (7.572 ms .. 7.783 ms)-std dev 303.4 μs (229.7 μs .. 442.5 μs)-variance introduced by outliers: 17% (moderately inflated)--benchmarking bench/mawk '/Bloom/ { total += 1; } END { print total }' /tmp/ulysses.txt-time 3.179 ms (3.099 ms .. 3.240 ms)- 0.997 R² (0.995 R² .. 0.998 R²)-mean 3.213 ms (3.178 ms .. 3.270 ms)-std dev 148.9 μs (97.11 μs .. 267.6 μs)-variance introduced by outliers: 29% (moderately inflated)--benchmarking bench/busybox awk '/Bloom/ { total += 1; } END { print total }' /tmp/ulysses.txt-time 12.61 ms (12.43 ms .. 12.77 ms)- 0.999 R² (0.998 R² .. 1.000 R²)-mean 12.98 ms (12.86 ms .. 13.09 ms)-std dev 303.1 μs (234.5 μs .. 396.2 μs)-```
bench/Bench.hs view
@@ -2,15 +2,20 @@ module Main (main) where -import Control.DeepSeq (NFData (..))+import Control.DeepSeq (NFData (..)) import Criterion.Main+import qualified Data.ByteString.Lazy as BSL import Jacinda.AST import Jacinda.File+import System.IO.Silently (silence) main :: IO () main = defaultMain [ bgroup "eval" [ bench "exprEval" $ nf exprEval "[x+' '+y]|'' split '01-23-1987' /-/"+ , bench "runOnFile" $ nfIO (silence $ runOnFile [] "(+)|0 {%/Bloom/}{1}" Nothing "bench/data/ulysses.txt")+ , bench "runOnFile" $ nfIO (silence $ do { contents <- BSL.readFile "examples/wc.jac" ; runOnFile [] contents Nothing "bench/data/ulysses.txt" })+ , bench "runOnFile" $ nfIO (silence $ do { contents <- BSL.readFile "examples/span2.jac" ; runOnFile [] contents Nothing "bench/data/span.txt" }) ] ]
doc/guide.pdf view
binary file changed (196912 → 197938 bytes)
+ examples/avg.jac view
@@ -0,0 +1,4 @@+let+ val tot := (+)|0.0 $1:f+ val n := (+)|0.0 [:1.0"$0+in tot%n end
+ examples/cloc.jac view
@@ -0,0 +1,38 @@+{. fd -t f -x wc -l | ja run cloc.jac++@include'prelude/fn.jac'++fn count(xs) :=+ (+)|0 [:1"xs;++{. TODO: clojure+let+ val bqn := {%/\.bqn$/}{`1:i}+ val hs := {%/\.hs$/}{`1:i}+ val ja := {%/\.jac$/}{`1:i}+ val pl := {%/\.pl$/}{`1:i}+ val sed := {%/\.sed$/}{`1:i}+ val asm := {%/\.(S|asm)$/}{`1:i}+ val rb := {%/\.rb$/}{`1:i}+ val py := {%/\.py$/}{`1:i}+ val c := {%/\.c$/}{`1:i}+ val awk := {%/\.awk$/}{`1:i}+ val m4 := {%/\.m4$/}{`1:i}+ val make := {%/((M|GNUm|m)akefile|\.mk)$/}{`1:i}+ val batch := {%/\.bat$/}{`1:i}+in sprintf'Haskell:\t%i\t%i\nBQN:\t\t%i\t%i\nJacinda:\t%i\t%i\nC:\t\t%i\t%i\nPython:\t\t%i\t%i\nPerl:\t\t%i\t%i\nSed:\t\t%i\t%i\nAssembly:\t%i\t%i\nRuby:\t\t%i\t%i\nAwk:\t\t%i\t%i\nM4:\t\t%i\t%i\nMakefile:\t%i\t%i\nBatch:\t\t%i\t%i'+ ( count hs . sum hs+ . count bqn . sum bqn+ . count ja . sum ja+ . count c . sum c+ . count py . sum py+ . count pl . sum pl+ . count sed . sum sed+ . count asm . sum asm+ . count rb . sum rb+ . count awk . sum awk+ . count m4 . sum m4+ . count make . sum make+ . count batch . sum batch+ )+end
+ examples/diffctx.jac view
@@ -0,0 +1,23 @@+{. git diff master | rg '(\+|-).*TODO'++@include'prelude/fn.jac'+@include'lib/maybe.jac'++fn mMatch(str, re) :=+ if str ~ re+ then Some str+ else None;++fn step(needle, ctx, line) :=+ let + val fpCtx ≔ line ~* 1 /diff --git\s+([^\s]+)/+ val mLine ≔ mMatch line needle+ in (alternative (ctx->1) fpCtx.mLine) end;++fn process(x) :=+ let+ val fpCtx ≔ fromMaybe 'WARN' (x->1)+ val line ≔ (λl. sprintf'%s: %s' (fpCtx.l))"(x->2)+ in line end;++process:?(step/(\+|-).*TODO/)^(None.None)$0
+ examples/fields.jac view
@@ -0,0 +1,1 @@+(\l.[x+'\n'+y]|>(splitc l','))¨{ix=1}{`0}
+ examples/hsExtensions.jac view
@@ -0,0 +1,9 @@+@include'lib/string.jac'++fn findExtensions(line) :=+ let+ val extStr ≔ line ~* 1 /\{-#\s*LANGUAGE\s*(.*)#-\}/+ val extList ≔ (\s.split s /,\s*/)"extStr+ in extList end;++~.(λx.(intercalate'\n')"(findExtensions x)):?$0
+ examples/inc.jac view
@@ -0,0 +1,4 @@+fn isInc(stream) :=+ (&)|#t (>)\. stream;++isInc {%/Florida/}{`3:f}
+ examples/nmCtx.jac view
@@ -0,0 +1,23 @@+{. fd '\.a$' /usr -x nm --defined-only++@include'prelude/fn.jac'+@include'lib/maybe.jac'++fn mMatch(str, re) :=+ if str ~ re+ then Some str+ else None;++fn step(ctx, line) :=+ let + val fpCtx := line ~* 1 /(.*\.o):$/+ val mSym := line ~* 1 /^[0-0a-f]{16}.{3}(.*)/+ in (alternative (ctx->1) fpCtx.mSym) end;++fn process(x) :=+ let+ val fpCtx := fromMaybe 'WARN' (x->1)+ val line := (λl. sprintf'%s: %s' (fpCtx.l))"(x->2)+ in line end;++process:?step^(None.None)$0
+ examples/wc.jac view
@@ -0,0 +1,7 @@+{. FIXME: can't handle \r lol+let+ val sum := [(+)|0 x]+ val words := sum {|nf}+ val lines := sum {|1}+ val bytes := sum {|#`0+1}+in sprintf'%i %i %i' (lines.words.bytes) end
jacinda.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: jacinda-version: 0.3.1.0+version: 1.0.0.0 license: AGPL-3 license-file: COPYING maintainer: vamchale@gmail.com@@ -159,7 +159,9 @@ base, criterion, jacinda-lib,- deepseq+ deepseq,+ bytestring,+ silently if impl(ghc >=8.0) ghc-options:
+ lib/csv.jac view
@@ -0,0 +1,6 @@+{. naive+fn presentLines(l) ≔+ [x+'\n'+y]|>(splitc l',');++fn cols() ≔+ presentLines"{⍳=1}{`0};
lib/maybe.jac view
@@ -3,3 +3,7 @@ fn isNothing(x) := option #t ([:#f) x;++{. Haskell's (<|>)+fn alternative(a, b) :=+ option a Some b;
man/ja.1 view
@@ -85,7 +85,7 @@ Witherable f :=> (a -> Bool) -> f a -> f a .TP \f[B]\[rs].\f[R] Binary operator: prior-(a -> a -> a) -> Stream a -> Stream a+(a -> a -> b) -> Stream a -> Stream b .TP \f[B]\[ti].\f[R] Unary deduplication (stream) Eq a :=> Stream a -> Stream a@@ -188,6 +188,9 @@ {| sprintf \[aq]%i %i\[aq] (\[ga]2 . \[ga]1)} Print the first two fields in opposite order .TP+{ix=3}{\[ga]0}+Select only the third line+.TP :set fs := /,[ \[rs]t]*|[ \[rs]t]+/; {| sprintf \[aq]%i %i\[aq] (\[ga]2 . \[ga]1)} Same, with input fields separated by comma and/or blanks and tabs. .TP@@ -208,6 +211,9 @@ .TP {|sprintf \[aq]%i: %s\[aq] (ix.\[ga]0)} Display with line numbers+.TP+(&)|#t (>)\[rs]. {|\[ga]1:f}+Is the first column strictly increasing? .SH BUGS .PP Please report any bugs you may come across to
src/Data/List/Ext.hs view
@@ -3,7 +3,7 @@ , prior ) where -prior :: (a -> a -> a) -> [a] -> [a]+prior :: (a -> a -> b) -> [a] -> [b] prior op xs = zipWith op (tail xs) xs imap :: (Int -> a -> b) -> [a] -> [b]
src/Jacinda/Backend/Normalize.hs view
@@ -83,6 +83,7 @@ readFloat :: BS.ByteString -> Double readFloat = read . ASCII.unpack +-- TODO: do this on all expressions? -- fill in regex with compiled. compileR :: E a -> E a@@ -208,19 +209,6 @@ (RegexCompiled re, StrLit _ str) -> BoolLit tyBool (not $ isMatch' re str) (StrLit _ str, RegexCompiled re) -> BoolLit tyBool (not $ isMatch' re str) _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty0 (EApp ty1 op@(BBuiltin (TyArr _ (TyB _ TyInteger) _) Plus) e) e') = do- eI <- eNorm e- eI' <- eNorm e'- pure $ case (eI, eI') of- (IntLit _ i, IntLit _ j) -> i `seq` j `seq` IntLit tyI (i+j)- _ -> EApp ty0 (EApp ty1 op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyStr) _) Plus) e) e') = do- eI <- eNorm e- eI' <- eNorm e'- pure $ case (eI, eI') of- (StrLit _ s, StrLit _ s') -> StrLit tyStr (s <> s') -- TODO: copy?- (RegexLit _ rr, RegexLit _ rr') -> RegexLit tyStr (rr <> rr')- _ -> EApp ty (EApp ty' op eI) eI' eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyInteger) _) Max) e) e') = do eI <- eNorm e eI' <- eNorm e'@@ -267,37 +255,30 @@ pure $ case eI of (FloatLit _ f) -> mkI (ceiling f) _ -> EApp ty op eI-eNorm (EApp ty0 (EApp ty1 op@(BBuiltin (TyArr _ (TyB _ TyInteger) _) Minus) e) e') = do- eI <- eNorm e- eI' <- eNorm e'- pure $ case (eI, eI') of- (IntLit _ i, IntLit _ j) -> i `seq` j `seq` IntLit tyI (i-j)- _ -> EApp ty0 (EApp ty1 op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyInteger) _) Times) e) e') = do- eI <- eNorm e- eI' <- eNorm e'- pure $ case (eI, eI') of- (IntLit _ i, IntLit _ j) -> i `seq` j `seq` IntLit tyI (i*j)- _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyFloat) _) Plus) e) e') = do -- TODO: don't match on type, do that below+eNorm (EApp ty0 (EApp ty1 op@(BBuiltin _ Minus) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of- (FloatLit _ i, FloatLit _ j) -> i `seq` j `seq` FloatLit tyF (i+j)- _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyFloat) _) Minus) e) e') = do+ (IntLit _ i, IntLit _ j) -> i `seq` j `seq` IntLit tyI (i-j)+ (FloatLit _ i, FloatLit _ j) -> i `seq` j `seq` FloatLit tyF (i-j)+ _ -> EApp ty0 (EApp ty1 op eI) eI'+eNorm (EApp ty (EApp ty' op@(BBuiltin _ Times) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of- (FloatLit _ i, FloatLit _ j) -> i `seq` j `seq` FloatLit tyF (i-j)+ (IntLit _ i, IntLit _ j) -> i `seq` j `seq` IntLit tyI (i*j)+ (FloatLit _ i, FloatLit _ j) -> i `seq` j `seq` FloatLit tyF (i*j) _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyFloat) _) Times) e) e') = do+eNorm (EApp ty (EApp ty' op@(BBuiltin _ Plus) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of- (FloatLit _ i, FloatLit _ j) -> i `seq` j `seq` FloatLit tyF (i*j)- _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyFloat) _) Div) e) e') = do+ (IntLit _ i, IntLit _ j) -> i `seq` j `seq` IntLit tyI (i+j)+ (StrLit _ s, StrLit _ s') -> StrLit tyStr (s <> s') -- TODO: copy?+ (RegexLit _ rr, RegexLit _ rr') -> RegexLit tyStr (rr <> rr')+ (FloatLit _ i, FloatLit _ j) -> i `seq` j `seq` FloatLit tyF (i+j)+ _ -> EApp ty (EApp ty' op eI) eI'+eNorm (EApp ty (EApp ty' op@(BBuiltin _ Div) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of@@ -308,102 +289,52 @@ pure $ case eI of StrLit _ str -> IntLit tyI (fromIntegral $ BS.length str) _ -> EApp ty (UBuiltin ty' Tally) eI-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyStr) _) Eq) e) e') = do- eI <- eNorm e- eI' <- eNorm e'- pure $ case (eI, eI') of- (StrLit _ i, StrLit _ j) -> BoolLit tyBool (i == j)- _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyInteger) _) Lt) e) e') = do- eI <- eNorm e- eI' <- eNorm e'- pure $ case (eI, eI') of- (IntLit _ i, IntLit _ j) -> BoolLit tyBool (i < j)- _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyInteger) _) Gt) e) e') = do- eI <- eNorm e- eI' <- eNorm e'- pure $ case (eI, eI') of- (IntLit _ i, IntLit _ j) -> BoolLit tyBool (i > j)- _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyInteger) _) Eq) e) e') = do- eI <- eNorm e- eI' <- eNorm e'- pure $ case (eI, eI') of- (IntLit _ i, IntLit _ j) -> BoolLit tyBool (i == j)- _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyInteger) _) Neq) e) e') = do- eI <- eNorm e- eI' <- eNorm e'- pure $ case (eI, eI') of- (IntLit _ i, IntLit _ j) -> BoolLit tyBool (i /= j)- _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyInteger) _) Leq) e) e') = do+eNorm (EApp ty (EApp ty' op@(BBuiltin _ Lt) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of- (IntLit _ i, IntLit _ j) -> BoolLit tyBool (i <= j)- _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyInteger) _) Geq) e) e') = do+ (IntLit _ i, IntLit _ j) -> BoolLit tyBool (i < j)+ (FloatLit _ i, FloatLit _ j) -> BoolLit tyBool (i < j)+ _ -> EApp ty (EApp ty' op eI) eI'+eNorm (EApp ty (EApp ty' op@(BBuiltin _ Gt) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of- (IntLit _ i, IntLit _ j) -> BoolLit tyBool (i >= j)- _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyFloat) _) Eq) e) e') = do+ (IntLit _ i, IntLit _ j) -> BoolLit tyBool (i > j)+ (FloatLit _ i, FloatLit _ j) -> BoolLit tyBool (i > j)+ _ -> EApp ty (EApp ty' op eI) eI'+eNorm (EApp ty (EApp ty' op@(BBuiltin _ Eq) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of+ (IntLit _ i, IntLit _ j) -> BoolLit tyBool (i == j) (FloatLit _ i, FloatLit _ j) -> BoolLit tyBool (i == j)+ (BoolLit _ b, BoolLit _ b') -> BoolLit tyBool (b == b')+ (StrLit _ i, StrLit _ j) -> BoolLit tyBool (i == j) _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyFloat) _) Neq) e) e') = do+eNorm (EApp ty (EApp ty' op@(BBuiltin _ Neq) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of+ (IntLit _ i, IntLit _ j) -> BoolLit tyBool (i /= j) (FloatLit _ i, FloatLit _ j) -> BoolLit tyBool (i /= j)+ (StrLit _ i, StrLit _ j) -> BoolLit tyBool (i /= j)+ (BoolLit _ b, BoolLit _ b') -> BoolLit tyBool (b /= b') _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyFloat) _) Leq) e) e') = do+eNorm (EApp ty (EApp ty' op@(BBuiltin _ Leq) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of+ (IntLit _ i, IntLit _ j) -> BoolLit tyBool (i <= j) (FloatLit _ i, FloatLit _ j) -> BoolLit tyBool (i <= j) _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyFloat) _) Geq) e) e') = do+eNorm (EApp ty (EApp ty' op@(BBuiltin _ Geq) e) e') = do eI <- eNorm e eI' <- eNorm e' pure $ case (eI, eI') of+ (IntLit _ i, IntLit _ j) -> BoolLit tyBool (i >= j) (FloatLit _ i, FloatLit _ j) -> BoolLit tyBool (i >= j) _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyFloat) _) Gt) e) e') = do- eI <- eNorm e- eI' <- eNorm e'- pure $ case (eI, eI') of- (FloatLit _ i, FloatLit _ j) -> BoolLit tyBool (i > j)- _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyFloat) _) Lt) e) e') = do- eI <- eNorm e- eI' <- eNorm e'- pure $ case (eI, eI') of- (FloatLit _ i, FloatLit _ j) -> BoolLit tyBool (i < j)- _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyStr) _) Neq) e) e') = do- eI <- eNorm e- eI' <- eNorm e'- pure $ case (eI, eI') of- (StrLit _ i, StrLit _ j) -> BoolLit tyBool (i /= j)- _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyBool) _) Eq) e) e') = do- eI <- eNorm e- eI' <- eNorm e'- pure $ case (eI, eI') of- (BoolLit _ b, BoolLit _ b') -> BoolLit tyBool (b == b')- _ -> EApp ty (EApp ty' op eI) eI'-eNorm (EApp ty (EApp ty' op@(BBuiltin (TyArr _ (TyB _ TyBool) _) Neq) e) e') = do- eI <- eNorm e- eI' <- eNorm e'- pure $ case (eI, eI') of- (BoolLit _ b, BoolLit _ b') -> BoolLit tyBool (b /= b')- _ -> EApp ty (EApp ty' op eI) eI' eNorm (EApp ty0 (EApp ty1 op@(BBuiltin _ And) e) e') = do eI <- eNorm e eI' <- eNorm e'@@ -475,7 +406,7 @@ st <- gets binds case IM.lookup i st of Just e'@Var{} -> eNorm e' -- no cyclic binds!!- Just e' -> renameE e'+ Just e' -> renameE e' -- FIXME: set outermost type to be type of var... Nothing -> pure e -- default to e in case var was bound in a lambda eNorm (EApp ty e@Var{} e') = eNorm =<< (EApp ty <$> eNorm e <*> pure e') eNorm (EApp _ (Lam _ (Name _ (Unique i) _) e) e') = do@@ -511,6 +442,10 @@ (OptionVal _ Nothing) -> pure e0' (OptionVal _ (Just e)) -> eNorm (EApp undefined e1' e) _ -> pure $ EApp ty0 (EApp ty1 (EApp ty2 op e0') e1') e2'+eNorm (EApp ty1 (EApp ty2 op@(TBuiltin _ Option) e0) e1) = do+ e0' <- eNorm e0+ e1' <- eNorm e1+ pure $ EApp ty1 (EApp ty2 op e0') e1' eNorm (EApp ty0 (EApp ty1 op@(BBuiltin _ Match) e) e') = do eI <- eNorm e eI' <- eNorm e'@@ -575,4 +510,4 @@ case p' of BoolLit _ True -> eNorm e0 BoolLit _ False -> eNorm e1- _ -> pure $ Cond ty p' e0 e1 -- don't eval further, might bottom?+ _ -> Cond ty p' <$> eNorm e0 <*> eNorm e1 -- needed to perform substitutions
src/Jacinda/Backend/TreeWalk.hs view
@@ -1,31 +1,38 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | Tree-walking interpreter module Jacinda.Backend.TreeWalk ( runJac ) where -- TODO: normalize before mapping? -import Control.Exception (Exception, throw)-import Control.Recursion (cata, embed)-import qualified Data.ByteString as BS-import Data.Containers.ListUtils (nubIntOn, nubOrdOn)-import Data.Foldable (foldl', traverse_)-import Data.List (scanl', transpose)+import Control.Exception (Exception, throw)+import Control.Monad.State.Strict (State, get, modify, runState)+import Control.Recursion (cata, embed)+import Data.Bifunctor (bimap)+import qualified Data.ByteString as BS+import Data.Containers.ListUtils (nubIntOn, nubOrdOn)+import Data.Foldable (foldl', traverse_)+import qualified Data.IntMap as IM+import Data.List (scanl', transpose, unzip4) import Data.List.Ext-import Data.Maybe (mapMaybe)-import Data.Semigroup ((<>))-import qualified Data.Vector as V-import Debug.Trace (traceShow, traceShowId)+import Data.Maybe (mapMaybe)+import Data.Semigroup ((<>))+import qualified Data.Vector as V+import Intern.Name (Name (Name))+import Intern.Unique (Unique (Unique)) import Jacinda.AST import Jacinda.Backend.Normalize import Jacinda.Backend.Printf import Jacinda.Regex import Jacinda.Ty.Const-import Regex.Rure (RurePtr)+import Regex.Rure (RurePtr) data StreamError = NakedField | UnevalFun | TupOfStreams -- ^ Reject a tuple of streams | BadCtx+ | InternalError deriving (Show) type FileBS = BS.ByteString@@ -205,6 +212,22 @@ let eI = asFloat (go e) eI' = asFloat (go e') in BoolLit tyBool (eI /= eI')+ go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyFloat) _) Lt) e) e') =+ let eI = asFloat (go e)+ eI' = asFloat (go e')+ in BoolLit tyBool (eI < eI')+ go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyFloat) _) Gt) e) e') =+ let eI = asFloat (go e)+ eI' = asFloat (go e')+ in BoolLit tyBool (eI > eI')+ go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyFloat) _) Geq) e) e') =+ let eI = asFloat (go e)+ eI' = asFloat (go e')+ in BoolLit tyBool (eI >= eI')+ go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyFloat) _) Leq) e) e') =+ let eI = asFloat (go e)+ eI' = asFloat (go e')+ in BoolLit tyBool (eI <= eI') go (EApp _ (EApp _ (BBuiltin (TyArr _ (TyB _ TyFloat) _) Plus) e) e') = let eI = asFloat (go e) eI' = asFloat (go e')@@ -297,6 +320,13 @@ in mkStr (sprintf eI eI') go (OptionVal ty e) = OptionVal ty (go <$> e)+ go (EApp _ (EApp _ (EApp _ (TBuiltin _ Option) e0) e1) e2) =+ let e0' = go e0+ e1' = go e1+ e2' = go e2+ in case asOpt e2' of+ Nothing -> e0'+ Just e -> go (EApp undefined e1' e) go (EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ _ (TyApp _ (TyB _ TyVec) _))) Map) x) y) = let x' = go x y' = asArr (go y)@@ -330,7 +360,6 @@ let p' = asBool (go p) in if p' then go e0 else go e1 - -- just shove some big number into the renamer and hope it doesn't clash (bad, -- hack, this is why we got kicked out of the garden of Eden) reprehensible :: Int@@ -375,7 +404,6 @@ ir fp re (Guarded _ pe e) = let pe' = compileR pe e' = compileR e- -- FIXME: compile e too? -- TODO: normalize before stream in fmap (uncurry (\ix line -> eEval (mkCtx fp re ix line) e')) . ifilter' (\ix line -> asBool (eEval (mkCtx fp re ix line) pe')) ir fp re (EApp _ (EApp _ (BBuiltin _ Map) op) stream) = let op' = compileR (withFp fp op) in fmap (applyUn op') . ir fp re stream@@ -387,14 +415,14 @@ in mapMaybe (asOpt . applyUn op') . ir fp re stream ir fp re (EApp _ (UBuiltin _ CatMaybes) stream) = mapMaybe asOpt . ir fp re stream-ir fp re (EApp _ (EApp _ (BBuiltin _ Prior) op) stream) = prior (applyOp (withFp fp op)) . ir fp re stream+ir fp re (EApp _ (EApp _ (BBuiltin _ Prior) op) stream) = prior (applyOp (withFp fp (compileR op))) . ir fp re stream ir fp re (EApp _ (EApp _ (EApp _ (TBuiltin _ ZipW) op) streaml) streamr) = \lineStream -> let irl = ir fp re streaml lineStream irr = ir fp re streamr lineStream- in zipWith (applyOp (withFp fp op)) irl irr+ in zipWith (applyOp (withFp fp (compileR op))) irl irr ir fp re (EApp _ (EApp _ (EApp _ (TBuiltin _ Scan) op) seed) xs) =- scanl' (applyOp (withFp fp op)) seed . ir fp re xs+ scanl' (applyOp (withFp fp (compileR op))) seed . ir fp re xs ir fp re (EApp _ (UBuiltin (TyArr _ (TyApp _ _ (TyB _ TyStr)) _) Dedup) e) = nubOrdOn asStr . ir fp re e ir fp re (EApp _ (UBuiltin (TyArr _ (TyApp _ _ (TyB _ TyInteger)) _) Dedup) e) =@@ -415,7 +443,7 @@ -> E (T K) -> [BS.ByteString] -> E (T K)-foldWithCtx fp re op seed streamExpr = foldl' (applyOp op) seed . ir fp re streamExpr+foldWithCtx fp re op seed streamExpr = foldl' (applyOp $ withFp fp (compileR op)) seed . ir fp re streamExpr fold1 :: FileBS -> RurePtr@@ -435,11 +463,82 @@ -> Either StreamError ([BS.ByteString] -> IO ()) runJac fp re i e = fileProcessor fp re (closedProgram i e) +foldAll :: FileBS+ -> RurePtr+ -> [(Int, E (T K), E (T K), E (T K))]+ -> [BS.ByteString]+ -> [(Int, E (T K))]+foldAll fp re foldExprs bs = evalAll seeds (mkStreams streamExprs) where+ (is, ops, seeds, streamExprs) = unzip4 foldExprs+ mkStreams = fmap (\streamExpr -> ir fp re streamExpr bs)++ evalAll seedsϵ ess | not (any null ess) = let es' = zipWith3 applyOp' ops seedsϵ (headMaybe <$> ess) in es' `seqAll` evalAll es' (tail' <$> ess)+ -- if I try to use the (all null ess) criterion it space+ -- leaks like crazy so... inspect only when we need?+ --+ -- (still leaks space... but less)+ | not (all null ess) = let es' = zipWith3 applyOp' ops seedsϵ (headMaybe <$> ess) in es' `seqAll` evalAll es' (tail' <$> ess)+ | otherwise = zip is seedsϵ++ seqAll (e:es) z = foldr seq e es `seq` z+ seqAll [] z = z++ applyOp' op seed (Just e) = applyOp op seed e+ applyOp' _ seed Nothing = seed++ headMaybe [] = Nothing+ headMaybe (x:_) = Just x++ tail' [] = []+ tail' (_:xs) = xs++ungather :: IM.IntMap (E (T K)) -> E (T K) -> E (T K)+ungather st (Var _ (Name _ (Unique i) _)) =+ case IM.lookup i st of+ Just res -> res+ Nothing -> throw InternalError+ungather st (EApp ty e0 e1) = EApp ty (ungather st e0) (ungather st e1)+ungather st (Tup ty es) = Tup ty (ungather st <$> es)+ungather st (Arr ty es) = Arr ty (ungather st <$> es)+ungather st (OptionVal ty e) = OptionVal ty (ungather st <$> e)+ungather _ e@BBuiltin{} = e+ungather _ e@UBuiltin{} = e+ungather _ (NBuiltin _ None) = OptionVal undefined Nothing+ungather _ e@NBuiltin{} = e+ungather _ e@TBuiltin{} = e+ungather _ e@StrLit{} = e+ungather _ e@BoolLit{} = e+ungather _ e@FloatLit{} = e+ungather _ e@IntLit{} = e++mkFoldVar :: Int -> b -> E b+mkFoldVar i l = Var l (Name "fold_placeholder" (Unique i) l)++gatherFoldsM :: FileBS -> E (T K) -> State (Int, [(Int, E (T K), E (T K), E (T K))]) (E (T K))+gatherFoldsM fp (EApp _ (EApp _ (EApp _ (TBuiltin (TyArr _ _ (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyStream) _) _))) Fold) op) seed) stream) = do+ (i,_) <- get+ modify (bimap (+1) ((i, withFp fp (compileR op), seed, stream) :))+ pure $ mkFoldVar i undefined+gatherFoldsM fp (EApp ty e0 e1) = EApp ty <$> gatherFoldsM fp e0 <*> gatherFoldsM fp e1+gatherFoldsM fp (Tup ty es) = Tup ty <$> traverse (gatherFoldsM fp) es+gatherFoldsM fp (Arr ty es) = Arr ty <$> traverse (gatherFoldsM fp) es+gatherFoldsM fp (OptionVal ty e) = OptionVal ty <$> traverse (gatherFoldsM fp) e+gatherFoldsM fp (Cond ty p e e') = Cond ty <$> gatherFoldsM fp p <*> gatherFoldsM fp e <*> gatherFoldsM fp e'+gatherFoldsM fp (NBuiltin _ Fp) = pure $ mkStr fp+gatherFoldsM _ (NBuiltin _ None) = pure $ OptionVal undefined Nothing+gatherFoldsM _ e@BBuiltin{} = pure e+gatherFoldsM _ e@TBuiltin{} = pure e+gatherFoldsM _ e@UBuiltin{} = pure e+gatherFoldsM _ e@NBuiltin{} = pure e+gatherFoldsM _ e@StrLit{} = pure e+gatherFoldsM _ e@FloatLit{} = pure e+gatherFoldsM _ e@IntLit{} = pure e+gatherFoldsM _ e@BoolLit{} = pure e+ -- evaluate something that has a fold nested in it eWith :: FileBS -> RurePtr -> E (T K) -> [BS.ByteString] -> E (T K) eWith fp re (EApp _ (EApp _ (EApp _ (TBuiltin (TyArr _ _ (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyStream) _) _))) Fold) op) seed) stream) = foldWithCtx fp re op seed stream-eWith fp re (EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyStream) _) _)) Fold1) op) stream) = fold1 fp re op stream-eWith fp re (EApp ty e0 e1) = \bs -> eClosed undefined (EApp ty (eWith fp re e0 bs) (eWith fp re e1 bs))+eWith fp re (EApp _ (EApp _ (BBuiltin (TyArr _ _ (TyArr _ (TyApp _ (TyB _ TyStream) _) _)) Fold1) op) stream) = fold1 fp re (withFp fp $ compileR op) stream eWith _ _ e@BBuiltin{} = const e eWith _ _ e@UBuiltin{} = const e eWith _ _ e@TBuiltin{} = const e@@ -447,12 +546,17 @@ eWith _ _ e@FloatLit{} = const e eWith _ _ e@IntLit{} = const e eWith _ _ e@BoolLit{} = const e+eWith fp _ (NBuiltin _ Fp) = const (mkStr fp)+eWith fp re e = \bs ->+ let (eHoles, (_, folds)) = runState (gatherFoldsM fp e) (0, []) -- 0 state, should contain no vars by now+ in eClosed undefined $ ungather (IM.fromList $ foldAll fp re folds bs) eHoles+{-+eWith fp re (EApp ty e0 e1) = \bs -> eClosed undefined (EApp ty (eWith fp re e0 bs) (eWith fp re e1 bs)) -}+{- eWith fp re (Tup ty es) = \bs -> Tup ty ((\e -> eWith fp re e bs) <$> es) eWith fp re (OptionVal ty e) = \bs -> OptionVal ty ((\eϵ -> eWith fp re eϵ bs) <$> e) eWith fp re (Cond ty p e e') = \bs -> eClosed undefined (Cond ty (eWith fp re p bs) (eWith fp re e bs) (eWith fp re e' bs))-eWith fp _ (NBuiltin _ Fp) = const (mkStr fp)--- TODO: rewrite tuple-of-folds as fold-of-tuples ... "compile" to E (T K) -> E (T K)--- OR "compile" to [(Int, E (T K)] -> ...+-} takeConcatMap :: (a -> [b]) -> [a] -> [b] takeConcatMap f = concat . transpose . fmap f
src/Jacinda/Lexer.x view
@@ -84,6 +84,7 @@ "|" { mkSym FoldTok } \" { mkSym Quot }+ ¨ { mkSym Quot } "^" { mkSym Caret } "|>" { mkSym Fold1Tok } @@ -112,6 +113,7 @@ ";" { mkSym Semicolon } "\." { mkSym BackslashDot } \\ { mkSym Backslash }+ λ { mkSym Backslash } "|`" { mkSym CeilSym } "|." { mkSym FloorSym } "~." { mkSym DedupTok }@@ -133,6 +135,7 @@ fs { mkRes VarFs } ix { mkRes VarIx }+ ⍳ { mkRes VarIx } nf { mkRes VarNf } -- TODO: does this uncover an alex bug? -- ⍳ { mkRes VarIx }
src/Jacinda/Parser/Rewrite.hs view
@@ -54,6 +54,7 @@ a (EAppF l e0@(TBuiltin _ Substr) (EApp lϵ e1 (EApp lϵϵ e2 e3))) = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3 a (EAppF l e0@(TBuiltin _ Option) (EApp lϵ (EApp lϵϵ e1 e2) e3)) = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3 a (EAppF l e0@(TBuiltin _ Option) (EApp lϵ e1 (EApp lϵϵ e2 e3))) = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3+ a (EAppF l e0@(TBuiltin _ Option) (EApp lϵ e1 e2)) = EApp l (EApp lϵ e0 e1) e2 a (EAppF l e0@(TBuiltin _ AllCaptures) (EApp lϵ (EApp lϵϵ e1 e2) e3)) = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3 a (EAppF l e0@(TBuiltin _ AllCaptures) (EApp lϵ e1 (EApp lϵϵ e2 e3))) = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3 a x = embed x
src/Jacinda/Regex.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE OverloadedStrings #-} module Jacinda.Regex ( splitBy- , splitWhitespace , defaultRurePtr , isMatch' , find'@@ -31,9 +30,6 @@ defaultRurePtr = unsafePerformIO $ yeetRureIO =<< compile genFlags defaultFs where genFlags = rureDefaultFlags <> rureFlagDotNL -- in case they want to use a weird custom record separator -splitWhitespace :: BS.ByteString -> V.Vector BS.ByteString-splitWhitespace = splitBy defaultRurePtr- substr :: BS.ByteString -> Int -> Int -> BS.ByteString substr (BS.BS fp l) begin endϵ | endϵ >= begin = BS.BS (fp `plusForeignPtr` begin) (min l endϵ - begin) | otherwise = "error: invalid substring indices."@@ -57,6 +53,7 @@ find' :: RurePtr -> BS.ByteString -> Maybe RureMatch find' re str = unsafeDupablePerformIO $ find re str 0 +-- FIXME: splitBy '\s+' '' should be [] not [''] {-# NOINLINE splitBy #-} splitBy :: RurePtr -> BS.ByteString@@ -66,6 +63,7 @@ where ixes = unsafeDupablePerformIO $ matches' re haystack slicePairs = case ixes of (RureMatch 0 i:rms) -> mkMiddle (fromIntegral i) rms+ [] -> [] rms -> mkMiddle 0 rms mkMiddle begin' [] = [(begin', l)] mkMiddle begin' (rm0:rms) = (begin', fromIntegral (start rm0)) : mkMiddle (fromIntegral $ end rm0) rms
src/Jacinda/Ty.hs view
@@ -33,7 +33,7 @@ data Error a = UnificationFailed a (T ()) (T ()) | Doesn'tSatisfy a (T ()) C | IllScoped a (Name a)- | Ambiguous (E ())+ | Ambiguous (T K) (E ()) | Expected K K | IllScopedTyVar (TyName ()) @@ -41,7 +41,7 @@ pretty (UnificationFailed l ty ty') = pretty l <+> "could not unify type" <+> squotes (pretty ty) <+> "with" <+> squotes (pretty ty') pretty (Doesn'tSatisfy l ty c) = pretty l <+> squotes (pretty ty) <+> "is not a member of class" <+> pretty c pretty (IllScoped l n) = pretty l <+> squotes (pretty n) <+> "is not in scope."- pretty (Ambiguous e) = "type of" <+> squotes (pretty e) <+> "is ambiguous"+ pretty (Ambiguous ty e) = "type" <+> squotes (pretty ty) <+> "of" <+> squotes (pretty e) <+> "is ambiguous" pretty (Expected k0 k1) = "Found kind" <+> pretty k0 <> ", expected kind" <+> pretty k1 pretty (IllScopedTyVar n) = "Type variable" <+> squotes (pretty n) <+> "is not in scope." @@ -199,24 +199,25 @@ liftCloneTy :: T a -> TypeM b (T a) liftCloneTy ty = do i <- gets maxU- let (ty', j) = cloneTy i ty- ty <$ modify (setMaxU i)+ let (ty', (j, iMaps)) = cloneTy i ty+ -- FIXME: clone/propagate constraints+ ty' <$ modify (setMaxU j) -cloneTy :: Int -> T a -> (T a, Int)-cloneTy i ty = second fst $ flip runState (i, IM.empty) $ cloneTyM ty+cloneTy :: Int -> T a -> (T a, (Int, IM.IntMap Unique))+cloneTy i ty = flip runState (i, IM.empty) $ cloneTyM ty where cloneTyM (TyVar l (Name n (Unique j) l')) = do st <- gets snd case IM.lookup j st of- Just k -> pure k+ Just k -> pure (TyVar l (Name n k l')) Nothing -> do k <- gets fst- let ty' = TyVar l (Name n (Unique $ k+1) l')- ty' <$ modify (\(u, s) -> (u+1, IM.insert j ty' s))+ let j' = Unique $ k+1+ TyVar l (Name n j' l') <$ modify (\(u, s) -> (u+1, IM.insert j j' s)) cloneTyM (TyArr l tyϵ ty') = TyArr l <$> cloneTyM tyϵ <*> cloneTyM ty' cloneTyM (TyApp l tyϵ ty') = TyApp l <$> cloneTyM tyϵ <*> cloneTyM ty' cloneTyM (TyTup l tys) = TyTup l <$> traverse cloneTyM tys- cloneTyM ty@TyNamed{} = pure ty- cloneTyM ty@TyB{} = pure ty+ cloneTyM tyϵ@TyNamed{} = pure tyϵ+ cloneTyM tyϵ@TyB{} = pure tyϵ kind :: T K -> TypeM a () kind (TyB Star TyStr) = pure ()@@ -271,6 +272,7 @@ checkType (TyB _ TyFloat) (IsEq, _) = pure () checkType (TyB _ TyBool) (IsEq, _) = pure () checkType (TyB _ TyStr) (IsEq, _) = pure ()+checkType ty@(TyB _ TyStr) (c@IsOrd, l) = throwError $ Doesn'tSatisfy l (void ty) c checkType (TyTup _ tys) (IsEq, l) = traverse_ (`checkType` (IsEq, l)) tys checkType (TyTup _ tys) (IsOrd, l) = traverse_ (`checkType` (IsOrd, l)) tys checkType (TyApp _ (TyB _ TyVec) ty) (IsEq, l) = checkType ty (IsEq, l)@@ -317,7 +319,7 @@ lookupVar n@(Name _ (Unique i) l) = do st <- gets varEnv case IM.lookup i st of- Just ty -> liftCloneTy ty+ Just ty -> pure ty -- liftCloneTy ty Nothing -> throwError $ IllScoped l n tyOf :: Ord a => E a -> TypeM a (T K)@@ -341,15 +343,15 @@ isAmbiguous TyB{} = False checkAmb :: E (T K) -> TypeM a ()-checkAmb e@(BBuiltin ty _) | isAmbiguous ty = throwError $ Ambiguous (void e)+checkAmb e@(BBuiltin ty _) | isAmbiguous ty = throwError $ Ambiguous ty (void e) checkAmb TBuiltin{} = pure () -- don't fail on ternary builtins, we don't need it anyway... better error messages-checkAmb e@(UBuiltin ty _) | isAmbiguous ty = throwError $ Ambiguous (void e)+checkAmb e@(UBuiltin ty _) | isAmbiguous ty = throwError $ Ambiguous ty (void e) checkAmb (Implicit _ e') = checkAmb e' checkAmb (Guarded _ p e') = checkAmb p *> checkAmb e' checkAmb (EApp _ e' e'') = checkAmb e' *> checkAmb e'' -- more precise errors, don't fail yet! (if they aren't ambiguous, it shouldn't be checkAmb (Tup _ es) = traverse_ checkAmb es-checkAmb e@(Arr ty _) | isAmbiguous ty = throwError $ Ambiguous (void e)-checkAmb e@(Var ty _) | isAmbiguous ty = throwError $ Ambiguous (void e)+checkAmb e@(Arr ty _) | isAmbiguous ty = throwError $ Ambiguous ty (void e)+checkAmb e@(Var ty _) | isAmbiguous ty = throwError $ Ambiguous ty (void e) checkAmb (Let _ bs e) = traverse_ checkAmb [e, snd bs] checkAmb (Lam _ _ e) = checkAmb e -- I think checkAmb _ = pure ()@@ -561,8 +563,10 @@ -- (a -> a -> a) -> Stream a -> Stream a tyE0 (BBuiltin _ Prior) = do a <- dummyName "a"+ b <- dummyName "b" let a' = var a- fTy = tyArr (tyArr a' (tyArr a' a')) (tyArr (tyStream a') (tyStream a'))+ b' = var b+ fTy = tyArr (tyArr a' (tyArr a' b')) (tyArr (tyStream a') (tyStream b')) pure $ BBuiltin fTy Prior -- (a -> b -> c) -> Stream a -> Stream b -> Stream c tyE0 (TBuiltin _ ZipW) = do
test/Spec.hs view
@@ -28,6 +28,7 @@ "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"]+ , splitWhitespaceT "" [] , testCase "type of" (tyOfT sumBytes (TyB Star TyInteger)) , testCase "type of" (tyOfT krakRegex (TyApp Star (TyB (KArr Star Star) TyStream) (TyB Star TyStr))) -- stream of str , testCase "type of" (tyOfT krakCol (TyApp Star (TyB (KArr Star Star) TyStream) (TyB Star TyStr))) -- stream of str@@ -63,7 +64,7 @@ splitWhitespaceT :: BS.ByteString -> [BS.ByteString] -> TestTree splitWhitespaceT haystack expected = testCase "split col" $- toList (splitWhitespace haystack) @?= expected+ toList (splitBy defaultRurePtr haystack) @?= expected -- example: ls -l | ja '(+)|0 $5:i' sumBytes :: BSL.ByteString
+ test/examples/evenOdd.jac view
@@ -0,0 +1,20 @@+fn count(x) ≔+ (+)|0 [:1"x;++fn isEven() :=+ (~ /(0|2|4|6|8)$/);++fn isOdd() :=+ (~ /(1|3|5|7|9)$/);++fn divTen() :=+ (~/0$/);++let+ val iStream := $0+ val even := count (isEven #. iStream)+ val odd := count (isOdd #. iStream)+ val tens := count (divTen #. iStream)+ {. FIXME: if different lengths, all fucked (and... wrong :(+ val total := odd + even+in (total . odd . even) end