escape strings in scheme

the characters \, ", and everything below space or above ~ are replaced
with a \xdd;-style escape inside string literals

lib/Quox/Untyped/Scheme.idr

@@ -278,6 +278,29 @@ prelude = """
 ;;;;;;
 """
 
+export
+toHex : Int -> String
+toHex x =
+  case toHex' x of
+    [<] => "0"
+    cs  => concatMap singleton cs
+where
+  toHex' : Int -> SnocList Char
+  toHex' x =
+    if x == 0 then [<] else
+    let d = x `div` 16
+        m = x `mod` 16 in
+    toHex' (assert_smaller x d) :<
+    assert_total strIndex "0123456789abcdef" m
+
+export
+escape : String -> String
+escape = concatMap esc1 . unpack where
+  esc1 : Char -> String
+  esc1 c = if c < ' ' || c > '~' || c == '\\' || c == '"'
+              then "\\x" ++ toHex (ord c) ++ ";"
+              else singleton c
+
 export covering
 defToScheme : Name -> Definition -> Eff Scheme (Maybe Sexp)
 defToScheme x ErasedDef = pure Nothing
@@ -343,7 +366,7 @@ prettySexp (L (x :: xs)) = do
 prettySexp (Q (V x)) = hl Tag $ "'" <+> prettyId' x
 prettySexp (Q x) = pure $ hcat [!(hl Tag "'"), !(prettySexp x)]
 prettySexp (N n) = hl Tag $ pshow n
-prettySexp (S s) = prettyStrLit s
+prettySexp (S s) = prettyStrLit $ escape s
 prettySexp (Lambda xs e) = prettyLambda "lambda" xs e
 prettySexp (LambdaC xs e) = prettyLambda "lambda%" xs e
 prettySexp (Let x rhs e) = prettyLet [< (x, rhs)] e