diff --git a/src/Disco/Interpret/CESK.hs b/src/Disco/Interpret/CESK.hs index a64fbec3..be2f8431 100644 --- a/src/Disco/Interpret/CESK.hs +++ b/src/Disco/Interpret/CESK.hs @@ -182,8 +182,8 @@ step cesk = case cesk of True -> do cell <- allocateValue (VTrie T.empty) -- cell <- allocateValue (VMap M.empty) - return $ Out (VClo [] (Just cell) e xs body) k - False -> return $ Out (VClo [] Nothing e xs body) k + return $ Out (VClo (Just (cell,[])) e xs body) k + False -> return $ Out (VClo Nothing e xs body) k (In (CApp c1 c2) e k) -> return $ In c1 e (FArg e c2 : k) (In (CType ty) _ k) -> return $ Out (VType ty) k @@ -209,18 +209,18 @@ step cesk = case cesk of (Out v (FMemo n sv : k)) -> memoSet n sv v *> (return $ Out v k) - (Out v (FApp (VClo mem mi e [x] b) : k)) -> case mi of + (Out v (FApp (VClo mi e [x] b) : k)) -> case mi of Nothing -> return $ In b (Ctx.insert (localName x) v e) k - Just n -> do + Just (n,mem) -> do let sv = toSimpleValue $ foldr VPair VUnit (v : mem) mv <- memoLookup n sv case mv of Nothing -> return $ In b (Ctx.insert (localName x) v e) (FMemo n sv : k) Just v' -> return $ Out v' k - (Out v (FApp (VClo mem mi e (x : xs) b) : k)) -> case mi of - Just _ -> return $ Out (VClo (v : mem) mi (Ctx.insert (localName x) v e) xs b) k - Nothing -> return $ Out (VClo mem mi (Ctx.insert (localName x) v e) xs b) k + (Out v (FApp (VClo mi e (x : xs) b) : k)) -> case mi of + Just (n,mem) -> return $ Out (VClo (Just (n,v:mem)) (Ctx.insert (localName x) v e) xs b) k + Nothing -> return $ Out (VClo mi (Ctx.insert (localName x) v e) xs b) k @@ -229,8 +229,8 @@ step cesk = case cesk of -- Annoying to repeat this code, not sure of a better way. -- The usual evaluation order (function then argument) doesn't work when -- we're applying a test function to randomly generated values. - (Out (VClo _ _ e [x] b) (FArgV v : k)) -> return $ In b (Ctx.insert (localName x) v e) k - (Out (VClo mem mi e (x : xs) b) (FArgV v : k)) -> return $ Out (VClo mem mi (Ctx.insert (localName x) v e) xs b) k + (Out (VClo _ e [x] b) (FArgV v : k)) -> return $ In b (Ctx.insert (localName x) v e) k + (Out (VClo mi e (x : xs) b) (FArgV v : k)) -> return $ Out (VClo mi (Ctx.insert (localName x) v e) xs b) k (Out (VConst op) (FArgV v : k)) -> appConst k op v (Out (VFun f) (FArgV v : k)) -> return $ Out (f v) k (Out (VRef n) (FForce : k)) -> do diff --git a/src/Disco/Value.hs b/src/Disco/Value.hs index 84a36dc0..5661ef1c 100644 --- a/src/Disco/Value.hs +++ b/src/Disco/Value.hs @@ -134,7 +134,7 @@ data Value where VPair :: Value -> Value -> Value -- | A closure, i.e. a function body together with its -- environment. - VClo :: [Value] -> Maybe Int -> Env -> [Name Core] -> Core -> Value + VClo :: Maybe (Int,[Value]) -> Env -> [Name Core] -> Core -> Value -- | A disco type can be a value. For now, there are only a very -- limited number of places this could ever show up (in -- particular, as an argument to @enumerate@ or @count@). @@ -168,7 +168,7 @@ data Value where -- property when the key type is finite. VMap :: Map SimpleValue Value -> Value - VTrie :: T.TrieMap M.Map SimpleValue Value -> Value + VTrie :: T.TrieMap Map SimpleValue Value -> Value VGen :: StdGen -> Value deriving (Show)