Operate strictly recursively.

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

app/Main.hs

@@ -70,41 +70,46 @@ 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
-  name <- ts_node_p_name node document
+  alloca unpack where
-  name <- peekCString name
+    unpack root = do
-  children <- namedChildren node
+      ts_document_root_node_p document root
-  range <- range node
+      toTerm root
-  annotation <- return . Info range $ Data.Set.fromList [ name ]
+    toTerm :: Ptr TSNode -> IO (Term String Info)
-  return (annotation, case children of
+    toTerm node = do
-    [] -> Leaf $ substring range contents
+      name <- ts_node_p_name node document
-    _ | Data.Set.member name fixedProductions -> Fixed children
+      name <- peekCString name
-    _ | otherwise -> Indexed children)
+      children <- withNamedChildren node toTerm
-  where
+      range <- range node
-    keyedProductions = Data.Set.fromList [ "object" ]
+      annotation <- return . Info range $ Data.Set.fromList [ name ]
-    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" ]
+      return $ annotation :< case children of
+        [] -> Leaf $ substring range contents
+        _ | Data.Set.member name fixedProductions -> Fixed children
+        _ | otherwise -> Indexed children
+
+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" ]
 
 withAlloc :: Storable a => (Ptr a -> IO b) -> IO b
 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