Operate strictly recursively.

This means we’re ensured of using allocations solely within the scopes
in which they are valid.

app/Main.hs

@@ -70,25 +70,29 @@ parseTreeSitterFile file = do
   source <- newCString contents
   ts_document_set_input_string document source
   ts_document_parse document
-  alloca (\root -> do
+  term <- parse document contents
-    ts_document_root_node_p document root
-    unfoldM (toTerm document contents) root)
   ts_document_free document
   free source
   putStrLn $ "hooray"
 
-toTerm :: Ptr TSDocument -> String -> Ptr TSNode -> IO (Info, Syntax String (Ptr TSNode))
+parse :: Ptr TSDocument -> String -> IO (Term String Info)
-toTerm document contents node = do
+parse document contents = do
+  alloca unpack where
+    unpack root = do
+      ts_document_root_node_p document root
+      toTerm root
+    toTerm :: Ptr TSNode -> IO (Term String Info)
+    toTerm node = do
       name <- ts_node_p_name node document
       name <- peekCString name
-  children <- namedChildren node
+      children <- withNamedChildren node toTerm
       range <- range node
       annotation <- return . Info range $ Data.Set.fromList [ name ]
-  return (annotation, case children of
+      return $ annotation :< case children of
         [] -> Leaf $ substring range contents
         _ | Data.Set.member name fixedProductions -> Fixed children
-    _ | otherwise -> Indexed children)
+        _ | otherwise -> Indexed children
-  where
+
 keyedProductions = Data.Set.fromList [ "object" ]
 fixedProductions = Data.Set.fromList [ "pair", "rel_op", "math_op", "bool_op", "bitwise_op", "type_op", "math_assignment", "assignment", "subscript_access", "member_access", "new_expression", "function_call", "function", "ternary" ]
 
@@ -97,14 +101,15 @@ withAlloc writeTo = do
   bytes <- malloc
   writeTo bytes
 
-namedChildren :: Ptr TSNode -> IO [Ptr TSNode]
+withNamedChildren :: Ptr TSNode -> (Ptr TSNode -> IO a) -> IO [a]
-namedChildren node = do
+withNamedChildren node f = do
   count <- ts_node_p_named_child_count node
   if count == 0
     then return []
-    else mapM (withAlloc . getChild) [0..pred count] where
+    else mapM (withAlloc . getChild f) [0..pred count] where
-      getChild n out = do
+      getChild f n out = do
         ts_node_p_named_child node n out
+        out <- f out
         return out
 
 range :: Ptr TSNode -> IO Range