Merge pull request #934 from github/evaluate-source-spans-eagerly

Evaluate source spans eagerly

src/Language.hs

@@ -43,7 +43,7 @@ languageForType mediaType = case mediaType of
 
 termConstructor
   :: Source Char -- ^ The source that the term occurs within.
-  -> IO SourceSpan -- ^ The span that the term occupies. This is passed in 'IO' to guarantee some access constraints & encourage its use only when needed (improving performance).
+  -> SourceSpan -- ^ The span that the term occupies.
   -> Text -- ^ The name of the production for this node.
   -> Range -- ^ The character range that the term occupies.
   -> [ SyntaxTerm Text '[Range, Category, SourceSpan] ] -- ^ The child nodes of the term.
@@ -55,9 +55,8 @@ termConstructor source sourceSpan name range children _ =
     (_, []) -> S.Leaf (toText $ slice range source)
     _ -> S.Indexed children
   where
-    withDefaultInfo syntax = do
-      sourceSpan' <- sourceSpan
-      pure $! cofree ((range .: Other name .: sourceSpan' .: RNil) :< syntax)
+    withDefaultInfo syntax =
+      pure $! cofree ((range .: Other name .: sourceSpan .: RNil) :< syntax)
 
 toVarDecl :: (HasField fields Category) => Term (S.Syntax Text) (Record fields) -> Term (S.Syntax Text) (Record fields)
 toVarDecl child = cofree $ setCategory (extract child) VarDecl :< S.VarDecl child

src/Language/C.hs

@@ -10,7 +10,7 @@ import Term
 
 termConstructor
   :: Source Char -- ^ The source that the term occurs within.
-  -> IO SourceSpan -- ^ The span that the term occupies. This is passed in 'IO' to guarantee some access constraints & encourage its use only when needed (improving performance).
+  -> SourceSpan -- ^ The span that the term occupies.
   -> Text -- ^ The name of the production for this node.
   -> Range -- ^ The character range that the term occupies.
   -> [ SyntaxTerm Text '[Range, Category, SourceSpan] ] -- ^ The child nodes of the term.
@@ -22,9 +22,7 @@ termConstructor source sourceSpan name range children _
   (_, []) -> S.Leaf . toText $ slice range source
   _ -> S.Indexed children
   where
-    withDefaultInfo syntax = do
-      sourceSpan' <- sourceSpan
-      pure $! cofree ((range .: categoryForCProductionName name .: sourceSpan' .: RNil) :< syntax)
+    withDefaultInfo syntax = pure $! cofree ((range .: categoryForCProductionName name .: sourceSpan .: RNil) :< syntax)
 
 categoryForCProductionName :: Text -> Category
 categoryForCProductionName name = Other name

src/Language/Go.hs

@@ -12,7 +12,7 @@ import SourceSpan (unionSourceSpansFrom)
 
 termConstructor
   :: Source Char -- ^ The source that the term occurs within.
-  -> IO SourceSpan -- ^ The span that the term occupies. This is passed in 'IO' to guarantee some access constraints & encourage its use only when needed (improving performance).
+  -> SourceSpan -- ^ The span that the term occupies.
   -> Text -- ^ The name of the production for this node.
   -> Range -- ^ The character range that the term occupies.
   -> [ SyntaxTerm Text '[Range, Category, SourceSpan] ] -- ^ The child nodes of the term.
@@ -47,7 +47,7 @@ termConstructor source sourceSpan name range children _ = case name of
       where isCaseClause = (== Case) . category . extract
   "type_switch_statement" ->
     case Prologue.break isCaseClause children of
-      (clauses, cases) -> do
+      (clauses, cases) ->
         withDefaultInfo $ case clauses of
           [id] -> S.Switch id cases
           _ -> S.Error children
@@ -140,15 +140,14 @@ termConstructor source sourceSpan name range children _ = case name of
            withDefaultInfo (S.Indexed varDecls)
         rest -> withCategory Error (S.Error rest)
 
-    withRanges originalRange category' terms syntax = do
+    withRanges originalRange category' terms syntax =
       let ranges' = getField . extract <$> terms
-      sourceSpan' <- sourceSpan
-      let sourceSpans' = getField . extract <$> terms
-      pure $! cofree ((unionRangesFrom originalRange ranges' .: category' .: unionSourceSpansFrom sourceSpan' sourceSpans' .: RNil) :< syntax)
+          sourceSpans' = getField . extract <$> terms
+      in
+      pure $! cofree ((unionRangesFrom originalRange ranges' .: category' .: unionSourceSpansFrom sourceSpan sourceSpans' .: RNil) :< syntax)
 
-    withCategory category syntax = do
-      sourceSpan' <- sourceSpan
-      pure $! cofree ((range .: category .: sourceSpan' .: RNil) :< syntax)
+    withCategory category syntax =
+      pure $! cofree ((range .: category .: sourceSpan .: RNil) :< syntax)
 
     withDefaultInfo = withCategory (categoryForGoName name)
 

src/Language/JavaScript.hs

@@ -20,7 +20,7 @@ forStatements = [ "for_statement", "for_of_statement", "for_in_statement", "trai
 
 termConstructor
   :: Source Char -- ^ The source that the term occurs within.
-  -> IO SourceSpan -- ^ The span that the term occupies. This is passed in 'IO' to guarantee some access constraints & encourage its use only when needed (improving performance).
+  -> SourceSpan -- ^ The span that the term occupies.
   -> Text -- ^ The name of the production for this node.
   -> Range -- ^ The character range that the term occupies.
   -> [ SyntaxTerm Text '[Range, Category, SourceSpan] ] -- ^ The child nodes of the term.
@@ -119,11 +119,10 @@ termConstructor source sourceSpan name range children allChildren
     (_, []) -> S.Leaf . toText $ slice range source
     _ -> S.Indexed children
   where
-    withDefaultInfo syntax = do
-      sourceSpan' <- sourceSpan
+    withDefaultInfo syntax =
       pure $! case syntax of
-        S.MethodCall{} -> cofree ((range .:  MethodCall .: sourceSpan' .: RNil) :< syntax)
-        _ -> cofree ((range .: categoryForJavaScriptProductionName name .: sourceSpan' .: RNil) :< syntax)
+        S.MethodCall{} -> cofree ((range .:  MethodCall .: sourceSpan .: RNil) :< syntax)
+        _ -> cofree ((range .: categoryForJavaScriptProductionName name .: sourceSpan .: RNil) :< syntax)
 
 categoryForJavaScriptProductionName :: Text -> Category
 categoryForJavaScriptProductionName name = case name of

src/Language/Ruby.hs

@@ -15,7 +15,7 @@ operators = ["binary", "unary", "range", "scope_resolution"]
 
 termConstructor
   :: Source Char -- ^ The source that the term occurs within.
-  -> IO SourceSpan -- ^ The span that the term occupies. This is passed in 'IO' to guarantee some access constraints & encourage its use only when needed (improving performance).
+  -> SourceSpan -- ^ The span that the term occupies.
   -> Text -- ^ The name of the production for this node.
   -> Range -- ^ The character range that the term occupies.
   -> [ SyntaxTerm Text '[Range, Category, SourceSpan] ] -- ^ The child nodes of the term.
@@ -135,9 +135,8 @@ termConstructor source sourceSpan name range children allChildren
     _  -> S.Indexed children
   where
     withRecord record syntax = pure $! cofree (record :< syntax)
-    withCategory category syntax = do
-      sourceSpan' <- sourceSpan
-      pure $! cofree ((range .: category .: sourceSpan' .: RNil) :< syntax)
+    withCategory category syntax =
+      pure $! cofree ((range .: category .: sourceSpan .: RNil) :< syntax)
     withDefaultInfo syntax = case syntax of
       S.MethodCall{} -> withCategory MethodCall syntax
       _ -> withCategory (categoryForRubyName name) syntax

src/TreeSitter.hs

@@ -53,10 +53,10 @@ documentToTerm language document SourceBlob{..} = alloca $ \ root -> do
           let allChildren = filter isNonEmpty <$> traverse (alloca . getUnnamedChild node) (take (fromIntegral allChildrenCount) [0..])
 
           -- Note: The strict application here is semantically important.
-          -- Without it, we may not evaluate the range until after we’ve exited
+          -- Without it, we may not evaluate the value until after we’ve exited
           -- the scope that `node` was allocated within, meaning `alloca` will
           -- free it & other stack data may overwrite it.
-          range `seq` termConstructor source (pure $! sourceSpan) (toS name) range children allChildren
+          range `seq` sourceSpan `seq` termConstructor source sourceSpan (toS name) range children allChildren
         getChild node n out = ts_node_p_named_child node n out >> toTerm out
         {-# INLINE getChild #-}
         getUnnamedChild node n out = ts_node_p_child node n out >> toTerm out