Compile Prim nodes to Hugr DFG

brat/Brat/Compile/Hugr.hs

@@ -188,7 +188,7 @@
 addOp op name | track ("addOp " ++ show op ++ show name) False = undefined
 addOp op name = do
   st <- get
   let new_nodes = M.alter (\Nothing -> Just op) name (nodes st) -- fail if key already present
   put (st { nodes = new_nodes })
 
 registerCompiled :: Name -> NodeId -> Compile ()
@@ -227,7 +227,7 @@
 
 renameAndSortHugr :: M.Map NodeId (HugrOp NodeId) -> [(PortId NodeId, PortId NodeId)] -> Hugr Int
 renameAndSortHugr nodes edges = fmap update (Hugr (fst <$> sorted_nodes) (edges ++ orderEdges)) where
   sorted_nodes = let ([root], rest) = partition (\(n, nid) -> nid == getParent n) (swap <$> M.assocs nodes) in
                    root : sort rest
 
   names2Pos = M.fromList $ zip (snd <$> sorted_nodes) ([0..] :: [Int])
@@ -338,7 +338,7 @@
       -- We are loading idNode as a value (not an Eval'd thing), and it is a FuncDef directly
       -- corresponding to a Brat TLD (not that produces said TLD when eval'd)
       False -> addNode ("load_thunk(" ++ show funcDef ++ ")")
                   (OpLoadConstant (LoadConstantOp parent (let [ty] = hTys in ty)))
     -- the only input
     pure $ Just (nod, [(Port funcDef 0, 0)])
   compileNode in_edges = do
@@ -387,8 +387,18 @@
     -- This should only have one outgoing wire which leads to an `Id` node for
     -- the brat representation of the function, and that wire should have a
     -- function type
-    Prim _ -> error $ "TODO: Compiling a Prim node being used as a thunk, not directly Evaled."
-                      ++ " Should construct trivial 4-node DFG+I/O+CustomOp Hugr."
+    Prim (ext,op) -> do
+      let n = ext ++ ('_':op)
+      let [] = ins
+      let [(_, VFun Braty cty)] = outs
+      box_sig@(FunctionType inputTys outputTys) <- body <$> compileSig Braty cty
+      ((p, _ty), ()) <- compileConstDfg parent n box_sig $ \dfg_id -> do
+        ins <- addNodeWithInputs ("Inputs" ++ n) (OpIn (InputNode dfg_id inputTys)) [] inputTys
+        outs <- addNodeWithInputs n (OpCustom (CustomOp dfg_id ext op box_sig [])) ins outputTys
+        addNodeWithInputs ("Outputs" ++ n) (OpOut (OutputNode dfg_id outputTys)) outs [] >>= \case
+          [] -> pure ()
+      case p of
+        (Port loadConst 0) -> pure $ default_edges loadConst
 
     -- Check if the node has prefix "globals", hence should be a direct call
     Eval (Ex outNode outPort) -> do

brat/examples/holes.brat

@@ -1,3 +1,6 @@
+ha :: Nat
+ha = ?idx
+
 -- Holes can go in kernels
 f :: { Qubit -o Qubit, Bool }
 f = { q => q, ?b }

brat/examples/vec_map.brat

@@ -0,0 +1,15 @@
+ext "to_float" to_float(i :: Int) -> Float
+
+map1({ Int -> Float }, List(Int)) -> List(Float)
+map1(_, []) = []
+map1(f, x ,- xs) = f(x) ,- map1(f, xs)
+
+test1 :: List(Float)
+test1 = map1(to_float, [5])
+
+map2({ {Int -> Float} -> Float}, List({Int->Float})) -> List(Float)
+map2(_, []) = []
+map2(f, x ,- xs) = f(x) ,- map2(f, xs)
+
+test2 :: List(Float)
+test2 = map2({f => f(5)}, [to_float])

brat/examples/vector.brat

@@ -7,21 +7,12 @@
 swap(Nat, Nat) -> Nat, Nat
 swap = a, b => b, a
 
-nat :: Nat
-nat = 0
-
 -- comp :: Nat, Nat -> Nat
 -- comp = x, y => fst(swap(x, y))
 
 -- te :: Vec Bool 2
 -- te = [true, true]
 
-test :: Nat
-test = 1
-
-ha :: Nat
-ha = ?idk
-
 type A = Nat
 
 isNil :: { Vec(A, 0) -> Bool }

brat/test/Test/Compile/Hugr.hs

@@ -50,12 +50,12 @@ nonCompilingExamples = (expectedCheckingFails ++ expectedParsingFails ++
   ,"kernel-syntax"
   ,"kinds"
   ,"let"
-  ,"list"
   ,"listpair"
   ,"one"
   ,"patterns"
   ,"qft"
   ,"test"
+  ,"type_alias"
   ,"vector"
   -- Conjecture: These examples don't compile because number patterns in type
   -- signatures causes `kindCheck` to call `abstract`, creating "Selector"