kempe 0.2.0.0 → 0.2.0.1
raw patch · 14 files changed
+103/−28 lines, 14 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +6/−0
- bench/Bench.hs +14/−3
- docs/manual.pdf binary
- examples/vierergruppe.kmp +14/−0
- kempe.cabal +3/−2
- lib/these.kmp +1/−0
- run/Main.hs +4/−0
- src/Kempe/Asm/Arm/Trans.hs +39/−7
- src/Kempe/Asm/Liveness.hs +1/−0
- src/Kempe/Check/Pattern.hs +7/−3
- src/Kempe/IR/Type.hs +6/−7
- src/Kempe/Proc/As.hs +2/−2
- src/Kempe/Proc/Nasm.hs +5/−3
- test/Golden.hs +1/−1
CHANGELOG.md view
@@ -1,5 +1,11 @@ # kempe +## 0.2.0.1++ * Performance improvements when assembling x86+ * Fix pattern match exhaustiveness checker+ * More lenient command-line parser+ ## 0.2.0.0 * Add aarch64 backend
bench/Bench.hs view
@@ -5,6 +5,7 @@ import Data.Bifunctor (Bifunctor, bimap) import qualified Data.ByteString.Lazy as BSL import qualified Data.Text as T+import qualified Data.Text.Lazy.IO as TLIO import Kempe.Asm.Liveness import qualified Kempe.Asm.X86.ControlFlow as X86 import qualified Kempe.Asm.X86.Linear as X86@@ -21,8 +22,10 @@ import Kempe.Pipeline import Kempe.Shuttle import Kempe.TyAssign-import Prettyprinter (Doc, defaultLayoutOptions, layoutPretty)-import Prettyprinter.Render.Text (renderStrict)+import Prettyprinter (Doc, defaultLayoutOptions, layoutCompact, layoutPretty)+import Prettyprinter.Render.Text (renderLazy, renderStrict)+import System.IO (hFlush)+import System.IO.Temp (withSystemTempFile) bivoid :: Bifunctor p => p a b -> p () () bivoid = bimap (const ()) (const ())@@ -48,6 +51,7 @@ , env eitherMod $ \ e -> bgroup "Pattern match exhaustiveness checker" [ bench "lib/either.kmp" $ nf checkModuleExhaustive e+ , bench "examples/vierergruppe.kmp" $ nf checkModuleExhaustive e ] , env parsedInteresting $ \ ~(f, n) -> bgroup "Inliner"@@ -96,9 +100,9 @@ , bench "Generate assembly (examples/splitmix.kmp)" $ nfIO (writeAsm "examples/splitmix.kmp") , bench "Generate assembly (lib/numbertheory.kmp)" $ nfIO (writeAsm "lib/numbertheory.kmp") , bench "Generate assembly (lib/gaussian.kmp)" $ nfIO (writeAsm "lib/gaussian.kmp")+ , bench "Write assembly to file (lib/gaussian.kmp)" $ nfIO (writeAsmToFile "lib/gaussian.kmp") , bench "Generate arm assembly (examples/factorial.kmp)" $ nfIO (writeArmAsm "examples/factorial.kmp") , bench "Generate arm assembly (lib/gaussian.kmp)" $ nfIO (writeArmAsm "lib/gaussian.kmp")- -- , bench "Generate assembly (lib/rational.kmp)" $ nfIO (writeAsm "lib/rational.kmp") , bench "Object file (examples/factorial.kmp)" $ nfIO (compile "examples/factorial.kmp" "/tmp/factorial.o" False) , bench "Object file (lib/numbertheory.kmp)" $ nfIO (compile "lib/numbertheory.kmp" "/tmp/numbertheory.o" False) , bench "Object file (examples/splitmix.kmp)" $ nfIO (compile "examples/splitmix.kmp" "/tmp/splitmix.o" False)@@ -144,6 +148,13 @@ absX86 = (,,) <$> splitmixAbsX86 <*> facAbsX86 <*> numAbsX86 -- not even gonna justify this yrrucnu f (y, x) = f x y++writeAsmToFile :: FilePath+ -> IO ()+writeAsmToFile inp = withSystemTempFile "unassembled.kmp" $ \_ h -> do+ res <- parseProcess inp+ TLIO.hPutStr h $ renderLazy $ layoutCompact $ uncurry dumpX86 res+ hFlush h writeAsm :: FilePath -> IO T.Text
docs/manual.pdf view
binary file changed (215362 → 215362 bytes)
+ examples/vierergruppe.kmp view
@@ -0,0 +1,14 @@+type Element { E | A | B | C }++; see: https://mathworld.wolfram.com/Vierergruppe.html+mult : Element Element -- Element+ =: [+ { case+ | E ->+ | A -> { case | E -> A | A -> E | B -> C | C -> B }+ | B -> { case | E -> B | A -> C | B -> E | C -> A }+ | C -> { case | E -> C | A -> B | B -> A | C -> E }+ }+]++%foreign kabi mult
kempe.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: kempe-version: 0.2.0.0+version: 0.2.0.1 license: BSD-3-Clause license-file: LICENSE copyright: Copyright: (c) 2020-2021 Vanessa McHale@@ -247,7 +247,8 @@ bytestring, criterion, prettyprinter,- text+ text,+ temporary if impl(ghc >=8.0) ghc-options:
+ lib/these.kmp view
@@ -0,0 +1,1 @@+type These a b { This a | That b | These a b }
run/Main.hs view
@@ -79,7 +79,11 @@ (Nothing, "aarch64") -> Aarch64 (Nothing, "x86_64") -> X64 (Just "aarch64", _) -> Aarch64+ (Just "arm64", _) -> Aarch64 (Just "x64", _) -> X64+ (Just "x86_64", _) -> X64+ (Just "x86-64", _) -> X64+ (Just "amd64", _) -> X64 _ -> error "Failed to parse architecture! Try one of x64, aarch64" irSwitch :: Parser Bool
src/Kempe/Asm/Arm/Trans.hs view
@@ -81,6 +81,12 @@ ; eEval <- evalE e r ; pure $ eEval ++ [BranchZero () (toAbsReg r) l1, Branch () l0] }+-- handles e.g. (mjump (=b (mem [1] (+ (reg datapointer) (int 0))) (tag 0x0)) kmp2)+irEmit _ (IR.MJump (IR.EqByte e (IR.ConstTag 0)) l) = do+ { r <- allocTemp64+ ; eEval <- evalE e r+ ; pure $ eEval ++ [BranchZero () (toAbsReg r) l]+ } irEmit _ (IR.MJump e l) = do { r <- allocTemp64 ; eEval <- evalE e r@@ -103,6 +109,7 @@ b1 = (w .&. 0xFFFF0000) `shiftR` 16 b2 = (w .&. 0xFFFF00000000) `shiftR` 32 b3 = (w .&. 0xFFFF000000000000) `shiftR` 48+ -- TODO: only MovRK if nonzero evalE :: IR.Exp -> IR.Temp -> WriteM [Arm AbsReg ()] evalE (IR.ConstInt i) r = pure [MovRC () (toAbsReg r) i]@@ -123,6 +130,8 @@ evalE (IR.ExprIntBinOp IR.IntMinusIR (IR.Reg r1) (IR.ConstInt i)) r = pure [SubRC () (toAbsReg r) (toAbsReg r1) i] evalE (IR.Mem 8 (IR.Reg r0)) r = pure [Load () (toAbsReg r) (Reg $ toAbsReg r0)] evalE (IR.Mem 1 (IR.Reg r0)) r = pure [LoadByte () (toAbsReg r) (Reg $ toAbsReg r0)]+evalE (IR.Mem 1 (IR.ExprIntBinOp IR.IntPlusIR (IR.Reg r0) (IR.ConstInt i))) r = pure [LoadByte () (toAbsReg r) (AddRCPlus (toAbsReg r0) i)]+evalE (IR.Mem 1 (IR.ExprIntBinOp IR.IntMinusIR (IR.Reg r0) (IR.ConstInt i))) r = pure [LoadByte () (toAbsReg r) (AddRCPlus (toAbsReg r0) (negate i))] evalE (IR.Mem 8 (IR.ExprIntBinOp IR.IntPlusIR (IR.Reg r0) (IR.ConstInt i))) r = pure [Load () (toAbsReg r) (AddRCPlus (toAbsReg r0) i)] evalE (IR.Mem 8 (IR.ExprIntBinOp IR.IntMinusIR (IR.Reg r0) (IR.ConstInt i))) r = pure [Load () (toAbsReg r) (AddRCPlus (toAbsReg r0) (negate i))] evalE (IR.Mem 8 e) r = do@@ -136,17 +145,22 @@ ; pure $ placeE ++ [LoadByte () (toAbsReg r) (Reg $ toAbsReg r')] } evalE (IR.Reg r) r' = pure [MovRR () (toAbsReg r') (toAbsReg r)]+evalE (IR.ExprIntRel IR.IntLeqIR (IR.Reg r1) (IR.Reg r2)) r =+ pure [CmpRR () (toAbsReg r1) (toAbsReg r2), CSet () (toAbsReg r) Leq] evalE (IR.ExprIntRel IR.IntLtIR (IR.Reg r1) (IR.Reg r2)) r = pure [CmpRR () (toAbsReg r1) (toAbsReg r2), CSet () (toAbsReg r) Lt]+evalE (IR.ExprIntRel IR.IntGtIR (IR.Reg r1) (IR.Reg r2)) r =+ pure [CmpRR () (toAbsReg r1) (toAbsReg r2), CSet () (toAbsReg r) Gt] evalE (IR.ExprIntRel IR.IntEqIR (IR.Reg r1) (IR.Reg r2)) r = pure [CmpRR () (toAbsReg r1) (toAbsReg r2), CSet () (toAbsReg r) Eq]-evalE (IR.ExprIntRel IR.IntEqIR e e') r = do- { r0 <- allocTemp64- ; r1 <- allocTemp64- ; eEval <- evalE e r0- ; e'Eval <- evalE e' r1- ; pure $ eEval ++ e'Eval ++ [CmpRR () (toAbsReg r0) (toAbsReg r1), CSet () (toAbsReg r) Eq]- }+evalE (IR.ExprIntRel IR.IntNeqIR (IR.Reg r1) (IR.Reg r2)) r =+ pure [CmpRR () (toAbsReg r1) (toAbsReg r2), CSet () (toAbsReg r) Neq]+evalE (IR.ExprIntRel IR.IntEqIR e e') r = cmpE e e' r Eq+evalE (IR.ExprIntRel IR.IntNeqIR e e') r = cmpE e e' r Neq+evalE (IR.ExprIntRel IR.IntLtIR e e') r = cmpE e e' r Lt+evalE (IR.ExprIntRel IR.IntGtIR e e') r = cmpE e e' r Gt+evalE (IR.ExprIntRel IR.IntLeqIR e e') r = cmpE e e' r Leq+evalE (IR.ExprIntRel IR.IntGeqIR e e') r = cmpE e e' r Geq evalE (IR.EqByte e (IR.ConstTag b)) r = do { r0 <- allocTemp64 ; eEval <- evalE e r0@@ -169,7 +183,25 @@ { rTrash <- allocTemp64 ; pure [ UnsignedDivRR () (toAbsReg rTrash) (toAbsReg r1) (toAbsReg r2), MulSubRRR () (toAbsReg r) (toAbsReg rTrash) (toAbsReg r2) (toAbsReg r1) ] }+evalE (IR.ExprIntBinOp IR.IntModIR e e') r = do+ { rTrash <- allocTemp64+ ; r0 <- allocTemp64+ ; r1 <- allocTemp64+ ; eEval <- evalE e r0+ ; e'Eval <- evalE e' r1+ ; pure $ eEval ++ e'Eval ++ [ UnsignedDivRR () (toAbsReg rTrash) (toAbsReg r0) (toAbsReg r1), MulSubRRR () (toAbsReg r) (toAbsReg rTrash) (toAbsReg r1) (toAbsReg r0) ]+ } evalE (IR.ConstBool b) r = pure [MovRC () (toAbsReg r) (toInt b)]++-- | Helper for <, >, etc. used by 'evalE'+cmpE :: IR.Exp -> IR.Exp -> IR.Temp -> Cond -> WriteM [Arm AbsReg ()]+cmpE e e' r c = do+ { r0 <- allocTemp64+ ; r1 <- allocTemp64+ ; eEval <- evalE e r0+ ; e'Eval <- evalE e' r1+ ; pure $ eEval ++ e'Eval ++ [CmpRR () (toAbsReg r0) (toAbsReg r1), CSet () (toAbsReg r) c]+ } -- | Just use 64-bit integers here toInt :: Bool -> Int64
src/Kempe/Asm/Liveness.hs view
@@ -56,6 +56,7 @@ where nSt' = {-# SCC "iterNodes" #-} iterNodes is nSt iterNodes :: [Int] -> LivenessMap -> LivenessMap+-- this is fickle, thread will seemingly thunk leak (??) if optimizations aren't on iterNodes is = thread (fmap stepNode is) stepNode :: Int -> LivenessMap -> LivenessMap
src/Kempe/Check/Pattern.hs view
@@ -16,6 +16,7 @@ import qualified Data.IntMap.Strict as IM import qualified Data.IntSet as IS import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE import Kempe.AST import Kempe.Error import Kempe.Name@@ -25,8 +26,9 @@ checkAtom :: PatternEnv -> Atom c b -> Maybe (Error b) checkAtom env (Case l ls) =- if isExhaustive env $ fmap fst ls- then Nothing+ let (ps, as) = NE.unzip ls in+ if isExhaustive env ps+ then foldMapAlternative (foldMapAlternative (checkAtom env)) as else Just (InexhaustiveMatch l) checkAtom _ _ = Nothing @@ -90,8 +92,10 @@ isExhaustive _ (PatternInt{}:|ps) = hasWildcard ps isExhaustive _ (PatternBool _ True:|PatternBool _ False:_) = True isExhaustive _ (PatternBool _ False:|PatternBool _ True:_) = True+-- doesn't technically work since you could have True True False but like...+-- don't do that isExhaustive _ (PatternBool{}:|ps) = hasWildcard ps-isExhaustive env ps@(PatternCons{}:|_) = isCompleteSet env (fmap patternName ps)+isExhaustive env ps@(PatternCons{}:|_) = hasWildcard ps || isCompleteSet env (fmap patternName ps) isCompleteSet :: PatternEnv -> NonEmpty (TyName a) -> Bool isCompleteSet env ns@(n:|_) =
src/Kempe/IR/Type.hs view
@@ -75,14 +75,13 @@ data Stmt = Labeled Label | Jump Label- -- conditional jump for ifs- | CJump Exp Label Label -- ^ If the 'Exp' evaluates to @1@, go to the first label, otherwise go to the second (if-then-else)+ | CJump Exp Label Label -- ^ If the 'Exp' evaluates to @1@, go to the first label, otherwise go to the second (if-then-else). Used to implement ifs. | MJump Exp Label | CCall MonoStackType BSL.ByteString- | KCall Label -- KCall is a jump to a Kempe procedure+ | KCall Label -- ^ a 'KCall' is a jump to a Kempe procedure | WrapKCall ABI MonoStackType BS.ByteString Label- | MovTemp Temp Exp -- put e in temp- | MovMem Exp Int64 Exp -- store e2 at address given by e1+ | MovTemp Temp Exp -- ^ Put @e@ in temp+ | MovMem Exp Int64 Exp -- ^ Store @e2@ at address given by @e1@, with sizing information | Ret deriving (Generic, NFData) @@ -92,7 +91,7 @@ | ConstWord Word | ConstBool Bool | Reg Temp -- TODO: size?- | Mem Int64 Exp -- fetch from address+ | Mem Int64 Exp -- ^ Fetch from address | ExprIntBinOp IntBinOp Exp Exp | ExprIntRel RelBinOp Exp Exp | BoolBinOp BoolBinOp Exp Exp@@ -134,7 +133,7 @@ | IntMinusIR | IntModIR -- rem? | IntXorIR- | WordShiftRIR -- compiles to shr on x86+ | WordShiftRIR -- ^ compiles to @shr@ on x86 | WordShiftLIR -- int/word mod are different, see: https://stackoverflow.com/questions/8231882/how-to-implement-the-mod-operator-in-assembly | WordModIR
src/Kempe/Proc/As.hs view
@@ -2,7 +2,7 @@ ) where import Data.Functor (void)-import Prettyprinter (Doc, defaultLayoutOptions, layoutPretty)+import Prettyprinter (Doc, layoutCompact) import Prettyprinter.Render.String (renderString) import System.Info (arch) import System.Process (CreateProcess (..), StdStream (Inherit), proc, readCreateProcess)@@ -21,6 +21,6 @@ -> Bool -- ^ Debug symbols? -> IO () writeO p fpO dbg = do- let inp = renderString (layoutPretty defaultLayoutOptions p)+ let inp = renderString (layoutCompact p) debugFlag = if dbg then ("-g":) else id void $ readCreateProcess ((proc assembler (debugFlag ["-o", fpO, "--"])) { std_err = Inherit }) inp
src/Kempe/Proc/Nasm.hs view
@@ -2,8 +2,9 @@ ) where import Data.Functor (void)-import Prettyprinter (Doc, defaultLayoutOptions, layoutPretty)-import Prettyprinter.Render.Text (renderIO)+import qualified Data.Text.Lazy.IO as TLIO+import Prettyprinter (Doc, layoutCompact)+import Prettyprinter.Render.Text (renderLazy) import System.IO (hFlush) import System.IO.Temp (withSystemTempFile) import System.Process (CreateProcess (..), StdStream (Inherit), proc, readCreateProcess)@@ -14,7 +15,8 @@ -> Bool -- ^ Debug symbols? -> IO () writeO p fpO dbg = withSystemTempFile "kmp.S" $ \fp h -> do- renderIO h (layoutPretty defaultLayoutOptions p)+ let txt = renderLazy $ layoutCompact p+ TLIO.hPutStr h txt hFlush h let debugFlag = if dbg then ("-g":) else id -- -O1 is signed byte optimization but no multi-passes
test/Golden.hs view
@@ -22,7 +22,7 @@ , compileArm "lib/numbertheory.kmp" , compileArm "test/examples/bool.kmp" , compileArm "examples/splitmix.kmp"- -- , compileArm "lib/gaussian.kmp"+ , compileArm "lib/gaussian.kmp" ] "aarch64" -> [] _ -> error "Test suite must be run on x86_64 or aarch64"