packages feed

kempe 0.2.0.8 → 0.2.0.9

raw patch · 26 files changed

+264/−41 lines, 26 filesdep ~prettyprinterPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependency ranges changed: prettyprinter

API changes (from Hackage documentation)

+ Kempe.AST: ArmAbi :: ABI
+ Kempe.AST: Hooked :: ABI
+ Kempe.File: cDeclFile :: FilePath -> IO [CFunc]
+ Kempe.File: dumpCDecl :: FilePath -> IO ()
+ Kempe.Lexer: KwArmAbi :: Keyword
+ Kempe.Lexer: KwHooked :: Keyword
+ Language.C.AST: CBool :: CType
+ Language.C.AST: CFunc :: !Text -> [CType] -> CType -> CFunc
+ Language.C.AST: CInt :: CType
+ Language.C.AST: CInt8 :: CType
+ Language.C.AST: CUInt64 :: CType
+ Language.C.AST: CVoid :: CType
+ Language.C.AST: CVoidPtr :: CType
+ Language.C.AST: cSettings :: LayoutOptions
+ Language.C.AST: data CFunc
+ Language.C.AST: data CType
+ Language.C.AST: instance GHC.Classes.Eq Language.C.AST.CHeader
+ Language.C.AST: instance GHC.Classes.Ord Language.C.AST.CHeader
+ Language.C.AST: instance Prettyprinter.Internal.Pretty Language.C.AST.CFunc
+ Language.C.AST: instance Prettyprinter.Internal.Pretty Language.C.AST.CType
+ Language.C.AST: prettyHeaders :: [CFunc] -> Doc ann

Files

CHANGELOG.md view
@@ -1,5 +1,11 @@ # kempe +## 0.2.0.9++  * Add `armabi` method of exporting Kempe functions, so that `kc` generates+    suitable code for M1 darwin.+  * Add `cdecl` subcommand to generate C headers for exported functions+ ## 0.2.0.8    * More efficient IR generation; don't copy bytes from a source to the same@@ -20,7 +26,7 @@   * Add `absInt` and `chocie` functions to prelude.   * Add lints for `swap >`, `swap *` &c.   * Fix bug in typing `>=`, `>`, `!=`-  + ## 0.2.0.5    * Fix bug in arm control-flow analysis
docs/manual.pdf view

binary file changed (215432 → 217165 bytes)

