From a26f7a79b4188669b8dd3a77a08469c6d59a0b17 Mon Sep 17 00:00:00 2001
From: ben <types@ccs.neu.edu>
Date: Sat, 12 Dec 2015 22:22:04 -0500
Subject: [PATCH] [format] change naming, fix broken format sequences, add
 typechecking

---
 format.rkt | 87 +++++++++++++++++++++++++++---------------------------
 1 file changed, 43 insertions(+), 44 deletions(-)

diff --git a/format.rkt b/format.rkt
index ff5bd48..c0e0361 100644
--- a/format.rkt
+++ b/format.rkt
@@ -1,7 +1,7 @@
 #lang typed/racket/base
 
 (provide
-  format!
+  format:
   ;; (-> (x:String) Any *N Void)
   ;; Takes 1 required string argument and N additional arguments,
   ;;  where N is the number of format sequences in the string.
@@ -11,7 +11,7 @@
   ;;
   ;; If the string is not a literal, arity-checking happens at runtime.
 
-  printf!
+  printf:
   ;; (-> (x:String) Any *N Void)
   ;; Similar to `format`, but displays the formatted string to `current-output-port`.
 )
@@ -21,71 +21,70 @@
 
 ;; =============================================================================
 
-(define-syntax format!
+(define-syntax format:
   (syntax-parser
    [(f template:str arg* ...)
-    (let ([num-expected (count-format-escapes (syntax-e #'template))]
-          [num-given (for/sum ([a (in-syntax #'(arg* ...))]) 1)])
+    ;; 1. Parse expected types from the template
+    (let* ([type* (template->type* (syntax-e #'template) #:src #'f)]
+           [num-expected (length type*)]
+           [num-given (for/sum ([a (in-syntax #'(arg* ...))]) 1)])
       (unless (= num-expected num-given)
         (raise-arity-error
           (syntax-e #'f)
           num-expected
           (for/list ([a (in-syntax #'(arg* ...))]) (syntax->datum a))))
-      (syntax/loc #'f (format template arg* ...)))]
+      ;; 2. If any types left obligations, use `ann` to typecheck the args
+      (let ([arg+*
+                    (for/list ([a (in-syntax #'(arg* ...))]
+                               [t (in-list type*)])
+                      (if t (quasisyntax/loc #'f (ann #,a #,t)) a))])
+        (quasisyntax/loc #'f
+          (format template #,@arg+*))))]
    [(f tmp arg* ...)
     (syntax/loc #'f (format tmp arg* ...))]))
 
-(define-syntax-rule (printf! arg* ...)
-  (display (format! arg* ...)))
+(define-syntax-rule (printf: arg* ...)
+  (display (format: arg* ...)))
+
+;; -----------------------------------------------------------------------------
 
 ;; Count the number of format escapes in a string.
-(define-for-syntax (count-format-escapes str)
+;; Returns a list of optional types (to be spliced into the source code)
+;; Example: If result is '(#f Integer), then
+;; - Expect 2 arguments to format string
+;; - First argument has no constraints, second must be an Integer
+;; (: count-format-escapes (->* [String] [#:src (U #f Syntax)] (Listof (U #f Syntax))))
+(define-for-syntax (template->type* str #:src [stx #f])
   (define last-index (- (string-length str) 1))
-  (let loop ([i 0] [acc 0])
+  (let loop ([i 0] [acc '()])
     (cond
      [(>= i last-index)
-      acc]
+      (reverse acc)]
      [(eq? #\~ (string-ref str i))
       ;; From fprintf docs
       (case (string-ref str (+ i 1))
-       [(#\n #\% #\a #\A #\v #\V #\e #\E #\c #\C #\b #\B #\o #\O #\x #\X #\space #\tab #\newline)
-        (loop (+ i 2) (+ 1 acc))]
+       [(#\% #\n #\~ #\space #\tab #\newline)
+        ;; Need 0 arguments
+        (loop (+ i 2) acc)]
+       [(#\a #\A #\s #\S #\v #\V #\e #\E)
+        ;; Need 1 argument, can be anything
+        (loop (+ i 2) (cons #f acc))]
        [(#\.)
+        ;; Need at most 1, can be anything
         (if (and (< (+ 1 i) last-index)
                  (memq (string-ref str (+ i 2)) '(#\a #\A #\s #\S #\v #\V)))
-          (loop (+ i 3) (+ 1 acc))
+          (loop (+ i 3) (cons #f acc))
           (loop (+ i 3) acc))]
+       [(#\c #\C)
+        ;; Need 1 `char?`
+        (loop (+ i 2) (cons (syntax/loc stx Char) acc))]
+       [(#\b #\B #\o #\O #\x #\X)
+        ;; Need 1 `exact?`
+        (loop (+ i 2) (cons (syntax/loc stx Exact-Number) acc))]
        [else
-        (loop (+ i 2) acc)])]
+        ;; Invalid format sequence
+        (raise-user-error "format: unrecognized pattern string '~~~c'"
+          (string-ref str (+ i 1)))])]
      [else
       (loop (+ i 1) acc)])))
 
-;; =============================================================================
-
-(module+ test (begin-for-syntax
-
-  (require
-    rackunit)
-
-  ;; --- count-format-escapes
-  (define-syntax-rule (test-escapes [str n] ...)
-    (begin
-      (check-equal? (count-format-escapes str) n) ...))
-
-  (test-escapes
-   ["" 0]
-   ["hello" 0]
-   ["world" 0]
-   ["~~ nope" 0]
-   ["~" 0]
-   ["\\~~" 0]
-   ["~~~~" 0]
-   ["hey ~.x you" 0]
-   ;; --
-   ["hello, ~a" 1]
-   ["~a ~b ~c" 3]
-   ["~\n ~%" 2]
-   ["~a ~A ~v ~V ~e ~E ~c ~C ~b ~B ~o ~O ~x ~X" 14]
-   ["~ " 1])
-))
-