From d72c220e647d42974f4449e775dd9ded57f1a63c Mon Sep 17 00:00:00 2001
From: Brian Huffman <huffman@galois.com>
Date: Mon, 3 Aug 2015 14:46:38 -0700
Subject: [PATCH] Add commands set_base and set_ascii for pretty-printing
 options.

This is one step towards fixing issues #28 and #29. So far, users
can set these values but the pretty printer does not use them yet.
---
 src/SAWScript/Interpreter.hs | 20 ++++++++++++++++++++
 src/SAWScript/Value.hs       |  5 ++++-
 2 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/src/SAWScript/Interpreter.hs b/src/SAWScript/Interpreter.hs
index a044f4e944..530ab055b2 100644
--- a/src/SAWScript/Interpreter.hs
+++ b/src/SAWScript/Interpreter.hs
@@ -308,6 +308,7 @@ buildTopLevelEnv opts =
                    , rwTypes    = tm0
                    , rwDocs     = primDocEnv
                    , rwCryptol  = ce0
+                   , rwPPOpts   = defaultPPOpts
                    }
        return (bic, ro0, rw0)
 
@@ -326,6 +327,16 @@ include_value file = do
   rw' <- io $ interpretFile ro rw file
   putTopLevelRW rw'
 
+set_ascii :: Bool -> TopLevel ()
+set_ascii b = do
+  rw <- getTopLevelRW
+  putTopLevelRW rw { rwPPOpts = (rwPPOpts rw) { ppOptsAscii = b } }
+
+set_base :: Int -> TopLevel ()
+set_base b = do
+  rw <- getTopLevelRW
+  putTopLevelRW rw { rwPPOpts = (rwPPOpts rw) { ppOptsBase = b } }
+
 print_value :: Value -> TopLevel ()
 print_value (VString s) = io $ putStrLn s
 print_value (VTerm t) = do
@@ -422,6 +433,15 @@ primitives = Map.fromList
     (pureVal envCmd)
     [ "Print all sawscript values in scope." ]
 
+  , prim "set_ascii"           "Bool -> TopLevel ()"
+    (pureVal set_ascii)
+    [ "Select whether to pretty-print arrays of 8-bit numbers as ascii strings." ]
+
+  , prim "set_base"            "Int -> TopLevel ()"
+    (pureVal set_base)
+    [ "Set the number base for pretty-printing numeric literals."
+    , "Permissible values include 2, 8, 10, and 16." ]
+
   , prim "print"               "{a} a -> TopLevel ()"
     (pureVal print_value)
     [ "Print the value of the given expression." ]
diff --git a/src/SAWScript/Value.hs b/src/SAWScript/Value.hs
index d679ec0f95..a27d684a2e 100644
--- a/src/SAWScript/Value.hs
+++ b/src/SAWScript/Value.hs
@@ -112,10 +112,12 @@ isVUnit _ = False
 
 data PPOpts = PPOpts
   { ppOptsAnnotate :: Bool
+  , ppOptsAscii :: Bool
+  , ppOptsBase :: Int
   }
 
 defaultPPOpts :: PPOpts
-defaultPPOpts = PPOpts False
+defaultPPOpts = PPOpts False False 10
 
 commaSep :: [ShowS] -> ShowS
 commaSep ss = foldr (.) id (intersperse (showString ",") ss)
@@ -232,6 +234,7 @@ data TopLevelRW =
   , rwTypes   :: Map SS.LName SS.Schema
   , rwDocs    :: Map SS.Name String
   , rwCryptol :: CEnv.CryptolEnv SAWCtx
+  , rwPPOpts  :: PPOpts
   }
 
 newtype TopLevel a = TopLevel (ReaderT TopLevelRO (StateT TopLevelRW IO) a)