3 files changed, 54 insertions(+), 32 deletions(-)

M CMakeLists.txt
M src/Compiler/GenLLVMIR.idr
A src/Compiler/LLVM/Rapid/Closure.idr

@@ 14,6 14,7 @@ add_idris_package(rapid-lite rapid-lite.ipkg
   src/Compiler/LLVM/Instruction.idr
   src/Compiler/LLVM/IR.idr
   src/Compiler/LLVM/Rapid/Builtin.idr
+  src/Compiler/LLVM/Rapid/Closure.idr
   src/Compiler/LLVM/Rapid/Foreign.idr
   src/Compiler/LLVM/Rapid/Integer.idr
   src/Compiler/LLVM/Rapid/Object.idr


@@ 38,6 39,7 @@ add_idris_package(rapidc rapidc.ipkg
   src/Compiler/LLVM/Instruction.idr
   src/Compiler/LLVM/IR.idr
   src/Compiler/LLVM/Rapid/Builtin.idr
+  src/Compiler/LLVM/Rapid/Closure.idr
   src/Compiler/LLVM/Rapid/Foreign.idr
   src/Compiler/LLVM/Rapid/Integer.idr
   src/Compiler/LLVM/Rapid/Object.idr

@@ 11,6 11,7 @@ import Compiler.CompileExpr
 import Compiler.VMCode
 import Compiler.LLVM.IR
 import Compiler.LLVM.Instruction
+import Compiler.LLVM.Rapid.Closure
 import Compiler.LLVM.Rapid.Integer
 import Compiler.LLVM.Rapid.Builtin
 import Compiler.LLVM.Rapid.Foreign


@@ 28,13 29,6 @@ import Rapid.Common
 -- we provide our own in Data.Utils
 %hide Core.Name.Namespace.showSep
 
-CLOSURE_MAX_ARGS : Int
-CLOSURE_MAX_ARGS = 1024
-
--- A "fat" closure is always invoked via its "closure entry" function
-FAT_CLOSURE_LIMIT : Int
-FAT_CLOSURE_LIMIT = 8
-
 ToIR Reg where
   toIR (Loc i) = "%v" ++ show i
   toIR RVal = "%rval"


@@ 907,32 901,9 @@ getInstIR {conNames} (MKCON r (Right n) args) = do
          store obj (reg2val r)
        Nothing => addError $ "MKCON name not found: " ++ show n
 
-getInstIR (MKCLOSURE r n missingN []) = do
-  let staticClosureObj = SSA IRObjPtr $ "bitcast ({i64, %FuncPtr} addrspace(1)* @\{safeName n}$$closureNoArgs to %ObjPtr)"
-  store staticClosureObj (reg2val r)
-
 getInstIR (MKCLOSURE r n missingN args) = do
-  let missing = cast {to=Int} missingN
-  let len = cast {to=Int} $ length args
-  let totalArgsExpected = missing + len
-  if totalArgsExpected > (cast CLOSURE_MAX_ARGS) then addError $ "ERROR : too many closure arguments: " ++ show totalArgsExpected ++ " > " ++ show CLOSURE_MAX_ARGS else do
-  let header = constHeader OBJECT_TYPE_ID_CLOSURE (cast ((missing * 0x10000) + len))
-  newObj <- dynamicAllocate (Const I64 $ cast (8 + 8 * len))
-  putObjectHeader newObj header
-  funcPtr <- (if (totalArgsExpected <= (cast FAT_CLOSURE_LIMIT))
-             then
-               assignSSA $ "bitcast %FuncPtrArgs" ++ show totalArgsExpected ++ " @" ++ (safeName n) ++ " to %FuncPtr"
-             else do
-               assignSSA $ "bitcast %FuncPtrClosureEntry @" ++ (safeName n) ++ "$$closureEntry to %FuncPtr"
-               )
-
-  putObjectSlot newObj (Const I64 0) (SSA FuncPtr funcPtr)
-  for_ (enumerate args) (\iv => do
-      let (i, arg) = iv
-      argObj <- load {t=IRObjPtr} (reg2val arg)
-      putObjectSlot newObj (Const I64 $ cast $ i+1) argObj
-      pure ()
-                              )
+  argsV <- traverse prepareArg args
+  newObj <- mkClosure n missingN argsV
   store newObj (reg2val r)
 
 getInstIR (APPLY r fun arg) = do

@@ 0,0 1,49 @@
+module Compiler.LLVM.Rapid.Closure
+
+import Core.Name
+
+import Compiler.LLVM.IR
+import Compiler.LLVM.Instruction
+import Compiler.LLVM.Rapid.Object
+import Control.Codegen
+import Data.Utils
+
+-- A "fat" closure is always invoked via its "closure entry" function
+export
+FAT_CLOSURE_LIMIT : Int
+FAT_CLOSURE_LIMIT = 8
+
+CLOSURE_MAX_ARGS : Int
+CLOSURE_MAX_ARGS = 1024
+
+export
+mkClosure : Name -> Nat -> List (IRValue IRObjPtr) -> Codegen (IRValue IRObjPtr)
+mkClosure n missingN [] =
+  pure $ SSA IRObjPtr $ "bitcast ({i64, %FuncPtr} addrspace(1)* @\{safeName n}$$closureNoArgs to %ObjPtr)"
+
+mkClosure n missingN args = do
+  let missing = cast {to=Int} missingN
+  let len = cast {to=Int} $ length args
+  let totalArgsExpected = missing + len
+  if totalArgsExpected > (cast CLOSURE_MAX_ARGS)
+     then do
+       addError $ "ERROR : too many closure arguments: " ++ show totalArgsExpected ++ " > " ++ show CLOSURE_MAX_ARGS
+       pure nullPtr
+     else do
+  let header = constHeader OBJECT_TYPE_ID_CLOSURE (cast ((missing * 0x10000) + len))
+  newObj <- dynamicAllocate (Const I64 $ cast (8 + 8 * len))
+  putObjectHeader newObj header
+  funcPtr <- (if (totalArgsExpected <= (cast FAT_CLOSURE_LIMIT))
+             then
+               assignSSA $ "bitcast %FuncPtrArgs" ++ show totalArgsExpected ++ " @" ++ (safeName n) ++ " to %FuncPtr"
+             else do
+               assignSSA $ "bitcast %FuncPtrClosureEntry @" ++ (safeName n) ++ "$$closureEntry to %FuncPtr"
+               )
+
+  putObjectSlot newObj (Const I64 0) (SSA FuncPtr funcPtr)
+  for_ (enumerate args) (\iv => do
+      let (i, argObj) = iv
+      putObjectSlot newObj (Const I64 $ cast $ i+1) argObj
+      pure ()
+      )
+  pure newObj