examples/factorial.kmp view
@@ -17,5 +17,5 @@            , dup 1 - fac * )        ] -%foreign cabi fac-%foreign cabi fac_tailrec+%foreign armabi fac+%foreign armabi fac_tailrec
+ golden/CDecl.hs view
@@ -0,0 +1,24 @@+module CDecl ( goldenCDecl+             ) where++import qualified Data.ByteString.Lazy      as BSL+import           Data.Text.Lazy.Encoding   (encodeUtf8)+import           Kempe.File+import           Language.C.AST+import           Prettyprinter             (Doc, LayoutOptions (..), PageWidth (..), layoutSmart)+import           Prettyprinter.Render.Text (renderLazy)+import           Test.Tasty                (TestTree)+import           Test.Tasty.Golden         (goldenVsString)++renderBSL :: Doc ann -> BSL.ByteString+renderBSL = encodeUtf8 . renderLazy . layoutSmart cSettings where++compileOutput :: FilePath+              -> IO BSL.ByteString+compileOutput = fmap (renderBSL . prettyHeaders) . cDeclFile++goldenCDecl :: FilePath -- ^ Kempe file+            -> FilePath -- ^ Golden header file+            -> TestTree+goldenCDecl kFp golden =+    goldenVsString kFp golden (compileOutput kFp)
golden/Golden.hs view
@@ -1,5 +1,6 @@ module Main (main) where +import           CDecl import           Data.Tuple.Extra (uncurry3) import           Harness import           System.Info      (arch)@@ -9,6 +10,7 @@ main = defaultMain $     testGroup "Golden output tests" $         fmap (uncurry3 goldenOutput) allGoldens ++ crossTests+            ++ fmap (uncurry goldenCDecl) headerGoldens  -- These are redundant on arm crossTests :: [TestTree]@@ -16,6 +18,9 @@     "x86_64"  -> fmap (uncurry3 crossGolden) allGoldens     "aarch64" -> []     _         -> error "Test suite must be run on x86_64 or aarch64"++headerGoldens :: [(FilePath, FilePath)]+headerGoldens = [ ("test/examples/splitmix.kmp", "test/include/splitmix.h") ]  allGoldens :: [(FilePath, FilePath, FilePath)] allGoldens =
golden/Harness.hs view
@@ -12,7 +12,6 @@ import           System.Process             (CreateProcess (env, std_err), StdStream (Inherit), proc, readCreateProcess) import           Test.Tasty import           Test.Tasty.Golden          (goldenVsString)-import           Test.Tasty.HUnit           (assertBool, testCase)  data CC = CC         | ArmCC
kempe.cabal view
@@ -1,6 +1,6 @@ cabal-version:   3.0 name:            kempe-version:         0.2.0.8+version:         0.2.0.9 license:         BSD-3-Clause license-file:    LICENSE copyright:       Copyright: (c) 2020-2021 Vanessa McHale@@ -17,6 +17,7 @@     test/examples/*.kmp     test/golden/*.out     test/golden/*.ir+    test/include/*.h     test/harness/*.c     examples/*.kmp     prelude/*.kmp@@ -59,6 +60,7 @@         Kempe.Asm.Arm.Trans         Kempe.Asm.Arm.ControlFlow         Kempe.Asm.Arm.Linear+        Language.C.AST      hs-source-dirs:   src     other-modules:@@ -77,6 +79,7 @@         Kempe.Asm.Pretty         Kempe.IR.Type         Kempe.IR.Monad+        Kempe.CGen         Kempe.Proc.Nasm         Kempe.Proc.As         Kempe.Debug@@ -152,7 +155,8 @@         optparse-applicative,         kempe-modules,         prettyprinter >=1.7.0,-        bytestring+        bytestring,+        text      if impl(ghc >=8.0)         ghc-options:@@ -210,7 +214,10 @@     type:             exitcode-stdio-1.0     main-is:          Golden.hs     hs-source-dirs:   golden-    other-modules:    Harness+    other-modules:+        Harness+        CDecl+     default-language: Haskell2010     ghc-options:      -threaded -rtsopts "-with-rtsopts=-N -K1K" -Wall     build-depends:@@ -222,8 +229,9 @@         temporary,         filepath,         tasty-golden,-        tasty-hunit,-        extra+        extra,+        prettyprinter,+        text      if impl(ghc >=8.0)         ghc-options:
lib/numbertheory.kmp view
@@ -35,5 +35,5 @@ k_gcd : Int Int -- Int       =: [ gcd ] -%foreign cabi k_gcd-%foreign cabi is_prime+%foreign armabi k_gcd+%foreign armabi is_prime
run/Main.hs view
@@ -4,15 +4,17 @@ import           Control.Monad             ((<=<)) import qualified Data.ByteString.Lazy      as BSL import           Data.Semigroup            ((<>))+import qualified Data.Text.Lazy.IO         as TLIO import qualified Data.Version              as V import           Kempe.AST import           Kempe.File import           Kempe.Lexer import           Kempe.Parser+import           Language.C.AST import           Options.Applicative import qualified Paths_kempe               as P import           Prettyprinter             (LayoutOptions (LayoutOptions), PageWidth (AvailablePerLine), hardline, layoutSmart)-import           Prettyprinter.Render.Text (renderIO)+import           Prettyprinter.Render.Text (putDoc, renderIO, renderLazy) import           System.Exit               (ExitCode (ExitFailure), exitWith) import           System.IO                 (stdout) import           System.Info               (arch)@@ -24,7 +26,16 @@              | Compile !FilePath !(Maybe FilePath) !Arch !Bool !Bool !Bool              | Format !FilePath              | Lint !FilePath+             | CDecl !FilePath !(Maybe FilePath) +cdecl :: FilePath -> IO ()+cdecl = putDoc . (<> hardline) . prettyHeaders <=< cDeclFile++writeCDecl :: FilePath -> FilePath -> IO ()+writeCDecl fp o = do+    ds <- cDeclFile fp+    TLIO.writeFile o (renderLazy $ layoutSmart cSettings $ prettyHeaders ds)+ fmt :: FilePath -> IO () fmt = renderIO stdout <=< fmap (render . (<> hardline) . prettyModule) . parsedFp     where render = layoutSmart settings@@ -48,6 +59,8 @@ run (Compile fp Nothing X64 False False True)     = x86File fp run (Compile fp Nothing Aarch64 False False True) = armFile fp run (Format fp)                                   = fmt fp+run (CDecl fp Nothing)                            = cdecl fp+run (CDecl fp (Just o))                           = writeCDecl fp o run _                                             = putStrLn "Invalid combination of CLI options. Try kc --help" *> exitWith (ExitFailure 1)  kmpFile :: Parser FilePath@@ -62,6 +75,9 @@ lintP :: Parser Command lintP = Lint <$> kmpFile +cdeclP :: Parser Command+cdeclP = CDecl <$> kmpFile <*> outFile+ debugSwitch :: Parser Bool debugSwitch = switch     (long "debug"@@ -96,8 +112,8 @@     (long "dump-asm"     <> help "Write assembly (intel syntax) to stdout") -exeFile :: Parser (Maybe FilePath)-exeFile = optional $ argument str+outFile :: Parser (Maybe FilePath)+outFile = optional $ argument str     (metavar "OUTPUT"     <> help "File output") @@ -109,10 +125,11 @@     (command "typecheck" (info tcP (progDesc "Type-check module contents"))     <> command "lint" (info lintP (progDesc "Lint a file")))     <|> hsubparser (command "fmt" (info fmtP (progDesc "Pretty-print a Kempe file")) <> internal)+    <|> hsubparser (command "cdecl" (info cdeclP (progDesc "Generate C headers for exported Kempe code")))     <|> compileP     where         tcP = TypeCheck <$> kmpFile-        compileP = Compile <$> kmpFile <*> exeFile <*> archFlag <*> debugSwitch <*> irSwitch <*> asmSwitch+        compileP = Compile <$> kmpFile <*> outFile <*> archFlag <*> debugSwitch <*> irSwitch <*> asmSwitch  wrapper :: ParserInfo Command wrapper = info (helper <*> versionMod <*> commandP)
src/Kempe/AST/Size.hs view
@@ -69,11 +69,15 @@  data ABI = Cabi          | Kabi+         | Hooked+         | ArmAbi          deriving (Eq, Ord, Generic, NFData)  instance Pretty ABI where-    pretty Cabi = "cabi"-    pretty Kabi = "kabi"+    pretty Cabi   = "cabi"+    pretty Kabi   = "kabi"+    pretty Hooked = "hooked"+    pretty ArmAbi = "armabi"  -- machinery for assigning a constructor to a function of its concrete types -- (and then curry forward...)
src/Kempe/Asm/Arm/Trans.hs view
@@ -4,13 +4,16 @@                            ) where  import           Data.Bits          (rotateR, (.&.))+import qualified Data.ByteString    as BS import           Data.Foldable.Ext  (foldMapA) import           Data.Int           (Int64) import           Data.List          (scanl')+import           Data.Semigroup     ((<>)) import           Kempe.AST.Size import           Kempe.Asm.Arm.Type import           Kempe.IR.Monad import qualified Kempe.IR.Type      as IR+import           System.Info        (arch, os)  irToAarch64 :: SizeEnv -> IR.WriteSt -> [IR.Stmt] -> [Arm AbsReg ()] irToAarch64 env w = runWriteM w . foldMapA (irEmit env)@@ -36,18 +39,33 @@ popLink :: [Arm AbsReg ()] popLink = [Load () LinkReg (Reg StackPtr), AddRC () StackPtr StackPtr 16] +-- darwin on arm requires _ prepended to export+darwinExport :: BS.ByteString -> BS.ByteString+darwinExport = case (os, arch) of+    ("darwin", "aarch64") -> ("_" <>)+    _                     -> id+ irEmit :: SizeEnv -> IR.Stmt -> WriteM [Arm AbsReg ()] irEmit _ (IR.Jump l)                    = pure [Branch () l] irEmit _ IR.Ret                         = pure [Ret ()] irEmit _ (IR.KCall l)                   = pure (pushLink ++ BranchLink () l : popLink) -- TODO: think more? irEmit _ (IR.Labeled l)                 = pure [Label () l]-irEmit _ (IR.WrapKCall Kabi (_, _) n l) = pure $ [BSLabel () n] ++ pushLink ++ [BranchLink () l] ++ popLink ++ [Ret ()]+irEmit _ (IR.WrapKCall Kabi (_, _) n l) = pure $ [BSLabel () (darwinExport n)] ++ pushLink ++ [BranchLink () l] ++ popLink ++ [Ret ()]+irEmit _ (IR.WrapKCall Hooked (_, _) n l) =+    pure $ [MovRR () DataPointer CArg0, BSLabel () n] ++ pushLink ++ [BranchLink () l] ++ popLink ++ [Ret ()] irEmit env (IR.WrapKCall Cabi (is, [o]) n l) | all (\i -> size' env i <= 8) is && size' env o <= 8 && length is <= 8 = do     { let sizes = fmap (size' env) is     ; let offs = scanl' (+) 0 sizes     ; let totalSize = sizeStack env is     ; let argRegs = [CArg0, CArg1, CArg2, CArg3, CArg4, CArg5, CArg6, CArg7]-    ; pure $ [BSLabel () n] ++ pushLink ++ [LoadLabel () DataPointer "kempe_data", GnuMacro () "calleesave"] ++ zipWith3 (\r sz i -> storeSize sz r (AddRCPlus DataPointer i)) argRegs sizes offs ++ [AddRC () DataPointer DataPointer totalSize, BranchLink () l, loadSize (size' env o) CArg0 (AddRCPlus DataPointer (negate $ size' env o)), GnuMacro () "calleerestore"] ++ popLink ++ [Ret ()]+    ; pure $ [BSLabel () (darwinExport n)] ++ pushLink ++ [LoadLabel () DataPointer "kempe_data", GnuMacro () "calleesave"] ++ zipWith3 (\r sz i -> storeSize sz r (AddRCPlus DataPointer i)) argRegs sizes offs ++ [AddRC () DataPointer DataPointer totalSize, BranchLink () l, loadSize (size' env o) CArg0 (AddRCPlus DataPointer (negate $ size' env o)), GnuMacro () "calleerestore"] ++ popLink ++ [Ret ()]+    }+irEmit env (IR.WrapKCall ArmAbi (is, [o]) n l) | all (\i -> size' env i <= 8) is && size' env o <= 8 && length is <= 8 = do+    { let sizes = fmap (size' env) is+    ; let offs = scanl' (+) 0 sizes+    ; let totalSize = sizeStack env is+    ; let argRegs = [CArg1, CArg2, CArg3, CArg4, CArg5, CArg6, CArg7]+    ; pure $ [BSLabel () (darwinExport n)] ++ pushLink ++ [MovRR () DataPointer CArg0, GnuMacro () "calleesave"] ++ zipWith3 (\r sz i -> storeSize sz r (AddRCPlus DataPointer i)) argRegs sizes offs ++ [AddRC () DataPointer DataPointer totalSize, BranchLink () l, loadSize (size' env o) CArg0 (AddRCPlus DataPointer (negate $ size' env o)), GnuMacro () "calleerestore"] ++ popLink ++ [Ret ()]     } irEmit _ (IR.MovMem (IR.Reg r) 8 (IR.Reg r')) =     pure [Store () (toAbsReg r') (Reg $ toAbsReg r)]
src/Kempe/Asm/X86/Trans.hs view
@@ -127,8 +127,16 @@     ; let argRegs = [CArg1, CArg2, CArg3, CArg4, CArg5, CArg6]     ; pure $ [BSLabel () n, MovRL () DataPointer "kempe_data", NasmMacro0 () "calleesave"] ++ zipWith (\r i-> MovAR () (AddrRCPlus DataPointer i) r) argRegs offs ++ [AddRC () DataPointer totalSize, Call () l, MovRA () CRet (AddrRCMinus DataPointer (size' env o)), NasmMacro0 () "calleerestore", Ret ()] -- TODO: bytes on the stack eh     }+irEmit env (IR.WrapKCall ArmAbi (is, [o]) n l) | all (\i -> size' env i <= 8) is && size' env o <= 8 && length is <= 6 = do+    { let offs = scanl' (+) 0 (fmap (size' env) is)+    ; let totalSize = sizeStack env is+    ; let argRegs = [CArg2, CArg3, CArg4, CArg5, CArg6]+    ; pure $ [BSLabel () n, MovRR () DataPointer CArg1, NasmMacro0 () "calleesave"] ++ zipWith (\r i-> MovAR () (AddrRCPlus DataPointer i) r) argRegs offs ++ [AddRC () DataPointer totalSize, Call () l, MovRA () CRet (AddrRCMinus DataPointer (size' env o)), NasmMacro0 () "calleerestore", Ret ()] -- TODO: bytes on the stack eh+    } irEmit _ (IR.WrapKCall Kabi (_, _) n l) =     pure [BSLabel () n, Call () l, Ret ()]+irEmit _ (IR.WrapKCall Hooked (_, _) n l) =+    pure [MovRR () DataPointer CArg1, BSLabel () n, Call () l, Ret ()] irEmit _ (IR.MovMem (IR.Reg r) _ (IR.ConstInt8 i)) =     pure [ MovACi8 () (Reg $ toAbsReg r) i ]     -- see: https://github.com/cirosantilli/x86-assembly-cheat/blob/master/x86-64/movabs.asm for why we don't do this ^ for words
+ src/Kempe/CGen.hs view
@@ -0,0 +1,36 @@+module Kempe.CGen ( cGen+                  ) where++import           Data.Maybe     (mapMaybe)+import           Kempe.AST+import           Kempe.Name+import           Language.C.AST++cGen :: Declarations a c (StackType ()) -> [CFunc]+cGen = mapMaybe cDecl++cDecl :: KempeDecl a c (StackType ()) -> Maybe CFunc+cDecl ExtFnDecl{}                                        = Nothing+cDecl TyDecl{}                                           = Nothing+cDecl FunDecl{}                                          = Nothing+cDecl (Export _ Cabi (Name n _ (StackType _ [] [])))     = Just (CFunc n [CVoid] CVoid)+cDecl (Export _ Cabi (Name n _ (StackType _ [] [o])))    = Just (CFunc n [CVoid] (kempeTyToCType o))+cDecl (Export _ Cabi (Name n _ (StackType _ ins [])))    = Just (CFunc n (kempeTyToCType <$> ins) CVoid)+cDecl (Export _ Cabi (Name n _ (StackType _ ins [o])))   = Just (CFunc n (kempeTyToCType <$> ins) (kempeTyToCType o))+cDecl (Export _ Cabi _)                                  = error "Multiple return not suppported :("+cDecl (Export _ ArmAbi (Name n _ (StackType _ [] [])))   = Just (CFunc n [CVoidPtr] CVoid)+cDecl (Export _ ArmAbi (Name n _ (StackType _ [] [o])))  = Just (CFunc n [CVoidPtr] (kempeTyToCType o))+cDecl (Export _ ArmAbi (Name n _ (StackType _ ins [])))  = Just (CFunc n (CVoidPtr : fmap kempeTyToCType ins) CVoid)+cDecl (Export _ ArmAbi (Name n _ (StackType _ ins [o]))) = Just (CFunc n (CVoidPtr : fmap kempeTyToCType ins) (kempeTyToCType o))+cDecl (Export _ ArmAbi _)                                = error "Multiple return not suppported :("+cDecl (Export _ Hooked (Name n _ _))                     = Just (CFunc n [CVoidPtr] CVoid)+cDecl (Export _ Kabi _)                                  = error "You probably don't want to do this."++kempeTyToCType :: KempeTy a -> CType+kempeTyToCType (TyBuiltin _ TyInt)  = CInt+kempeTyToCType (TyBuiltin _ TyBool) = CBool+kempeTyToCType (TyBuiltin _ TyWord) = CUInt64+kempeTyToCType (TyBuiltin _ TyInt8) = CInt8+kempeTyToCType TyVar{}              = error "Don't do that"+kempeTyToCType TyApp{}              = error "User-defined types cannot be exported :("+kempeTyToCType TyNamed{}            = error "User-defined types cannot be exported :("
src/Kempe/File.hs view
@@ -2,6 +2,8 @@                   , warnFile                   , dumpMono                   , dumpTyped+                  , dumpCDecl+                  , cDeclFile                   , irFile                   , x86File                   , armFile@@ -16,6 +18,7 @@ import           Control.Applicative       ((<|>)) import           Control.Composition       ((.*)) import           Control.Exception         (Exception, throwIO)+import           Control.Monad             ((<=<)) import           Data.Bifunctor            (bimap) import           Data.Functor              (void) import           Data.Semigroup            ((<>))@@ -25,6 +28,7 @@ import           Kempe.AST import qualified Kempe.Asm.Arm.Type        as Arm import qualified Kempe.Asm.X86.Type        as X86+import           Kempe.CGen import           Kempe.Check.Lint import           Kempe.Check.Pattern import           Kempe.Check.TopLevel@@ -37,6 +41,7 @@ import qualified Kempe.Proc.Nasm           as Nasm import           Kempe.Shuttle import           Kempe.TyAssign+import           Language.C.AST import           Prettyprinter             (Doc, hardline) import           Prettyprinter.Render.Text (putDoc) @@ -54,6 +59,15 @@  yeetIO :: Exception e => Either e a -> IO a yeetIO = either throwIO pure++cDeclFile :: FilePath -> IO [CFunc]+cDeclFile fp = do+    (i, m) <- parseProcess fp+    (mTyped, _) <- yeetIO $ runTypeM i (assignModule m)+    pure $ cGen mTyped++dumpCDecl :: FilePath -> IO ()+dumpCDecl = putDoc . prettyHeaders <=< cDeclFile  dumpTyped :: FilePath -> IO () dumpTyped fp = do
src/Kempe/Lexer.x view
@@ -111,6 +111,8 @@         "%foreign"               { mkKw KwForeign }         "cabi"                   { mkKw KwCabi }         "kabi"                   { mkKw KwKabi }+        "hooked"                 { mkKw KwHooked }+        "armabi"                 { mkKw KwArmAbi }          -- builtin         dip                      { mkBuiltin BuiltinDip }@@ -288,6 +290,8 @@              | KwForeign              | KwCabi              | KwKabi+             | KwHooked+             | KwArmAbi              deriving (Generic, NFData)  instance Pretty Keyword where@@ -299,6 +303,8 @@     pretty KwForeign = "%foreign"     pretty KwCabi    = "cabi"     pretty KwKabi    = "kabi"+    pretty KwHooked  = "hooked"+    pretty KwArmAbi  = "armabi"  data Builtin = BuiltinBool              | BuiltinBoolLit { bool :: !Bool }
src/Kempe/Parser.y view
@@ -89,6 +89,8 @@     foreign { TokKeyword $$ KwForeign }     cabi { TokKeyword $$ KwCabi }     kabi { TokKeyword $$ KwKabi }+    hooked { TokKeyword $$ KwHooked }+    armabi { TokKeyword $$ KwArmAbi }     import { TokKeyword $$ KwImport }      dip { TokBuiltin $$ BuiltinDip }@@ -139,6 +141,8 @@ ABI :: { ABI }     : cabi { Cabi }     | kabi { Kabi }+    | hooked { Hooked }+    | armabi { ArmAbi }  Decl :: { KempeDecl AlexPosn AlexPosn AlexPosn }      : TyDecl { $1 }
+ src/Language/C/AST.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}++module Language.C.AST ( CType (..)+                      , CFunc (..)+                      , prettyHeaders+                      , cSettings+                      ) where++import           Data.Semigroup    ((<>))+import qualified Data.Set          as S+import qualified Data.Text         as T+import           Prettyprinter     (Doc, LayoutOptions (..), PageWidth (..), Pretty (..), tupled, (<+>))+import           Prettyprinter.Ext++cSettings :: LayoutOptions+cSettings = LayoutOptions $ AvailablePerLine 180 0.8++data CHeader = StdBool -- ^ @stdbool.h@+             | StdInt -- ^ @stdint.h@+             deriving (Eq, Ord)++prettyInclude :: CHeader -> Doc ann+prettyInclude StdBool = "#include <stdbool.h>"+prettyInclude StdInt  = "#include <stdint.h>"++data CType = CInt+           | CBool+           | CUInt64+           | CInt8+           | CVoid+           | CVoidPtr+           -- ADTs etc.++data CFunc = CFunc !T.Text [CType] CType++prettyHeaders :: [CFunc] -> Doc ann+prettyHeaders es =+    let hs = foldMap mentionedFunc es+        in prettyLines (fmap prettyInclude (S.toList hs))+            <#> prettyLines (fmap pretty es)++mentioned :: CType -> S.Set CHeader+mentioned CInt     = mempty+mentioned CBool    = S.singleton StdBool+mentioned CUInt64  = S.singleton StdInt+mentioned CVoid    = mempty+mentioned CVoidPtr = mempty+mentioned CInt8    = S.singleton StdInt++mentionedFunc :: CFunc -> S.Set CHeader+mentionedFunc (CFunc _ args ret) = foldMap mentioned (ret : args)++instance Pretty CType where+    pretty CInt     = "int"+    pretty CBool    = "bool"+    pretty CUInt64  = "uint64_t"+    pretty CVoid    = "void"+    pretty CVoidPtr = "void*"+    pretty CInt8    = "int8_t"++instance Pretty CFunc where+    pretty (CFunc fname args retType) = "extern" <+> pretty retType <+> pretty fname <+> tupled (pretty <$> args) <> ";"
test/examples/bool.kmp view
@@ -15,5 +15,5 @@ nor : Bool Bool -- Bool     =: [ || not ] -%foreign cabi not-%foreign cabi eq+%foreign armabi not+%foreign armabi eq
test/examples/const.kmp view
@@ -1,4 +1,4 @@ id_int : Int -- Int        =: [ ] -%foreign cabi id_int+%foreign armabi id_int
test/examples/splitmix.kmp view
@@ -8,4 +8,4 @@ from_seed : Word -- Word           =: [ next dip(drop) ] -%foreign cabi from_seed+%foreign armabi from_seed
test/harness/bool.c view
@@ -1,11 +1,13 @@ #include <stdbool.h> #include <stdio.h>+#include <stdlib.h> -extern bool not(bool);-extern bool eq(bool, bool);+extern bool not(void*, bool);+extern bool eq(void*, bool, bool);  int main(int argc, char *argv[]) {-    printf("%d\n", not(true));-    printf("%d\n", not(false));-    printf("%d", eq(true, false));+    void* kptr = malloc(32 * 1024);+    printf("%d\n", not(kptr, true));+    printf("%d\n", not(kptr, false));+    printf("%d", eq(kptr, true, false)); }
test/harness/const.c view
@@ -1,7 +1,9 @@ #include <stdio.h>+#include <stdlib.h> -extern int id_int(int);+extern int id_int(void*, int);  int main(int argc, char *argv[]) {-    printf("%d", id_int(3));+    void* kptr = malloc(32 * 1024);+    printf("%d", id_int(kptr, 3)); }
test/harness/factorial.c view
@@ -1,9 +1,11 @@ #include <stdio.h>+#include <stdlib.h> -extern int fac_tailrec(int);-extern int fac(int);+extern int fac_tailrec(void*, int);+extern int fac(void*, int);  int main(int argc, char *argv[]) {-    printf("%d\n", fac_tailrec(3));-    printf("%d", fac(3));+    void* kptr = malloc(32 * 1024);+    printf("%d\n", fac_tailrec(kptr, 3));+    printf("%d", fac(kptr, 3)); }
test/harness/numbertheory.c view
@@ -1,11 +1,13 @@ #include <stdbool.h> #include <stdio.h>+#include <stdlib.h> -extern int k_gcd(int, int);-extern bool is_prime(int);+extern int k_gcd(void*, int, int);+extern bool is_prime(void*, int);  int main(int argc, char *argv[]) {-    printf("%d\n", is_prime(37));-    printf("%d\n", is_prime(36));-    printf("%d", k_gcd(21, 35));+    void* kptr = malloc(32 * 1024);+    printf("%d\n", is_prime(kptr, 37));+    printf("%d\n", is_prime(kptr, 36));+    printf("%d", k_gcd(kptr, 21, 35)); }
test/harness/splitmix.c view
@@ -1,8 +1,10 @@ #include <stdint.h> #include <stdio.h>+#include <stdlib.h> -extern uint64_t from_seed(uint64_t);+extern uint64_t from_seed(void*, uint64_t);  int main(int argc, char *argv[]) {-    printf("%u", (unsigned int) from_seed(3012512025));+    void* kptr = malloc(32 * 1024);+    printf("%u", (unsigned int) from_seed(kptr, 3012512025)); }
+ test/include/splitmix.h view
@@ -0,0 +1,2 @@+#include <stdint.h>+extern uint64_t from_seed (void*, uint64_t);