diff options
| author | Marvin Borner | 2023-02-23 15:29:44 +0100 |
|---|---|---|
| committer | Marvin Borner | 2023-02-23 15:29:44 +0100 |
| commit | f452a6f311408ea78e5fce765766c98acca33188 (patch) | |
| tree | badb08607c84eff28149d5602d8f50643cc047e7 /src/Eval.hs | |
| parent | 99d8f364d6376886dd49a51ff4c3afe13337cfc4 (diff) | |
Added free command (doesn't really work though)
Diffstat (limited to 'src/Eval.hs')
| -rw-r--r-- | src/Eval.hs | 35 |
1 files changed, 22 insertions, 13 deletions
diff --git a/src/Eval.hs b/src/Eval.hs index 331ab8d..5b0c9d0 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -22,6 +22,7 @@ import System.Console.Haskeline import System.Directory import System.Environment import System.FilePath.Posix ( takeBaseName ) +import System.Mem import Text.Megaparsec hiding ( State , try ) @@ -242,6 +243,27 @@ evalCommand inp s@(EnvState env@(Environment envDefs) conf cache) = \case _ -> pure s | otherwise -> pure s + ClearState -> do -- TODO: actually free memory :/ + putStr "Currently allocated: " + getAllocationCounter >>= putStr . show . (0 -) + putStrLn " Byte" + performGC + pure $ EnvState (Environment M.empty) conf (EnvCache M.empty) + Time e -> do + start <- getTime Monotonic + _ <- evalInstruction (ContextualInstruction (Evaluate e) inp) + s + (const $ pure s) + end <- getTime Monotonic + let roundSecs x = + (fromIntegral (round $ x * 1e6 :: Integer)) / 1e6 :: Double + putStr + $ show + $ roundSecs + $ (fromIntegral $ toNanoSecs $ diffTimeSpec start end :: Double) + / 1e9 + putStrLn " seconds" + pure s -- TODO: Reduce redundancy showResult :: Expression -> Expression -> Environment -> IO () @@ -285,19 +307,6 @@ evalInstruction (ContextualInstruction instr inp) s@(EnvState env conf _) rec = yeet s' (c : cs') = do s'' <- s' yeet (evalCommand inp s'' c) cs' - Time e -> do - start <- getTime Monotonic - _ <- evalInstruction (ContextualInstruction (Evaluate e) inp) s rec - end <- getTime Monotonic - let roundSecs x = - (fromIntegral (round $ x * 1e6 :: Integer)) / 1e6 :: Double - putStr - $ show - $ roundSecs - $ (fromIntegral $ toNanoSecs $ diffTimeSpec start end :: Double) - / 1e9 - putStrLn " seconds" - rec s _ -> rec s evalInstruction instr s rec = evalInstruction (ContextualInstruction instr "<unknown>") s rec |