From a152771d93f39df22f666592b3de2293437ab904 Mon Sep 17 00:00:00 2001 From: Erik Oosting Date: Tue, 16 Jan 2024 21:22:59 +0100 Subject: added back 3 hours of work hopefully this is all correct, I lost it when I forgot to soave --- haskell/app/Lift.hs | 48 +++++++++++++++++++++++++++++++++++++++++++ haskell/pkgs/llvm-codegen.nix | 1 + 2 files changed, 49 insertions(+) diff --git a/haskell/app/Lift.hs b/haskell/app/Lift.hs index d31eab1..fa22a17 100644 --- a/haskell/app/Lift.hs +++ b/haskell/app/Lift.hs @@ -39,3 +39,51 @@ findVarsAExp :: AExpF [String] -> [String] findVarsAExp (IdentF ns) = [ns] findVarsAExp (LamF args cexp) = converge (\\ args) (fold findVars cexp) findVarsAExp def = foldMap id def + +-- replacing free variables with a new one if it matches the argument + +compareNames n m = if n == m then n ++ "_" else n + +-- | replace bound variables in AExps +replaceVarsAExp :: String -> AExpF a -> AExpF a +replaceVarsAExp n (IdentF m) = IdentF $ compareNames m n +replaceVarsAExp n (LamF args body) = + LamF + (fmap (\x -> if x == n then x ++ "_" else x) args) + (cata replaceVarsCExp body n) +replaceVarsAExp _ rest = rest + +-- | replace bound variables in CExps +replaceVarsCExp :: CExpF (String -> CExp) -> String -> CExp +replaceVarsCExp (LetF name fc restf) = do + env <- id + rest <- restf + let newName = compareNames name env + return $ Let newName (replaceVarsFC env fc) rest +replaceVarsCExp (IfF cond thenF elseF) = do + thenPart <- thenF + elsePart <- elseF + env <- id + return $ If (hoist (replaceVarsAExp env) cond) thenPart elsePart +replaceVarsCExp (FCF fc) = do + env <- id + return $ FC (replaceVarsFC env fc) + +-- | replace bound variables in Function calls +replaceVarsFC :: String -> Funcall -> Funcall +replaceVarsFC n (Atom aexp) = Atom $ hoist (replaceVarsAExp n) aexp +replaceVarsFC n (Call name args) = + Call + (compareNames name n) + $ fmap (hoist (replaceVarsAExp n)) args + +subVarsAExp :: ([String], AExpF a) -> AExpF ([String], a) +subVarsAExp (env, LamF args body) = let + toReplace = intersect env args + newArgs = fmap (\x -> if x `elem` toReplace then x ++ "_" else x) args + newBody = foldl (cata replaceVarsCExp) body toReplace + in LamF newArgs (cotransverse subVarsCExp (newArgs ++ env, newBody)) +subVarsAExp (env, rest) = fmap (env,) rest + +subVarsCExp :: ([String], CExpF a) -> CExpF ([String], a) +subVarsCExp = undefined diff --git a/haskell/pkgs/llvm-codegen.nix b/haskell/pkgs/llvm-codegen.nix index 57a95c8..76e6a8d 100644 --- a/haskell/pkgs/llvm-codegen.nix +++ b/haskell/pkgs/llvm-codegen.nix @@ -21,6 +21,7 @@ mkDerivation { base bytestring containers dlist ghc-prim hspec hspec-hedgehog mmorph mtl neat-interpolation text text-builder-linear ]; + doHaddock = false; testToolDepends = [ llvm-config ]; homepage = "https://github.com/luc-tielen/llvm-codegen"; license = lib.licenses.bsd3; -- cgit 1.4.1-2-gfad0