https://csl.name/post/python-jit but in haskell

Main.hs

{-# LANGUAGE ForeignFunctionInterface #-}
module Main where

import qualified System.Posix.Memory as M
import qualified System.Posix.Types  as P
import qualified Foreign             as F
import qualified Foreign.C           as F
import qualified Foreign.C.Error     as F
import qualified Foreign.Storable    as F
import           System.IO.Error
import           Data.Bits

-- with no error handling whatsoever
main :: IO ()
main = do
  let pageSize = fromIntegral M.sysconfPageSize
  blk <- createBlock pageSize
  mkMultiplier blk 101
  f <- mkExec blk pageSize
  let res = f 9
  print res
  M.memoryUnmap blk pageSize


type Block = F.Ptr F.CChar
type MulFun = F.CLong -> F.CLong
foreign import ccall "dynamic"
  mkFun :: F.FunPtr MulFun -> MulFun

createBlock :: F.CSize -> IO Block
createBlock size = 
  M.memoryMap Nothing size 
    [M.MemoryProtectionWrite, M.MemoryProtectionRead]
    M.MemoryMapPrivate Nothing (P.COff 0)

mkExec :: Block -> F.CSize -> IO MulFun
mkExec blk size = do
  M.memoryProtect blk size 
    [ M.MemoryProtectionRead
    , M.MemoryProtectionExecute
    ]
  let fptr = F.castPtrToFunPtr blk
  pure $ mkFun fptr

mkMultiplier :: Block -> Int -> IO ()
mkMultiplier blk mul = do
  write 0 0x48
  write 1 0xb8

  write 2 $ fromIntegral $ (mul .&. 0x00000000000000ff) `shiftR` 0
  write 3 $ fromIntegral $ (mul .&. 0x000000000000ff00) `shiftR` 8
  write 4 $ fromIntegral $ (mul .&. 0x0000000000ff0000) `shiftR` 16
  write 5 $ fromIntegral $ (mul .&. 0x00000000ff000000) `shiftR` 24
  write 6 $ fromIntegral $ (mul .&. 0x000000ff00000000) `shiftR` 32
  write 7 $ fromIntegral $ (mul .&. 0x0000ff0000000000) `shiftR` 40
  write 8 $ fromIntegral $ (mul .&. 0x00ff000000000000) `shiftR` 48
  write 9 $ fromIntegral $ (mul .&. 0xff00000000000000) `shiftR` 56

  write 10 0x48
  write 11 0x0f
  write 12 0xaf
  write 13 0xc7

  write 14 0xc3

    where
      write :: Int -> F.CChar -> IO ()
      write = F.pokeByteOff blk