Skip to content
Permalink
Browse files

Merge PR #297: Graph API work contd.

  • Loading branch information
cwgoes committed Jan 7, 2020
1 parent 73515bd commit 969cbd915f31e300171a3b7379f4a8f29da7e62f
@@ -23,3 +23,7 @@ tmp/

# Agda temporary
*.agdai

# LLVM temporary
*.ll
*.s
@@ -0,0 +1,7 @@
1

can we make them look like primitive inductive datatypes

2


@@ -320,7 +320,9 @@ numPortsPointer ∷ Type
numPortsPointer = pointerOf numPortsNameRef

numPortsNameRef Type
numPortsNameRef = Type.NamedTypeReference numPortsName
numPortsNameRef
| bitSizeEncodingPoint = Type.IntegerType addressSpace
| otherwise = Type.NamedTypeReference numPortsName

numPortsName IsString p p
numPortsName = "graph_num_ports"
@@ -76,8 +76,6 @@ orcJitWith config mod func = do
resolvers newIORef Map.empty
withModuleFromAST context mod $ \m do
putText "got module"
asm moduleLLVMAssembly m
B.putStrLn asm
withHostTargetMachine Reloc.PIC CodeModel.Default CodeGenOpt.Default $ \tm do
putText "got target machine"
withExecutionSession $ \es do
@@ -129,7 +127,6 @@ mcJitWith config mod func = do
_ runPassManager pm m
-- convert to llvm assembly
s moduleLLVMAssembly m
B.putStrLn s
B.putStrLn "getting execution engine"
EE.withModuleInEngine executionEngine m $ \ee do
B.putStrLn "got execution engine"
@@ -56,6 +56,18 @@ opaqueNetType = Type.PointerType eacListPointer (Addr.AddrSpace 0)
-- appendToNet :: Ptr Net -> [Node] -> IO ()
-- readNet :: Ptr Net -> IO [Node]
-- reduceUntilComplete :: Ptr Net -> IO ()
-- test :: IO ()

defineTest Codegen.Define m m Operand.Operand
defineTest =
Codegen.defineFunction Type.void "test" [] $ do
create_net Codegen.externf "create_net"
append_to_net Codegen.externf "append_to_net"
reduce_until_complete Codegen.externf "reduce_until_complete"
ptr Codegen.call opaqueNetType create_net (Codegen.emptyArgs [])
Codegen.callVoid append_to_net (Codegen.emptyArgs [ptr, Operand.ConstantOperand (C.Null nodePointer), Operand.ConstantOperand (C.Int Codegen.addressSpace 0)])
Codegen.callVoid reduce_until_complete (Codegen.emptyArgs [ptr])
Codegen.retNull

defineCreateNet Codegen.Define m m Operand.Operand
defineCreateNet =
@@ -96,56 +108,63 @@ defineAppendToNet =
eac_list Types.cons appNode (Operand.ConstantOperand (C.Null Types.eacLPointer))
Codegen.store netPtr eac_list
Codegen.retNull
where
args = [(opaqueNetType, "net"), (nodePointer, "nodes"), (int32, "node_count")]

