Don't like ads? PRO users don't see any ads ;-)
Guest

Untitled

By: a guest on May 2nd, 2012  |  syntax: None  |  size: 1.20 KB  |  hits: 13  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. withArgsM :: Monad m
  2.           => Expression
  3.           -> (forall a . StructFields a => a -> m s)
  4.           -> m s
  5. withArgsM exp f = inner vars f where
  6.   vars = nub [ x :: Factor | x <- universeBi exp ]
  7.   inner :: Monad m => [Factor] -> (forall a . StructFields a => a -> m s) -> m s
  8.   inner (x:xs) f = inner xs (\ x  -> f ((undefined::Double) & x))
  9.   inner []     f = f ()
  10.  
  11. genModule :: forall a . StructFields a
  12.          => Expression
  13.          -> a
  14.          -> CodeGenModule (Function (Int32 -> Ptr Int8 -> IO Double))
  15. genModule exp _ = createFunction ExternalLinkage (go exp) where
  16.   go exp idx args = do
  17.     c :: Value (Ptr (Struct a)) <- bitcast args
  18.     -- val :: Value (Ptr Double) <- getElementPtr c (0::Int32, (0::Int32, ())) ??
  19.     val :: Value (Ptr Double) <- unsafeGetElementPtr c [0::Int32, 0]
  20.     val' <- load val
  21.     ret val'
  22.  
  23. compileExpression :: Expression -> IO (FunPtr (Int32 -> Ptr Int8 -> IO Double))
  24. compileExpression exp = withArgsM exp fun where
  25.   fun :: forall a . StructFields a => a -> IO (FunPtr (Int32 -> Ptr Int8 -> IO Double))
  26.   fun a = do
  27.      m <- newModule
  28.      fun <- defineModule m (genModule exp a)
  29.      dumpValue fun
  30.      runEngineAccess $ do
  31.        addModule m
  32.        getPointerToFunction fun