summaryrefslogtreecommitdiff
path: root/debugger.hs
diff options
context:
space:
mode:
Diffstat (limited to 'debugger.hs')
-rw-r--r--debugger.hs89
1 files changed, 89 insertions, 0 deletions
diff --git a/debugger.hs b/debugger.hs
new file mode 100644
index 0000000..2fdaa3b
--- /dev/null
+++ b/debugger.hs
@@ -0,0 +1,89 @@
+import Control.Applicative
+import Control.Monad
+import Control.Monad.ST
+import Data.STRef
+import Data.Array.Unboxed
+import Data.Array.ST
+import Data.Char
+import Data.Chatty.AVL
+import Data.List
+import System.Environment
+import qualified Text.CTPL0 as Old
+import qualified Text.CTPL0n as New
+
+debugOld :: String -> String -> IO ()
+debugOld prog str =
+ let state0 = Old.CTPL0State buffer0 program0 register0 info0
+ buffer0
+ | null str = Old.BufferState [] (chr 3) []
+ | otherwise = Old.BufferState [] (head str) (tail str ++ [chr 3])
+ program0
+ | null prog = Old.BufferState [] (chr 3) []
+ | otherwise = Old.BufferState [] (head prog) (tail prog ++ [chr 3])
+ register0 = Old.RegisterState 0 [] [length prog] [0] False
+ info0 = Old.InfoState EmptyAVL
+ imprf avl = sortBy (\b a -> snd a `compare` snd b) $ avlInorder avl
+ in debugOldProg 10000 state0
+
+debugOldProg :: Int -> Old.CTPL0State -> IO ()
+debugOldProg limit state =
+ let prst (Old.CTPL0State b p r f) i m =
+ putStrLn (show (Old.unetx (reverse (Old.leftBehind b) ++ [Old.thisChar b] ++ Old.rightPending b)) ++ " I="++show i++" AX="++show (Old.ax r)++" CK="++concat(intersperse ":" (map show $ Old.ck r))++" IP=" ++ show (length $ Old.leftBehind p)++ " BP="++ show (length $ Old.leftBehind b) ++ " | "++m)
+ in case Old.runCTPL0 Old.endOfInstr limit state of
+ Old.Succ (True, st, i) -> prst st i "Program finished."
+ Old.Succ (False, st, i) ->
+ case Old.runCTPL0 Old.singleInstr limit state of
+ Old.Succ (_, st, i) -> do
+ prst st i "<>"
+ debugOldProg i st
+ Old.Expired -> putStrLn "Expired."
+ Old.SynViol -> putStrLn "Syntax violation."
+ Old.ConfViol -> putStrLn "Confidence violation."
+
+debugNew :: String -> String -> IO ()
+debugNew prog str = mapM_ putStrLn $ runST $ do
+ let limit = New.maxTime New.safeVM
+ bufsize = max (New.initBufferMeasure New.safeVM) (length str+1)
+ bc <- newListArray (0, bufsize-1) (str++'\3':replicate (bufsize-length str-1) '\0')
+ let pc = listArray (0, length prog - 1) prog
+ state0 = New.CTPL0State (New.MBuffer bc) pc 0 0 False 0 [] [length prog] [0]
+ ref <- newSTRef state0
+ debugNewProg limit ref New.safeVM
+
+debugNewProg :: Int -> STRef s (New.CTPL0State s) -> New.VMConfig -> ST s [String]
+debugNewProg limit state cfg =
+ let prst ref i m = do
+ New.CTPL0State bc pc bp pp cp ax mk rk ck <- readSTRef ref
+ buf <- New.joinBuffer bc
+ return (show buf ++ " I=" ++ show i ++ " AX=" ++ show ax ++ " CK="++concat(intersperse ":" $ map show ck) ++ " IP=" ++ show pp ++ " BP="++show bp++" | "++m)
+ in do
+ r <- New.runCTPL0 New.endOfInstr limit state cfg
+ case r of
+ New.Succ (True, i) -> return <$> prst state i "Program finished."
+ New.Succ (False, i) -> do
+ r <- New.runCTPL0 New.singleInstr limit state cfg
+ case r of
+ New.Succ (_, i) -> (:) <$> prst state i "<>" <*> debugNewProg i state cfg
+ New.Fail f -> return [show f]
+
+main = do
+ args <- getArgs
+ case args of
+ ["--old", progf, buff] -> do
+ prog <- readFile progf
+ buf <- readFile buff
+ debugOld (init prog) (init buf)
+ ["--new", progf, buff] -> do
+ prog <- readFile progf
+ buf <- readFile buff
+ debugNew (init prog) (init buf)
+ ["--help"] -> do
+ putStrLn "ctpl0debug 0.1"
+ putStrLn "----------------"
+ putStrLn "A debugger for CTPL0 (both VMs)"
+ putStrLn "Synapsis:"
+ putStrLn " ctpl0debug --old <program-file> <input-file>"
+ putStrLn " Debugs execution with the old VM"
+ putStrLn " ctpl0debug --new <program-file> <input-file>"
+ putStrLn " Debugs execution with the new VM"
+ _ -> putStrLn "Don't know what to do. See --help for help"