{-
nodes ← Codegen.externf "nodes"
node_count ← Codegen.externf "node_count"
forLoop ← Codegen.addBlock "for.loop"
forExit ← Codegen.addBlock "for.exit"
--forLoop2 ← Codegen.addBlock "for.loop.2"
--forExit2 ← Codegen.addBlock "for.exit.2"
-- Create a counter to track position
counter ← Codegen.alloca int32
Codegen.store counter (Operand.ConstantOperand (C.Int 32 0))
Codegen.br forLoop
-- Loop case: convert node, increment counter.
Codegen.setBlock forLoop
ind ← Codegen.load int32 counter
-- Load node at index `ind`.
node ← Codegen.loadElementPtr (Codegen.Minimal {Codegen.address' = nodes, Codegen.type' = nodePointer, Codegen.indincies' = [ind]})
-- Create the in-memory node.
kind ← EAC.mallocApp -- TODO: Switch on node kind.
-- Write the address to the list.
addr ← Codegen.getElementPtr (Codegen.Minimal {Codegen.address' = nodes, Codegen.type' = nodePointer, Codegen.indincies' = [ind, Operand.ConstantOperand (C.Int 32 0)]})
Codegen.store addr kind
next ← Codegen.add int32 ind (Operand.ConstantOperand (C.Int 32 1))
Codegen.store counter next
cond ← Codegen.icmp IntPred.EQ node_count next
Codegen.cbr cond forLoop forExit
-- Exit case: next loop.
Codegen.setBlock forExit
Codegen.retNull
Codegen.store counter (Operand.ConstantOperand (C.Int 32 0))
Codegen.br forLoop2
-- Second loop: link nodes.
Codegen.setBlock forLoop2
ind ← Codegen.load int32 counter
-- Load node at index `ind`.
node ← Codegen.loadElementPtr (Codegen.Minimal {Codegen.address' = nodes, Codegen.type' = nodePointer, Codegen.indincies' = [ind]})
ptr ← Codegen.loadElementPtr (Codegen.Minimal {Codegen.address' = nodes, Codegen.type' = nodePointer, Codegen.indincies' = [ind, Operand.ConstantOperand (C.Int 32 0)]})
-- TODO: Link things, lookup node pointers.
-- Alter parameter?
next ← Codegen.add int32 ind (Operand.ConstantOperand (C.Int 32 1))
Codegen.store counter next
cond ← Codegen.icmp IntPred.EQ node_count next
Codegen.cbr cond forLoop forExit
-- Exit case: return.
Codegen.setBlock forExit2
-- TODO: Set eac list pointer?
Codegen.retNull
-}
where
args = [(opaqueNetType, "net"), (nodePointer, "nodes"), (int32, "node_count")]

defineAppendToNet' (Codegen.Define m, Codegen.MallocNode m) m Operand.Operand
defineAppendToNet' =
Codegen.defineFunction Type.void "append_to_net" args $ do
nodes Codegen.externf "nodes"
node_count Codegen.externf "node_count"
forLoop Codegen.addBlock "for.loop"
forExit Codegen.addBlock "for.exit"
forLoop2 Codegen.addBlock "for.loop.2"
forExit2 Codegen.addBlock "for.exit.2"
-- Create a counter to track position
counter Codegen.alloca int32
Codegen.store counter (Operand.ConstantOperand (C.Int 32 0))
Codegen.br forLoop
-- Loop case: convert node, increment counter.
Codegen.setBlock forLoop
ind Codegen.load int32 counter
-- Load node at index `ind`.
node Codegen.loadElementPtr
(Codegen.Minimal {Codegen.address' = nodes, Codegen.type' = nodePointer, Codegen.indincies' = [ind]})
-- Create the in-memory node.
kind EAC.mallocApp -- TODO: Switch on node kind.
-- Write the address to the list.
addr Codegen.getElementPtr
(Codegen.Minimal {Codegen.address' = nodes, Codegen.type' = nodePointer, Codegen.indincies' = [ind, Operand.ConstantOperand (C.Int 32 0)]})
Codegen.store addr kind
next Codegen.add int32 ind (Operand.ConstantOperand (C.Int 32 1))
Codegen.store counter next
cond Codegen.icmp IntPred.EQ node_count next
Codegen.cbr cond forLoop forExit
-- Exit case: next loop.
Codegen.setBlock forExit
Codegen.retNull
Codegen.store counter (Operand.ConstantOperand (C.Int 32 0))
Codegen.br forLoop2
-- Second loop: link nodes.
Codegen.setBlock forLoop2
ind Codegen.load int32 counter
-- Load node at index `ind`.
node Codegen.loadElementPtr
(Codegen.Minimal {Codegen.address' = nodes, Codegen.type' = nodePointer, Codegen.indincies' = [ind]})
ptr Codegen.loadElementPtr
(Codegen.Minimal {Codegen.address' = nodes, Codegen.type' = nodePointer, Codegen.indincies' = [ind, Operand.ConstantOperand (C.Int 32 0)]})
-- TODO: Link things, lookup node pointers.
-- Alter parameter?
next Codegen.add int32 ind (Operand.ConstantOperand (C.Int 32 1))
Codegen.store counter next
cond Codegen.icmp IntPred.EQ node_count next
Codegen.cbr cond forLoop forExit
-- Exit case: return.
Codegen.setBlock forExit2
-- TODO: Set eac list pointer?
Codegen.retNull
where
args = [(opaqueNetType, "net"), (nodePointer, "nodes"), (int32, "node_count")]

defineReduceUntilComplete Codegen.Define m m Operand.Operand
defineReduceUntilComplete =
@@ -39,7 +39,8 @@ initialModule = do
}
)
-- registering types----------------------------------------------
Codegen.addType Codegen.numPortsName Codegen.numPorts
when Codegen.bitSizeEncodingPoint $
Codegen.addType Codegen.numPortsName Codegen.numPorts
Codegen.addType Codegen.portTypeName Defs.portType
Codegen.addType Types.eacName Types.eac
Codegen.addType Types.eacListName Types.eacList
@@ -75,6 +76,7 @@ initialModule = do
_ API.defineReadNet
_ API.defineAppendToNet
_ API.defineReduceUntilComplete
_ API.defineTest
-- end API definitions
pure ()

@@ -4,7 +4,8 @@
module Juvix.Backends.LLVM.Translation where

import qualified Data.HashMap.Strict as Map
import Juvix.Backends.LLVM.JIT
import qualified Data.Text.Lazy.IO as T
import Juvix.Backends.LLVM.JIT hiding (Node)
import qualified Juvix.Backends.LLVM.Net.EAC.MonadEnvironment as Environment
import Juvix.Backends.LLVM.Net.Environment
import qualified Juvix.Core.Erased.Types as Erased
@@ -18,20 +19,24 @@ import Juvix.Library hiding (empty, link, reduce)
import LLVM.Pretty
import Prelude ((!!))

jitInitialModule IO (NetAPI, IO ())
jitInitialModule = do
-- Generate the LLVM module.
let mod = Environment.moduleAST runInitModule
-- Pretty-print the module to a file for reference.
T.writeFile "initial_module.ll" (ppllvm mod)
-- JIT the module.
putText "Just-in-time compiling initial module..."
jitToNetAPI (Config None) mod

evalErasedCoreInLLVM
primTy primVal m.
(MonadIO m)
Core.Parameterisation primTy primVal
Erased.Term primVal
m (Erased.Term primVal)
evalErasedCoreInLLVM parameterisation term = do
-- Generate the LLVM module.
let mod = Environment.moduleAST runInitModule
-- Pretty-print the module.
putStr (ppllvm mod) >> putStr ("\n" Text)
-- JIT the module.
liftIO (putText "Just-in-time compiling initial module...")
(NetAPI createNet appendToNet readNet reduceUntilComplete, kill) liftIO (jitToNetAPI (Config None) mod)
(NetAPI createNet appendToNet readNet reduceUntilComplete, kill) liftIO jitInitialModule
-- Convert the term to a graph.
let netAST = erasedCoreToInteractionNetAST term

@@ -51,16 +56,7 @@ evalErasedCoreInLLVM parameterisation term = do
liftIO (putText "Creating net...")
net liftIO createNet
-- Append the nodes.
let nodes = flip map (zip [0 ..] ns) $ \(ind, (_, l, edges))
INIR.Node
{ INIR.nodeAddress = ind,
INIR.nodeKind = case l of
Primar Erase 0
Auxiliary2 Lambda 1
Auxiliary2 App 2
Auxiliary2 (FanIn i) i
--INIR.nodePorts = map (\(_, toNode, toPort) → INIR.Port toNode (portTypeToIndex toPort)) edges
}
let nodes = flip map (zip [0 ..] ns) nodeToIR
liftIO (putText ("Appending nodes..."))
liftIO (putText ("Nodes: " <> show nodes))
liftIO (appendToNet net nodes)
@@ -74,12 +70,7 @@ evalErasedCoreInLLVM parameterisation term = do
-- Translate into a native graph.
let retGraph Graph.FlipNet (Lang primVal)
retGraph = flip evalEnvState (Env 0 empty Map.empty) $ do
ns flip mapM nodes $ \node
newNode $ case INIR.nodeKind node of
0 Primar Erase
1 Auxiliary2 Lambda
2 Auxiliary2 App
n Auxiliary2 (FanIn (fromIntegral n))
ns mapM nodeFromIR nodes
flip mapM_ nodes $ \node do
let addr = ns !! INIR.nodeAddress node
-- TODO: Ports
@@ -97,6 +88,26 @@ evalErasedCoreInLLVM parameterisation term = do
-- Return the resulting term.
pure res

nodeFromIR net primVal m dataTy. (Network net, HasState "net" (net (Lang primVal)) m) INIR.Node dataTy m Node
nodeFromIR = \node
newNode $ case INIR.nodeKind node of
0 Primar Erase
1 Auxiliary2 Lambda
2 Auxiliary2 App
n Auxiliary2 (FanIn (fromIntegral n))

nodeToIR k a primVal c (dataTy k). (INIR.Address, (a, Lang primVal, c)) INIR.Node dataTy
nodeToIR (ind, (_, l, edges)) =
INIR.Node
{ INIR.nodeAddress = ind,
INIR.nodeKind = case l of
Primar Erase 0
Auxiliary2 Lambda 1
Auxiliary2 App 2
Auxiliary2 (FanIn i) i
--INIR.nodePorts = map (\(_, toNode, toPort) → INIR.Port toNode (portTypeToIndex toPort)) edges
}

portTypeToIndex PortType INIR.Slot
portTypeToIndex Prim = 0
portTypeToIndex Aux1 = 1
@@ -34,8 +34,9 @@ backendLLVM =
"Backend LLVM"
[ test_example_jit,
test_malloc_free_jit,
--test_eval_jit,
--test_init_module_jit,
--test_create_net_kill,
--test_eval_jit,
test_init_module
]

@@ -67,6 +68,12 @@ test_eval_jit = T.testCase "x should evaluate to x" $ do
res evalErasedCoreInLLVM unit term
term T.@=? res

test_create_net_kill T.TestTree
test_create_net_kill = T.testCase "create net & kill should work" $ do
(api, kill) jitInitialModule
_ createNet api
kill

test_malloc_free_jit T.TestTree
test_malloc_free_jit = T.testCase "malloc free module should jit" $ do
(imp, kill) mcJitWith (Config None) mallocFreeModule dynamicImport

0 comments on commit 969cbd9

Please sign in to comment.
You can’t perform that action at this time.