Skip to content

Commit

Permalink
Avoid using recursion schemes (slow)
Browse files Browse the repository at this point in the history
  • Loading branch information
@vmchale
vmchale committed Jun 17, 2024
1 parent fba6d98 commit 35212a2
Show file tree
Hide file tree
Showing 3 changed files with 50 additions and 80 deletions.
1 change: 0 additions & 1 deletion jacinda.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -89,7 +89,6 @@ library jacinda-lib
filepath,
microlens-mtl >=0.1.8.0,
vector >=0.12.2.0,
recursion >=1.0.0.0,
split,
deepseq,
lazy-csv
Expand Down
34 changes: 0 additions & 34 deletions src/A.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,12 +11,9 @@ module A ( E (..), T (..), (~>), TB (..), C (..)
, Mode (..)
, mapExpr
, getS, flushD
-- * Base functors
, EF (..)
) where

import Control.DeepSeq (NFData)
import Control.Recursion (Base, Corecursive, Recursive)
import qualified Data.ByteString as BS
import qualified Data.IntMap as IM
import Data.List (foldl')
Expand Down Expand Up @@ -216,37 +213,6 @@ data E a = Column { eLoc :: a, col :: Int }
| RwB { eLoc :: a, eBin :: BBin } | RwT { eLoc :: a, eTer :: BTer }
deriving (Functor, Generic)

instance Recursive (E a) where
instance Corecursive (E a) where

data EF a x = ColumnF a Int
| IParseColF a Int | FParseColF a Int | ParseColF a Int
| FieldF a Int | LastFieldF a | FieldListF a | AllFieldF a
| AllColumnF a | IParseAllColF a | FParseAllColF a | ParseAllColF a
| EAppF a x x
| 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
| DfnF a x
| BBF a BBin | TBF a BTer | UBF a BUn | NBF a N
| TupF a [x]
| ResVarF a DfnVar
| RCF RurePtr
| ArrF a (V.Vector x)
| AnchorF a [x]
| ParenF a x
| OptionValF a (Maybe x)
| CondF a x x x
| InF x (Maybe x) (Maybe x) x
| RwBF a BBin | RwTF a BTer
deriving (Generic, Functor)

type instance Base (E a) = (EF a)

instance Pretty N where
pretty Ix="⍳"; pretty Nf="nf"; pretty None="None"; pretty Fp="fp"; pretty MZ="⍬"

Expand Down
95 changes: 50 additions & 45 deletions src/Parser/Rw.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,6 @@ module Parser.Rw ( rwP, rwD, rwE ) where


import A
import Control.Recursion (cata, embed)

rwP :: Program a -> Program a
rwP (Program ds e) = Program (rwD <$> ds) (rwE e)
Expand Down Expand Up @@ -44,49 +43,55 @@ mFi Prior = Just 5
mFi DedupOn = Just 5
mFi Report = Just 4

isPre :: BUn -> Bool
isPre At{} = False
isPre Select{} = False
isPre IParse = False
isPre FParse = False
isPre Parse = False
isPre _ = True
pPre :: BUn -> Bool
pPre Dedup = True
pPre Not = True
pPre TallyList = True
pPre Tally = True
pPre _ = False

-- FIXME: prefix-not should extend over vars...

rwE :: E a -> E a
rwE = cata a where
a (EAppF l e0@(UB _ op) (EApp lϵ (EApp lϵϵ e1@(BB _ bop) e2) e3))
| Just{} <- mFi bop
, isPre op && op /= Dedup
= EApp l (EApp lϵ e1 (EApp lϵϵ e0 e2)) e3
a (EAppF l e0@(EApp _ (BB _ op0) _) (EApp l1 (EApp l2 e1@(BB _ op1) e2) e3))
| Just f0 <- mFi op0
, Just f1 <- mFi op1
, f0 > f1
= EApp l1 (EApp l2 e1 (EApp l e0 e2)) e3
a (EAppF l e0@Var{} (EApp lϵ (EApp lϵϵ e1 e2) e3)) = EApp l (EApp lϵ (EApp lϵϵ e0 e1) e2) e3
-- TODO rewrite dfn
a (EAppF l e0@Var{} (EApp l0 e1 (EApp l1 (EApp l2 op@BB{} e2) e3))) = EApp l1 (EApp l2 op (EApp l (EApp l0 e0 e1) e2)) e3
a (EAppF l e0@Var{} (EApp lϵ e1 e2)) = EApp l (EApp lϵ e0 e1) e2
a (EAppF l e0@(BB _ 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
a x = embed x
rwE (EApp l0 (EApp l1 (EApp l2 ho@TB{} e3) e2) e1) =
(EApp l0 (EApp l1 (EApp l2 ho (rwE e3)) (rwE e2)) (rwE e1))
rwE (EApp l0 (EApp l1 e0@(BB _ op0) e1) e2) | Just fi <- mFi op0 =
case rwE e2 of
(EApp l2 (EApp l3 e3@(BB _ op1) e4) e5) | Just fi' <- mFi op1, fi > fi' -> EApp l0 (EApp l1 e3 (rwE (EApp l2 (EApp l3 e0 e1) e4))) e5
e2' -> EApp l0 (EApp l1 e0 (rwE e1)) e2'
rwE (EApp l op@(UB _ Dedup) e) = EApp l op (rwE e)
rwE (EApp l e0 e') =
case (e0, rwE e') of
(_, EApp lϵ (EApp lϵϵ e3@(BB _ op) e4) e2) | Just{} <- mFi op -> EApp l (EApp lϵϵ e3 (rwE $ EApp lϵ e0 e4)) e2
(UB _ f, e2) | pPre f -> EApp l e0 e2
(_, EApp lϵ e1@EApp{} e2) -> EApp l (rwE $ EApp lϵ e0 e1) e2
(_, EApp lϵ e1 e2) -> EApp l (EApp lϵ (rwE e0) e1) e2
(_, eRw) -> EApp l (rwE e0) eRw
rwE e@Column{} = e
rwE e@IParseCol{} = e
rwE e@FParseCol{} = e
rwE e@ParseCol{} = e
rwE e@Field{} = e
rwE e@LastField{} = e
rwE e@FieldList{} = e
rwE e@AllField{} = e
rwE e@AllColumn{} = e
rwE e@IParseAllCol{} = e
rwE e@FParseAllCol{} = e
rwE e@ParseAllCol{} = e
rwE (Guarded l p e) = Guarded l (rwE p) (rwE e)
rwE (Implicit l e) = Implicit l (rwE e)
rwE (Let l (n, e') e) = Let l (n, rwE e') (rwE e)
rwE e@Var{} = e
rwE e@Lit{} = e
rwE e@RegexLit{} = e
rwE (Lam l n e) = Lam l n (rwE e)
rwE (Dfn l e) = Dfn l (rwE e)
rwE e@BB{} = e
rwE e@TB{} = e
rwE e@UB{} = e
rwE e@NB{} = e
rwE (Tup l es) = Tup l (rwE<$>es)
rwE e@ResVar{} = e
rwE (Paren l e) = Paren l (rwE e)
rwE (Cond l p e e') = Cond l (rwE p) (rwE e) (rwE e')

0 comments on commit 35212a2

Please sign in to comment.