gistfile1.hs

withArgsM :: Monad m
          => Expression
          -> (forall a . StructFields a => a -> m s)
          -> m s
withArgsM exp f = inner vars f where
  vars = nub [ x :: Factor | x <- universeBi exp ]
  inner :: Monad m => [Factor] -> (forall a . StructFields a => a -> m s) -> m s
  inner (x:xs) f = inner xs (\ x  -> f ((undefined::Double) & x))
  inner []     f = f ()

genModule :: forall a . StructFields a
         => Expression
         -> a
         -> CodeGenModule (Function (Int32 -> Ptr Int8 -> IO Double))
genModule exp _ = createFunction ExternalLinkage (go exp) where
  go exp idx args = do
    c :: Value (Ptr (Struct a)) <- bitcast args
    -- val :: Value (Ptr Double) <- getElementPtr c (0::Int32, (0::Int32, ())) ??
    val :: Value (Ptr Double) <- unsafeGetElementPtr c [0::Int32, 0]
    val' <- load val
    ret val'

compileExpression :: Expression -> IO (FunPtr (Int32 -> Ptr Int8 -> IO Double))
compileExpression exp = withArgsM exp fun where
  fun :: forall a . StructFields a => a -> IO (FunPtr (Int32 -> Ptr Int8 -> IO Double))
  fun a = do
     m <- newModule
     fun <- defineModule m (genModule exp a)
     dumpValue fun
     runEngineAccess $ do
       addModule m
       getPointerToFunction fun