inline-asm (empty) → 0.1.0.0

raw patch · 8 files changed

+190/−0 lines, 8 filesdep +basedep +ghc-primdep +inline-asmsetup-changed

Dependencies added: base, ghc-prim, inline-asm, template-haskell, uniplate

Files

• ChangeLog.md +3/−0
• LICENSE +30/−0
• README.md +6/−0
• Setup.hs +2/−0
• app/Main.hs +11/−0
• inline-asm.cabal +74/−0
• src/Language/Asm/Inline.hs +62/−0
• test/Spec.hs +2/−0

@@ -0,0 +1,3 @@+# Changelog for inline-asm++## Unreleased changes

@@ -0,0 +1,30 @@+Copyright Georg Rudoy (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Georg Rudoy nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,6 @@+# inline-asm++_When inline C is too safe_.++Did you try `inline-c`, but it's not enough? You need more? Nothing seems to satisfy?+`inline-asm` to the rescue!

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,11 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE GHCForeignImportPrim, UnliftedFFITypes #-}++module Main where++import Language.Asm.Inline++defineAsmFun "foobar" [t| Word -> Word |] "add %rbx, %rbx"++main :: IO ()+main = print $ foobar 21

@@ -0,0 +1,74 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: e27b467c99b6f79a5aa43f7fbfa55f44eca8495e93b7a08b9c9ce2a09d17cbd0++name:           inline-asm+version:        0.1.0.0+synopsis:       Inline some Assembly in ur Haskell!+description:    Please see the README on GitHub at <https://github.com/0xd34df00d/inline-asm#readme>+category:       FFI+homepage:       https://github.com/0xd34df00d/inline-asm#readme+bug-reports:    https://github.com/0xd34df00d/inline-asm/issues+author:         Georg Rudoy+maintainer:     0xd34df00d@gmail.com+copyright:      2020 Georg Rudoy+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/0xd34df00d/inline-asm++library+  exposed-modules:+      Language.Asm.Inline+  other-modules:+      Paths_inline_asm+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base >=4.7 && <5+    , ghc-prim+    , template-haskell >=2.15.0.0+    , uniplate+  default-language: Haskell2010++executable inline-asm-exe+  main-is: Main.hs+  other-modules:+      Paths_inline_asm+  hs-source-dirs:+      app+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , ghc-prim+    , inline-asm+    , template-haskell >=2.15.0.0+    , uniplate+  default-language: Haskell2010++test-suite inline-asm-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_inline_asm+  hs-source-dirs:+      test+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , ghc-prim+    , inline-asm+    , template-haskell >=2.15.0.0+    , uniplate+  default-language: Haskell2010

@@ -0,0 +1,62 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, FunctionalDependencies #-}+{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies #-}+{-# LANGUAGE TemplateHaskell #-}++module Language.Asm.Inline where++import Control.Monad+import Data.Generics.Uniplate.Data+import GHC.Prim+import GHC.Types hiding (Type)+import Language.Haskell.TH+import Language.Haskell.TH.Syntax++class AsmArg a (rep :: RuntimeRep) (uty :: TYPE rep) | a -> rep, a -> uty where+  unbox :: a -> uty+  rebox :: uty -> a++instance AsmArg Int 'IntRep Int# where+  unbox (I# w) = w+  rebox = I#++instance AsmArg Word 'WordRep Word# where+  unbox (W# w) = w+  rebox = W#++defineAsmFun :: String -> Q Type -> String -> Q [Dec]+defineAsmFun name funTyQ asmCode = do+  addForeignSource LangAsm $ unlines [ ".global " <> asmName+                                     , asmName <> ":"+                                     , asmCode+                                     , "jmp *(%rbp)"+                                     ]+  funTy <- funTyQ+  let importedName = mkName asmName+  wrapperFunD <- mkFunD name importedName funTy+  pure+    [ ForeignD $ ImportF Prim Safe asmName importedName $ unliftType funTy+    , SigD (mkName name) funTy+    , wrapperFunD+    ]+  where+    asmName = name <> "_unlifted"++mkFunD :: String -> Name -> Type -> Q Dec+mkFunD funName importedName funTy = do+  argNames <- replicateM (countArgs funTy) $ newName "arg"+  funAppE <- foldM f (VarE importedName) argNames+  body <- [e| rebox $(pure funAppE) |]+  pure $ FunD (mkName funName) [Clause (VarP <$> argNames) (NormalB body) []]+  where+    f acc argName = [e| $(pure acc) (unbox $(pure $ VarE argName)) |]++unliftType :: Type -> Type+unliftType = transformBi f+  where+    f x | x == ''Word = ''Word#+        | x == ''Int = ''Int#+        | otherwise = x++countArgs :: Type -> Int+countArgs ty = length [ () | ConT _ <- universeBi ty ] - 1

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"