diff options
Diffstat (limited to 'src/Compile.hs')
| -rw-r--r-- | src/Compile.hs | 35 | 
1 files changed, 23 insertions, 12 deletions
diff --git a/src/Compile.hs b/src/Compile.hs index f2063ee..bf7817a 100644 --- a/src/Compile.hs +++ b/src/Compile.hs @@ -8,7 +8,7 @@  {-# LANGUAGE PolyKinds #-}  {-# LANGUAGE TupleSections #-}  {-# LANGUAGE TypeApplications #-} -module Compile (compile) where +module Compile (compile, compileStderr) where  import Control.Applicative (empty)  import Control.Monad (forM_, when, replicateM) @@ -71,28 +71,30 @@ debugAllocs :: Bool; debugAllocs = toEnum 0  -- | Emit extra C code that checks stuff  emitChecks :: Bool; emitChecks = toEnum 0 +-- | Returns compiled function plus compilation output (warnings)  compile :: SList STy env -> Ex env t -        -> IO (SList Value env -> IO (Rep t)) +        -> IO (SList Value env -> IO (Rep t), String)  compile = \env expr -> do    codeID <- atomicModifyIORef' uniqueIdGenRef (\i -> (i + 1, i))    let (source, offsets) = compileToString codeID env expr    when debugPrintAST $ hPutStrLn stderr $ "Compiled AST: <<<\n" ++ ppExpr env expr ++ "\n>>>"    when debugCSource $ hPutStrLn stderr $ "Generated C source: <<<\n\x1B[2m" ++ lineNumbers source ++ "\x1B[0m>>>" -  lib <- buildKernel source "kernel" +  (lib, compileOutput) <- buildKernel source "kernel"    let result_type = typeOf expr        result_size = sizeofSTy result_type -  return $ \val -> do -    allocaBytes (koResultOffset offsets + result_size) $ \ptr -> do -      let args = zip (reverse (unSList Some (slistZip env val))) (koArgOffsets offsets) -      serialiseArguments args ptr $ do -        callKernelFun lib ptr -        ok <- peekByteOff @Word8 ptr (koOkResOffset offsets) -        when (ok /= 1) $ -          ioError (mkIOError userErrorType "fatal error detected during chad kernel execution (memory has been leaked)" Nothing Nothing) -        deserialise result_type ptr (koResultOffset offsets) +  let function val = do +        allocaBytes (koResultOffset offsets + result_size) $ \ptr -> do +          let args = zip (reverse (unSList Some (slistZip env val))) (koArgOffsets offsets) +          serialiseArguments args ptr $ do +            callKernelFun lib ptr +            ok <- peekByteOff @Word8 ptr (koOkResOffset offsets) +            when (ok /= 1) $ +              ioError (mkIOError userErrorType "fatal error detected during chad kernel execution (memory has been leaked)" Nothing Nothing) +            deserialise result_type ptr (koResultOffset offsets) +  return (function, compileOutput)    where      serialiseArguments :: [(Some (Product STy Value), Int)] -> Ptr () -> IO r -> IO r      serialiseArguments ((Some (Product.Pair t (Value arg)), off) : args) ptr k = @@ -100,6 +102,15 @@ compile = \env expr -> do          serialiseArguments args ptr k      serialiseArguments _ _ k = k +-- | 'compile', but writes any produced C compiler output to stderr. +compileStderr :: SList STy env -> Ex env t +              -> IO (SList Value env -> IO (Rep t)) +compileStderr env expr = do +  (fun, output) <- compile env expr +  when (not (null output)) $ +    hPutStrLn stderr $ "[chad] Kernel compilation GCC output: <<<\n" ++ output ++ ">>>" +  return fun +  data StructDecl = StructDecl      String  -- ^ name  | 
