diff --git a/parser-typechecker/src/Unison/Runtime/IR.hs b/parser-typechecker/src/Unison/Runtime/IR.hs index afab46760..8bd9cda2e 100644 --- a/parser-typechecker/src/Unison/Runtime/IR.hs +++ b/parser-typechecker/src/Unison/Runtime/IR.hs @@ -19,6 +19,7 @@ import Control.Monad.State.Strict (StateT, gets, modify, runStateT, lift) import Data.Bifunctor (first, second) import Data.Foldable import Data.Functor (void) +import Data.HashTable.IO (BasicHashTable) import Data.IORef import Data.Int (Int64) import Data.Map (Map) @@ -33,6 +34,7 @@ import Unison.Symbol (Symbol) import Unison.Term (AnnotatedTerm) import Unison.Util.Monoid (intercalateMap) import Unison.Var (Var) +import qualified Data.HashTable.IO as HT import qualified Data.Map as Map import qualified Data.Set as Set import qualified Unison.ABT as ABT @@ -78,6 +80,7 @@ toSymbolC s = SymbolC False s -- Values, in normal form type RefID = Int + data Value e cont = I Int64 | F Double | N Word64 | B Bool | T Text | Lam Arity (UnderapplyStrategy e cont) (IR e cont) @@ -89,6 +92,28 @@ data Value e cont | Cont cont | UninitializedLetRecSlot Symbol [(Symbol, IR e cont)] (IR e cont) +instance (CycleEq e, CycleEq cont) => CycleEq (UnderapplyStrategy e cont) where + cycleEq ht us us2 = undefined + +instance (CycleEq e, CycleEq cont) => CycleEq (Value e cont) where + cycleEq _ _ (I x) (I y) = pure (x == y) + cycleEq _ _ (F x) (F y) = pure (x == y) + cycleEq _ _ (N x) (N y) = pure (x == y) + cycleEq _ _ (B x) (B y) = pure (x == y) + cycleEq _ _ (T x) (T y) = pure (x == y) + cycleEq e n (Lam arity1 us _) (Lam arity2 us2 _) = + if arity1 == arity2 then cycleEq e n us us2 + else pure False + cycleEq e n (Data r1 c1 vs1) (Data r2 c2 vs2) = + if r1 == r2 && c1 == c2 then go e n vs1 vs2 + else pure False + where + go _ _ [] [] = pure True + go e n (h1:t1) (h2:t2) = cycleEq e n h1 h2 >>= \b -> + if b then go e n t1 t2 + else pure False +-- cycleEq e n (Sequence v1) (Sequence v2) = + instance (Eq cont, Eq e) => Eq (Value e cont) where I x == I y = x == y F x == F y = x == y diff --git a/parser-typechecker/src/Unison/Util/CyclicEq.hs b/parser-typechecker/src/Unison/Util/CyclicEq.hs new file mode 100644 index 000000000..5c88b08ea --- /dev/null +++ b/parser-typechecker/src/Unison/Util/CyclicEq.hs @@ -0,0 +1,12 @@ +module Unison.Util.CyclicEq where + +import Data.HashTable.IO (BasicHashTable) +import qualified Data.HashTable.IO as HT + +type HashTable k v = BasicHashTable k v + +class CyclicEq a where + -- Map from `Ref` ID to position in the stream + -- If a ref is encountered again, we use its mapped ID + cyclicEq :: HashTable Int Int -> IORef Int -> a -> a -> IO Bool + diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 50d8f230e..09c565f83 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -118,6 +118,7 @@ library Unison.Util.Relation Unison.Util.TQueue Unison.Util.TransitiveClosure + Unison.Util.CyclicEq Unison.Var build-depends: @@ -142,6 +143,7 @@ library free, fsnotify, hashable, + hashtables, haskeline, io-streams, lens, @@ -150,6 +152,7 @@ library monad-loops, mtl, murmur-hash, + mutable-containers, network, process, megaparsec,