diff --git a/hwhile.cabal b/hwhile.cabal --- a/hwhile.cabal +++ b/hwhile.cabal @@ -1,5 +1,5 @@ name: hwhile -version: 0.1.1.1 +version: 0.1.1.2 synopsis: An implementation of Neil D. Jones' While language license: GPL-3 license-file: LICENSE diff --git a/src/exec/Main.hs b/src/exec/Main.hs --- a/src/exec/Main.hs +++ b/src/exec/Main.hs @@ -26,7 +26,7 @@ badArgsMessage = "Invalid argument(s) supplied. Run 'hwhile -h' for help." versionMessage :: String -versionMessage = "HWhile version 0.1.1.1" +versionMessage = "HWhile version 0.1.1.2" helpMessage :: String helpMessage = concat $ (intersperse "\n") $ diff --git a/src/lib/InterSyntax.hs b/src/lib/InterSyntax.hs --- a/src/lib/InterSyntax.hs +++ b/src/lib/InterSyntax.hs @@ -51,3 +51,13 @@ , S.unions (map (\(e, b) -> S.union (namesExpr e) (namesInBlock b)) eb) , namesInBlock b ] + +showSnippet :: InCommand -> [String] +showSnippet inComm = case inComm of + InAssign _ n e -> [show n ++ " := " ++ show e] + InWhile _ e _ -> ["while " ++ show e ++ " { ..."] + InIfElse _ e _ _ -> ["if " ++ show e ++ " { ..."] + InSwitch _ e [] _ -> + ["switch " ++ show e ++ " { ...", " default: ..."] + InSwitch _ e ((gd, _):_) _ -> + ["switch " ++ show e ++ " { ...", " case " ++ show gd ++ ": ..."] diff --git a/src/lib/REPL.hs b/src/lib/REPL.hs --- a/src/lib/REPL.hs +++ b/src/lib/REPL.hs @@ -73,7 +73,12 @@ Left err -> replPutStrLn err Right comm -> do store <- getStore - putStore $ evalInBlock store comm + -- Here we use $! to force strict evaluation of + -- the expression 'evalInBlock store comm'. This + -- means that infinite loops make the REPL hang + -- right now, rather than next time the store is + -- used. + putStore $! evalInBlock store comm Right exp -> do store <- getStore replPutStrLn $ printFn $ evalExpr store exp @@ -164,7 +169,7 @@ printFn <- getPrintFn let output = intercalate "\n" $ map (\(Name (fp, n), tree) -> - "(" ++ fp ++ ") " ++ n ++ " := " ++ printFn tree) $ + "(" ++ fp ++ ") " ++ n ++ " = " ++ printFn tree) $ M.assocs store replPutStrLn output @@ -182,6 +187,15 @@ replPutStrLn msg break :: [String] -> REPL () +break [] = do + bps <- getBreakpoints + if S.null bps then do + replPutStrLn "No breakpoints set." + else do + let output = intercalate "\n" $ map (\(fp, n) -> + "Program '" ++ fp ++ "', line " ++ show n ++ ".") $ S.toList bps + replPutStrLn "Current breakpoints:" + replPutStrLn output break [lineStr] = do fp <- getCurrentFilePath ; doBreak fp (readMaybe lineStr) break [lineStr, fp] = doBreak fp (readMaybe lineStr) break _ = replPutStrLn $ @@ -248,8 +262,10 @@ Left inComm : _ -> case info inComm of Info i@(fp, line) -> if S.member i bps then - (store', blk', "Stopping at line " ++ show line ++ - " of program " ++ fp ++ ".") + (store', blk', "Hit breakpoint.\n" ++ fp ++ + ", line " ++ show line ++ ":\n" ++ + (concat (intersperse "\n" (map (" | " ++) + (showSnippet inComm))))) else runToBreakpoint store' bps blk' printFn @@ -257,32 +273,42 @@ (Store, [Either InCommand DebugOp], String) doStep store [] printFn = (store, [], "No program loaded.") doStep store (comm : rest) printFn = case comm of - Left (InAssign _ n e) -> let evalE = evalExpr store e in - (M.insert n evalE store, rest, show n ++ " := " ++ printFn evalE) - Left (InWhile _ gd blk) -> case evalExpr store gd of + Left (InAssign i n e) -> let evalE = evalExpr store e in + (M.insert n evalE store, rest, + fileInfo i ++ ", line " ++ show (lineInfo i) ++ ":\n | " ++ + show n ++ " := " ++ show e ++ "\n" ++ show n ++ " = " ++ + printFn evalE) + Left (InWhile i gd blk) -> case evalExpr store gd of ENil -> (store, rest, "Skipped or exited while-loop.") _ -> (store, (map Left blk) ++ (comm : rest), - "while " ++ show gd ++ " { ...\nEntered or re-entered while-loop.") - Left (InIfElse _ gd tb fb) -> case evalExpr store gd of - ENil -> (store, (map Left fb) ++ rest, - "if " ++ show gd ++ " { ...\nTook if-branch.") - _ -> (store, (map Left tb) ++ rest, - "if " ++ show gd ++ " { ...\nTook else-branch or skipped.") - Left (InSwitch _ gd [] def) -> + fileInfo i ++ ", line " ++ show (lineInfo i) ++ ":\n | while " ++ + show gd ++ " { ...\nEntered or re-entered while-loop.") + Left (InIfElse i gd tb fb) -> case evalExpr store gd of + ENil -> (store, (map Left fb) ++ rest, fileInfo i ++ ", line " ++ + show (lineInfo i) ++ ":\n | if " ++ show gd ++ + " { ...\nTook if-branch.") + _ -> (store, (map Left tb) ++ rest, fileInfo i ++ ", line " ++ + show (lineInfo i) ++ ":\n | if " ++ show gd ++ + " { ...\nTook else-branch or skipped.") + Left (InSwitch i gd [] def) -> (store, (map Left def) ++ rest, - "switch " ++ show gd ++ " { ... \nTook default case.") + fileInfo i ++ ", line " ++ show (lineInfo i) ++ + ":\n | switch " ++ show gd ++ + " { ... \n | default:\nTook default case.") Left (InSwitch i gd ((e, blk) : cases) def) -> if evalExpr store gd == evalExpr store e then (store, (map Left blk) ++ rest, - "switch " ++ show gd ++ " { ...\n case " ++ show e ++ - ": ...\nTook switch-case.") + fileInfo i ++ ", line " ++ show (lineInfo i) ++ + ":\n | switch " ++ show gd ++ " { ...\n | case " ++ + show e ++ ": ...\nTook switch-case.") else (store, Left (InSwitch i gd cases def) : rest, - "switch " ++ show gd ++ " { ...\n case " ++ show e ++ - ": ...\nSkipped switch-case.") + fileInfo i ++ ", line " ++ show (lineInfo i) ++ + ":\n | switch " ++ show gd ++ " { ...\n | case " ++ + show e ++ ": ...\nSkipped switch-case.") Right (WhileRead n arg) -> (M.insert n arg store, rest, "read " ++ - show n ++ " := " ++ printFn arg) - Right (WhileWrite n) -> (store, rest, "wrote " ++ show n ++ " := " ++ + show n ++ " = " ++ printFn arg) + Right (WhileWrite n) -> (store, rest, "wrote " ++ show n ++ " = " ++ (printFn (M.findWithDefault ENil n store))) Right (Message m) -> (store, rest, m) @@ -421,6 +447,7 @@ , " :cd dir - Change the current file search path to 'dir'." , " :break n - Add a breakpoint to line 'n' of the loaded program." , " :break n p - Add a breakpoint to line 'n' of program 'p'." + , " :break - Print all breakpoints." , " :delbreak n - Delete the breakpoint on line 'n' of the loaded" , " program." , " :delbreak n p - Delete the breakpoint on line 'n' of program 'p'." diff --git a/src/lib/SugarSyntax.hs b/src/lib/SugarSyntax.hs --- a/src/lib/SugarSyntax.hs +++ b/src/lib/SugarSyntax.hs @@ -12,7 +12,13 @@ type SuBlock = [SuCommand] -newtype Info = Info (FilePath, Int) deriving (Show, Eq, Ord) +newtype Info = Info { getInfo :: (FilePath, Int) } deriving (Show, Eq, Ord) + +fileInfo :: Info -> FilePath +fileInfo = fst . getInfo + +lineInfo :: Info -> Int +lineInfo = snd. getInfo -- The sugared command syntax - has conditionals, macros and switches in -- addition to the pure syntax commands.