Change warnings from set to stack

pact/Pact/Core/Environment/Types.hs

@@ -76,6 +76,11 @@ module Pact.Core.Environment.Types
  , ReplDebugFlag(..)
  , SourceCode(..)
  , PactWarning(..)
+ , PactWarningStack
+ , newWarningStack
+ , newDefaultWarningStack
+ , pushWarning
+ , getWarningStack
  ) where
 
 
@@ -177,7 +182,37 @@ instance Pretty PactWarning where
     ModuleGuardEnforceDetected ->
       "Module guard enforce detected. Module guards are known to be unsafe, and will be removed in a future version of pact"
 
-type LocatedPactWarning i = Located i PactWarning
+-- | A simple stack of pact warnings,
+--   which appends up until a limit.
+data PactWarningStack i
+  = PactWarningStack
+  { _pwLimit :: !Int
+  -- ^ The max allowed warnings
+  , _pwCurrentSize :: !Int
+  -- ^ The current number of warnings
+  , _pwWarnings :: [Located i PactWarning]
+  -- ^ The actual warnings, including a loc info param
+  } deriving (Show)
+
+-- | Create a new warning stack, with a set limit
+newWarningStack :: Int -> PactWarningStack i
+newWarningStack lim =
+  PactWarningStack
+  { _pwLimit = lim
+  , _pwCurrentSize = 0
+  , _pwWarnings = []
+  }
+
+newDefaultWarningStack :: PactWarningStack i
+newDefaultWarningStack = newWarningStack 100
+
+pushWarning :: Located i PactWarning -> PactWarningStack i -> PactWarningStack i
+pushWarning w p@(PactWarningStack lim curr warnings)
+  | curr < lim = PactWarningStack lim (curr + 1) (w:warnings)
+  | otherwise = p
+
+getWarningStack :: PactWarningStack i -> [Located i PactWarning]
+getWarningStack = _pwWarnings
 
 -- From pact
 -- | All of the types included in our evaluation environment.
@@ -209,7 +244,7 @@ data EvalEnv b i
   -- ^ The gas environment
   , _eeSPVSupport :: SPVSupport
   -- ^ The SPV backend
-  , _eeWarnings :: !(Maybe (IORef (Set (LocatedPactWarning i))))
+  , _eeWarnings :: !(Maybe (IORef (PactWarningStack i)))
   } deriving (Generic)
 
 instance (NFData b, NFData i) => NFData (EvalEnv b i)
@@ -280,7 +315,7 @@ defaultEvalEnv
   -> IO (EvalEnv b i)
 defaultEvalEnv pdb m = do
   gasRef <- newIORef mempty
-  warningRef <- newIORef mempty
+  warningRef <- newIORef (newWarningStack 100)
   pure $ EvalEnv
     { _eeMsgSigs = mempty
     , _eeMsgVerifiers = mempty

pact/Pact/Core/IR/Eval/Runtime/Utils.hs

@@ -540,4 +540,4 @@ emitPactWarning i pw =
   viewEvalEnv eeWarnings >>= \case
     Nothing -> pure ()
     Just warnRef ->
-      liftIO $ modifyIORef' warnRef (S.insert (Located i pw))
+      liftIO $ modifyIORef' warnRef (pushWarning (Located i pw))

pact/Pact/Core/Info.hs

@@ -49,10 +49,4 @@ data Located i a
   = Located
   { _locLocation :: i
   , _locElem :: a }
-  deriving (Show, Functor, Foldable, Traversable)
-
-instance (Eq a) => Eq (Located i a) where
-  (Located _ a) == (Located _ a') = a == a'
-
-instance (Ord a) => Ord (Located i a) where
-  compare (Located _ a) (Located _ a') = compare a a'
+  deriving (Show, Eq, Ord, Functor, Foldable, Traversable)

pact/Pact/Core/Repl/Compile.hs

@@ -26,14 +26,14 @@ import Control.Monad.Except
 import Control.Monad.State.Strict
 import Data.Text(Text)
 import Data.Default
+import Data.IORef
 import Data.Foldable
 import System.FilePath.Posix
 
 
 import qualified Data.Map.Strict as M
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
-import qualified Data.Set as S
 
 import Pact.Core.Persistence
 import Pact.Core.Persistence.MockPersistence (mockPactDb)
@@ -65,7 +65,6 @@ import qualified Pact.Core.Syntax.Parser as Lisp
 import qualified Pact.Core.IR.Eval.CEK as CEK
 import qualified Pact.Core.IR.Eval.Direct.Evaluator as Direct
 import qualified Pact.Core.IR.Eval.Direct.ReplBuiltin as Direct
-import Data.IORef (writeIORef, readIORef)
 
 type ReplInterpreter = Interpreter ReplRuntime ReplCoreBuiltin SpanInfo
 
@@ -244,9 +243,11 @@ interpretReplProgram interpreter (SourceCode sourceFp source) = do
     viewEvalEnv eeWarnings >>= \case
       Nothing -> pure ()
       Just ref -> do
-        warnings <- liftIO (readIORef ref <* writeIORef ref mempty)
+        warnings <- liftIO $
+          atomicModifyIORef' ref (\old -> (newDefaultWarningStack, getWarningStack old))
         -- Todo: print located line
-        traverse_ (replPrintLn . _locElem) (S.toList warnings)
+        -- Note: warnings are pushed FIFO, so we reverse to get the right order
+        traverse_ (replPrintLn . _locElem) (reverse warnings)
   interpret (DesugarOutput tl _deps) = do
     case tl of
       RTLDefun df -> do