From 1f2485fc44cad6155953de43567f9e7cf51c8ed9 Mon Sep 17 00:00:00 2001 From: "Juan J. Martinez" Date: Sat, 13 Aug 2022 08:49:39 +0100 Subject: Extracted function --- src/Compiler.hs | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) (limited to 'src') diff --git a/src/Compiler.hs b/src/Compiler.hs index ea97bb8..978e32b 100644 --- a/src/Compiler.hs +++ b/src/Compiler.hs @@ -15,6 +15,19 @@ type CompResult = Either [Error] () startState :: CompState startState = (emptyEnv, []) +-- | @foldlEither fn init xs@ folds left @xs@ applying a function @fn@ that +-- returns either, returning accumulated right and the collected lefts as a +-- list. +foldlEither :: (accr -> b -> Either accl accr) -> (accr, [accl]) -> [b] -> (accr, [accl]) +foldlEither fn init xs = + foldl + ( \(r, l) x -> case fn r x of + Left e -> (r, e : l) + Right x -> (x, l) + ) + init + xs + compile :: [A.Expr] -> State CompState CompResult compile (x : xs) = do case x of @@ -27,14 +40,7 @@ compile (x : xs) = do (nev, nerrs) <- return $ case addSymUniq ev (ident, A.toFuncType params ret, pos) of Left e -> (ev, e : errs) - Right fev -> - foldl - ( \(ev, errs) (id, typ, pos) -> case addSymUniq ev (id, typ, pos) of - Right ev -> (ev, errs) - Left nerr -> (ev, nerr : errs) - ) - (addEnv fev, errs) - params + Right fev -> foldlEither addSymUniq (addEnv fev, errs) params put (nev, nerrs) r <- compile body (_, errs) <- get -- cgit v1.2.3