wip

src/Core/Evaluation.hs

@@ -29,6 +29,7 @@ import Plicity
 import Protolude hiding (IntMap, Seq, evaluate, force, head, try)
 import Query (Query)
 import qualified Query
+import qualified Query.Mapped as Mapped
 import Rock
 import Telescope (Telescope)
 import qualified Telescope
@@ -69,8 +70,12 @@ evaluate env term =
       result <- try $ fetch $ Query.ElaboratedDefinition name
       case result of
         Right (Syntax.ConstantDefinition term', _) -> do
+          recursive <- fetch $ Query.TransitiveDependencies name $ Mapped.Query name
           value <- lazyEvaluate Environment.empty term'
-          pure $ Domain.Stuck (Domain.Global name) mempty value mempty
+          pure
+            if isJust recursive
+              then Domain.Stuck (Domain.Global name) mempty value mempty
+              else Domain.Glued (Domain.Global name) mempty value
         Left (Cyclic (_ :: Some Query)) ->
           pure $ Domain.global name
         _ ->

src/Rules.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 
 module Rules where
@@ -31,6 +32,7 @@ import Data.HashSet (HashSet)
 import qualified Data.HashSet as HashSet
 import qualified Data.OrderedHashMap as OrderedHashMap
 import qualified Data.OrderedHashSet as OrderedHashSet
+import Data.Some (Some)
 import qualified Data.Text as Text
 import qualified Data.Text.Unsafe as Text
 import Data.Text.Utf16.Rope (Rope)
@@ -336,7 +338,11 @@ rules sourceDirectories files readFile_ (Writer (Writer query)) =
               go (dep : todo) done
                 | dep `HashSet.member` done = go todo done
                 | otherwise = do
-                    depDeps <- fetch $ TransitiveDependencies dep Mapped.Map
+                    transitiveDeps <- try $ fetch $ TransitiveDependencies dep Mapped.Map
+                    depDeps <- case transitiveDeps of
+                      Left (Cyclic (_ :: Some Query)) -> fetch $ Dependencies dep Mapped.Map
+                      Right depDeps -> pure depDeps
+
                     go todo $ HashSet.insert dep done <> HashSet.fromMap depDeps
           deps <- fetch $ Dependencies qualifiedName Mapped.Map
           HashSet.toMap