From 10a5663ddff61e11f95f773802cc0e2679ca2cfb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@gmail.com>
Date: Tue, 10 Jan 2017 15:54:34 +0100
Subject: [PATCH] Cleaned up hiding/restoring comments, partially typed

---
 comment-reader.rkt                         |   6 -
 comments/hide-comments.rkt                 |  75 +++++++
 comments/restore-comments.rkt              | 130 +++++++++++++
 comments/syntax-properties-typed.rkt       |  47 +++++
 comments/syntax-properties.rkt             |  37 ++++
 comments/typed-syntax-convert.rkt          | 216 +++++++++++++++++++++
 comments/typed-syntax-predicate.rkt        |  52 +++++
 comments/typed-syntax.rkt                  |  10 +
 lang/meta-first-line.rkt                   |   9 +-
 restore-comments.rkt                       |   2 +-
 test/comments/annotate-syntax-typed.rkt    |  65 +++++++
 test/comments/annotate-syntax.rkt          |  52 +++++
 test/comments/same-syntax.rkt              |  25 +++
 test/comments/test-comments-round-trip.rkt |  55 ++++++
 14 files changed, 769 insertions(+), 12 deletions(-)
 create mode 100644 comments/hide-comments.rkt
 create mode 100644 comments/restore-comments.rkt
 create mode 100644 comments/syntax-properties-typed.rkt
 create mode 100644 comments/syntax-properties.rkt
 create mode 100644 comments/typed-syntax-convert.rkt
 create mode 100644 comments/typed-syntax-predicate.rkt
 create mode 100644 comments/typed-syntax.rkt
 create mode 100644 test/comments/annotate-syntax-typed.rkt
 create mode 100644 test/comments/annotate-syntax.rkt
 create mode 100644 test/comments/same-syntax.rkt
 create mode 100644 test/comments/test-comments-round-trip.rkt

diff --git a/comment-reader.rkt b/comment-reader.rkt
index 931856d5..2b0ac644 100644
--- a/comment-reader.rkt
+++ b/comment-reader.rkt
@@ -52,12 +52,6 @@
                       recur
                       #:comment-wrapper [comment-wrapper 'code:comment]
                       #:unsyntax [unsyntax? #t])
-    #;(let loop ()
-        (when (equal? #\; (peek-char port))
-          (read-char port)
-          (loop)))
-    #;(when (equal? #\space (peek-char port))
-        (read-char port))
     (define comment-text
       `(t
         ,@(append-strings
diff --git a/comments/hide-comments.rkt b/comments/hide-comments.rkt
new file mode 100644
index 00000000..613bead8
--- /dev/null
+++ b/comments/hide-comments.rkt
@@ -0,0 +1,75 @@
+#lang racket
+
+(require (rename-in syntax/parse [...+ …+])
+         syntax/stx
+         racket/match
+         racket/set
+         racket/list
+         racket/function
+         racket/vector
+         racket/contract
+         sexp-diff
+         racket/pretty
+         rackunit
+         (only-in racket/base [... …])
+         (for-syntax (rename-in racket/base [... …]))
+         "syntax-properties.rkt")
+
+(provide hide-#%comment)
+
+;;    ([#%comment c1] a [#%comment c2] . ([#%comment c3] b [#%comment c4]))
+;; => (aᶜ² . (bᶜ⁴)⁻ᶜ³)⁻ᶜ¹
+;;    (c1 a c2 . (c3 . (c4 b c5)))
+;; => (aᶜ² . (bᶜ⁵)⁻ᶜ³⁻⁻ᶜ⁴)⁻ᶜ¹
+;;    (c1 a c2 . (c3 . (c4 c5)))
+;; => (aᶜ² . ()⁻ᶜ³⁻⁻ᶜ⁴ᶜ⁵)⁻ᶜ¹
+;;    (c1 a (c2) b)
+;; => (a ()⁻ᶜ² b)⁻ᶜ¹
+;;    (c1 a (c2 . b) c)
+;; => (a b⁻ᶜ² c)⁻ᶜ¹
+;;    (c1 a (c2 . (c3 c4)) c)
+;; => (a ()⁻ᶜ²⁻⁻ᶜ³ᶜ⁴ c)⁻ᶜ¹
+(define (hide-#%comment stx)
+  (match (syntax-e stx)
+    [(not (? pair?))
+     ;; TODO: recurse down vectors etc.
+     stx]
+    [(list* e* ... rest)
+     (syntax-parse e*
+       #:datum-literals (#%comment)
+       [({~and c₀ [#%comment . _]} …
+         {~seq {~and eᵢ {~not [#%comment . _]}}
+               {~and cᵢⱼ [#%comment . _]} …}
+         …+)
+        (define new-e* (map with-comments-after
+                            (map hide-#%comment
+                                 (syntax->list #'(eᵢ …)))
+                            (map syntax->list
+                                 (syntax->list #'((cᵢⱼ …) …)))))
+        (define new-rest (if (null? rest)
+                             rest
+                             (hide-#%comment rest)))
+        (with-first-comments
+         (datum->syntax stx (append new-e* new-rest) stx stx)
+         (cons #f (syntax->list #'(c₀ …))))]
+       [({~and c₀ [#%comment . _]} …)
+        (define new-rest (if (null? rest)
+                             rest
+                             (hide-#%comment rest)))
+        (with-first-comments
+         (with-comments-after
+          (datum->syntax stx new-rest stx stx)
+          (if (syntax? new-rest)
+              (syntax-property new-rest 'comments-after)
+              '()))
+         (cons (if (syntax? new-rest)
+                   (cons (datum->syntax new-rest
+                                        'saved-props+srcloc
+                                        new-rest
+                                        new-rest)
+                         (or (syntax-property new-rest 'first-comments)
+                             ;; TODO: I'm dubious about this, better typecheck
+                             ;; everything…
+                             (cons #f null)))
+                   #f)
+               (syntax->list #'(c₀ …))))])]))
\ No newline at end of file
diff --git a/comments/restore-comments.rkt b/comments/restore-comments.rkt
new file mode 100644
index 00000000..aab3a3fa
--- /dev/null
+++ b/comments/restore-comments.rkt
@@ -0,0 +1,130 @@
+#lang racket
+
+(require (rename-in syntax/parse [...+ …+])
+         syntax/stx
+         racket/match
+         racket/set
+         racket/list
+         racket/function
+         racket/vector
+         racket/contract
+         sexp-diff
+         racket/pretty
+         rackunit
+         (only-in racket/base [... …])
+         (for-syntax (rename-in racket/base [... …]))
+         "syntax-properties.rkt")
+
+(provide restore-#%comment)
+
+(define/contract (restore-#%comment stx
+                                      #:replace-with (replace-with #f)
+                                      #:scope [scope (datum->syntax #f 'zero)])
+    (->* (syntax?)
+         (#:replace-with [or/c #f syntax? (-> syntax? syntax?)]
+          #:scope identifier?)
+         syntax?)
+    (define (erase-props stx)
+      (define stx* (if (syntax-property stx 'first-comments)
+                       (syntax-property stx 'first-comments #f)
+                       stx))
+      (if (syntax-property stx* 'comments-after)
+          (syntax-property stx* 'comments-after #f)
+          stx*))
+    (define (recur stx)
+      (restore-#%comment stx #:replace-with replace-with #:scope scope))
+    (define (replace-in commentᵢ)
+      (syntax-parse commentᵢ
+        #:datum-literals (#%comment)
+        [({~and c #%comment} . rest)
+         (if (syntax? replace-with)
+             (datum->syntax commentᵢ
+                            `(,(datum->syntax #'c replace-with #'c #'c)
+                              . ,((make-syntax-delta-introducer
+                                   scope
+                                   (datum->syntax #f 'zero))
+                                  #'rest
+                                  'add))
+                            commentᵢ
+                            commentᵢ)
+             (replace-with
+              (datum->syntax commentᵢ
+                             `(,#'c
+                               . ,((make-syntax-delta-introducer
+                                    scope
+                                    (datum->syntax #f 'zero))
+                                   #'rest
+                                   'add))
+                             commentᵢ
+                             commentᵢ)))]
+        [_
+         commentᵢ]))
+    (define (replace-in-after comments)
+      (if replace-with
+          (if (eq? comments #f)
+              comments
+              (stx-map replace-in comments))
+          comments))
+    (define (replace-in-first first-comments)
+      (define (replace-in-first1 first-comments)
+        (if (eq? first-comments #f)
+            first-comments
+            (cons (cons (caar first-comments)
+                        (replace-in-first1 (cdar first-comments)))
+                  (stx-map replace-in (cdr first-comments)))))
+      (if replace-with
+          (if (eq? first-comments #f)
+              first-comments
+              (cons (replace-in-first1 (car first-comments))
+                    (stx-map replace-in (cdr first-comments))))
+          first-comments))
+    (match (syntax-e stx)
+      [(list* e* ... rest)
+       ;; TODO: when extracting the comments properties, check that they have
+       ;; the right shape (listof syntax?) or (*list/c syntax? (list/c R))
+       ;; Or append-map when stx is a stx-list (not in a tail position for the
+       ;;                                       comments-after)
+       (define new-e*
+         (append-map (λ (eᵢ)
+                       (cons (recur eᵢ)
+                             (or (replace-in-after (extract-comments-after eᵢ))
+                                 '())))
+                     e*))
+       (define new-rest
+         (if (syntax? rest)
+             (recur rest)
+             ;; TODO: handle vectors etc. here?
+             rest))
+       (define first-comments
+         (or (replace-in-first (extract-first-comments stx))
+             #f))
+       (define (nest first-comments to-nest)
+         (cond
+           [(eq? first-comments #f)
+            to-nest]
+           [(eq? (car first-comments) #f)
+            (append (cdr first-comments) to-nest)]
+           [else
+            (nest1 first-comments to-nest)]))
+       (define (nest1 first-comments to-nest)
+         (if (eq? first-comments #f)
+             to-nest
+             (append (cdr first-comments)
+                     (datum->syntax (caar first-comments)
+                                    (nest (cdar first-comments) to-nest)))))
+       (define new-stx
+         (nest first-comments (append new-e* new-rest)))
+       (erase-props (datum->syntax stx new-stx stx stx))]
+      ;; TODO: recurse down vectors etc.
+      [(? vector? v)
+       ;; TODO: what if there is a first-comment property on the vector itself?
+       (erase-props
+        (datum->syntax stx
+                       (vector-map (λ (vᵢ)
+                                     (recur vᵢ))
+                                   v)
+                       stx
+                       stx))]
+      [other
+       'TODO…
+       other]))
\ No newline at end of file
diff --git a/comments/syntax-properties-typed.rkt b/comments/syntax-properties-typed.rkt
new file mode 100644
index 00000000..f2c76f09
--- /dev/null
+++ b/comments/syntax-properties-typed.rkt
@@ -0,0 +1,47 @@
+#lang typed/racket
+
+(provide First-Comments
+         Comments-After
+         with-first-comments
+         with-comments-after
+         extract-first-comments
+         extract-comments-after)
+
+(define-type First-Comments
+  (Rec R (Pairof (U #f (Pairof (Syntaxof 'saved-props+srcloc)
+                               R))
+                 (Listof (Syntaxof Any)))))
+
+(define-type Comments-After
+  (Listof (Syntaxof Any)))
+
+(: with-first-comments (∀ (A) (→ (Syntaxof A)
+                                 (U #f First-Comments)
+                                 (Syntaxof A))))
+(define (with-first-comments e c)
+    
+  (if (or (not c) (and (= (length c) 1) (not (first c))))
+      e
+      (syntax-property e 'first-comments c)))
+
+(: with-comments-after (∀ (A) (→ (Syntaxof A)
+                                 (U #f Comments-After)
+                                 (Syntaxof A))))
+(define (with-comments-after e c)
+  (if (or (not c) (null? c))
+      e
+      (syntax-property e 'comments-after c)))
+
+(: extract-first-comments (-> (Syntaxof Any) (U #f First-Comments)))
+(define (extract-first-comments stx)
+  (define c (syntax-property stx 'first-comments))
+  (if ((make-predicate First-Comments) c)
+      c
+      #f))
+
+(: extract-comments-after (-> (Syntaxof Any) (U #f Comments-After)))
+(define (extract-comments-after stx)
+  (define c (syntax-property stx 'comments-after))
+  (if ((make-predicate Comments-After) c)
+      c
+      #f))
\ No newline at end of file
diff --git a/comments/syntax-properties.rkt b/comments/syntax-properties.rkt
new file mode 100644
index 00000000..db1fbb4d
--- /dev/null
+++ b/comments/syntax-properties.rkt
@@ -0,0 +1,37 @@
+#lang racket
+
+(provide first-comments/c
+         comments-after/c
+         with-first-comments
+         with-comments-after
+         extract-first-comments
+         extract-comments-after)
+
+(define first-comments/c
+  (flat-rec-contract R (cons/c (or/c #f (cons/c (syntax/c 'saved-props+srcloc)
+                                                R)) #| nested |#
+                               (listof syntax?) #| comments |#)))
+(define comments-after/c
+  (listof syntax?))
+
+(define/contract (with-first-comments e c)
+    (-> syntax?
+        (or/c #f first-comments/c)
+        syntax?)
+    (if (or (not c) (and (= (length c) 1) (not (first c))))
+        e
+        (syntax-property e 'first-comments c)))
+
+(define/contract (with-comments-after e c)
+    (-> syntax? (or/c #f comments-after/c) syntax?)
+    (if (or (not c) (null? c))
+        e
+        (syntax-property e 'comments-after c)))
+
+(define/contract (extract-first-comments stx)
+    (-> syntax? (or/c #f first-comments/c))
+    (syntax-property stx 'first-comments))
+
+  (define/contract (extract-comments-after stx)
+    (-> syntax? (or/c #f comments-after/c))
+    (syntax-property stx 'comments-after))
\ No newline at end of file
diff --git a/comments/typed-syntax-convert.rkt b/comments/typed-syntax-convert.rkt
new file mode 100644
index 00000000..6d77cecf
--- /dev/null
+++ b/comments/typed-syntax-convert.rkt
@@ -0,0 +1,216 @@
+#lang typed/racket
+
+(require typed-map
+         typed/racket/unsafe)
+
+(provide try-any->isexp*
+         try-any->isexp
+         any->isexp+non-sexp
+         NonSexpOf)
+
+(unsafe-require/typed racket/function
+                      [[identity unsafe-cast-function] (∀ (A) (→ Any A))])
+(unsafe-require/typed racket/base
+                      [[datum->syntax datum->syntax*]
+                       (∀ (A) (→ (Syntaxof Any)
+                                 A
+                                 (Syntaxof Any)
+                                 (Syntaxof Any)
+                                 (Syntaxof A)))])
+
+(define-syntax-rule (unsafe-cast v t)
+  ((inst unsafe-cast-function t) v))
+
+(define-type (non-sexp-handler A)
+  (→ Any
+     (Values (U (Sexpof A) #f)
+             (U 'unmodified 'modified #f))))
+
+(: try-listof-any->isexp* (∀ (A) (→ (Listof Any)
+                                    (non-sexp-handler A)
+                                    (U (Pairof (Listof (Sexpof A))
+                                               (U 'unmodified 'modified))
+                                       (Pairof #f #f)))))
+
+(define (try-listof-any->isexp* e non-sexp)
+  (define e+status*
+    (map (λ ([eᵢ : Any])
+           (let-values ([(eᵢ* status) (try-any->isexp* eᵢ non-sexp)])
+             (cons eᵢ* status)))
+         e))
+  (define e* (map car e+status*))
+  (define status* (map cdr e+status*))
+  (cond
+    [(andmap (curry eq? 'unmodified) status*)
+     (cons (unsafe-cast e (Listof (Sexpof A))) 'unmodified)]
+    [(ormap (curry eq? #f) status*)
+     (cons #f #f)]
+    [else
+     (cons e* 'modified)]))
+
+(: try-any->isexp* (∀ (A) (→ Any
+                             (non-sexp-handler A)
+                             (Values (U (Sexpof A) #f)
+                                     (U 'unmodified 'modified #f)))))
+(define (try-any->isexp* e non-sexp)
+  (cond
+    [(boolean? e) (values e 'unmodified)]
+    [(char? e)    (values e 'unmodified)]
+    [(number? e)  (values e 'unmodified)]
+    [(keyword? e) (values e 'unmodified)]
+    [(null? e)    (values e 'unmodified)]
+    [(string? e)  (if (immutable? e)
+                      (values e 'unmodified)
+                      (values (string->immutable-string e) 'modified))]
+    [(symbol? e)  (values e 'unmodified)]
+    [(box? e)     (let*-values ([(u) (unbox e)]
+                                [(u* status) (try-any->isexp* e non-sexp)])
+                    (case status
+                      [(unmodified)
+                       (if (immutable? e)
+                           (values (unsafe-cast e (Sexpof A)) 'unmodified)
+                           (values (box-immutable u*) 'modified))]
+                      [(modified)
+                       (values (box-immutable u*) 'modified)]
+                      [(#f)
+                       (values #f #f)]))]
+    [(pair? e)    (let*-values ([(car* status-car)
+                                 (try-any->isexp* (car e) non-sexp)]
+                                [(cdr* status-cdr)
+                                 (try-any->isexp* (cdr e) non-sexp)])
+                    (cond
+                      [(and (eq? status-car 'unmodified)
+                            (eq? status-cdr 'unmodified))
+                       (values (unsafe-cast e (Sexpof A)) 'unmodified)]
+                      [(or (eq? status-car #f)
+                           (eq? status-cdr #f))
+                       (values #f #f)]
+                      [else
+                       (values (cons car* cdr*) 'modified)]))]
+    [(vector? e)  (match-let ([(cons vs* status)
+                               (try-listof-any->isexp* (vector->list e) non-sexp)])
+                    (case status
+                      [(unmodified)
+                       (if (immutable? e)
+                           (values (unsafe-cast e (Sexpof A)) 'unmodified)
+                           (values (apply vector-immutable vs*) 'modified))]
+                      [(modified)
+                       (values (apply vector-immutable vs*) 'modified)]
+                      [(#f)
+                       (values #f #f)]))]
+    [else
+     (non-sexp e)]))
+
+
+;; Sexp:  
+
+(struct (A) NonSexp ([value : A]) #:type-name NonSexpOf)
+
+(: any->isexp+non-sexp (→ Any (Sexpof (NonSexpOf Any))))
+(define (any->isexp+non-sexp e)
+  (let*-values ([(e* status) (try-any->isexp*
+                              e
+                              (λ (non-sexp-e)
+                                (values (NonSexp non-sexp-e)
+                                        'modified)))])
+    (case status
+      [(unmodified) (unsafe-cast e (Sexpof (NonSexpOf Any)))]
+      [(modified) e*]
+      [(#f)
+       (error
+        (string-append "Got #f from try->any-isexp* using non-sexp which does"
+                       " not return #f."))])))
+
+
+(: try-any->isexp (→ Any (U (List Any) #f)))
+(define (try-any->isexp e)
+  (let*-values ([(e* status) (try-any->isexp*
+                              e
+                              (λ (non-sexp-e)
+                                (values #f #f)))])
+    (case status
+      [(unmodified) (list e)]
+      [(modified) (list e*)]
+      [(#f) #f])))
+
+;; Syntax:
+
+(struct (A) NonSyntax ([value : A]) #:type-name NonSyntaxOf)
+(define-type (SyntaxU A)
+  (Syntaxof (SexpStx A)))
+(define-type (SexpStx A)
+  (Rec sexp (U Boolean
+               Char
+               Complex
+               Keyword
+               Null
+               String
+               Symbol
+               (Boxof sexp)
+               (Pairof sexp sexp)
+               (Vectorof sexp)
+               (Syntaxof sexp)
+               A)))
+
+(: syntax-wrapper (∀ (A) (→ (non-sexp-handler (U A (SyntaxU A)))
+                            (non-sexp-handler (U A (SyntaxU A))))))
+(define (syntax-wrapper nested-wrapper)
+  (: recur (→ Any
+              (Values (U (Sexpof (U A (SyntaxU A))) #f)
+                      (U 'unmodified 'modified #f))))
+  (define (recur e)
+    (cond
+      [(syntax? e)
+       (let-values ([(e* status) (try-any->isexp* (syntax-e e) recur)])
+         (case status
+           [(unmodified) (values (ann (unsafe-cast e (U (SyntaxU A) #f))
+                                      (U (SyntaxU A) #f))'unmodified)]
+           [(modified) (values (datum->syntax* e e* e e) 'modified)]
+           [(#f) (values #f #f)]))]
+      [else (nested-wrapper e)]))
+  recur)
+
+(: any->isexpstx+non-syntax (→ Any (Sexpof (U (NonSyntaxOf Any) (SyntaxU (NonSyntaxOf Any))))))
+(define (any->isexpstx+non-syntax e)
+  (let*-values ([(e* status)
+                 ((inst try-any->isexp* (U (NonSyntaxOf Any) (SyntaxU (NonSyntaxOf Any))))
+                  e
+                  (syntax-wrapper
+                   (λ (non-syntax-e)
+                     (values (NonSyntax non-syntax-e)
+                             'modified))))])
+    (case status
+      [(unmodified) (unsafe-cast e (SyntaxU (NonSyntaxOf Any)))]
+      [(modified) e*]
+      [(#f)
+       (error
+        (string-append "Got #f from try->any-isexp* using non-sexp which does"
+                       " not return #f."))])))
+
+;; TODO: this duplicates parts of any->isexpstx+non-syntax and syntax-wrapper.
+(: syntax->isyntax+non-syntax (→ Syntax (SyntaxU (NonSyntaxOf Any))))
+(define (syntax->isyntax+non-syntax e)
+  (let-values ([(e* status) (try-any->isexp* (syntax-e e)
+                                             (syntax-wrapper
+                                              (λ (non-syntax-e)
+                                                (values (NonSyntax non-syntax-e)
+                                                        'modified))))])
+    (case status
+      [(unmodified) (unsafe-cast e (SyntaxU (NonSyntaxOf Any)))]
+      [(modified) (datum->syntax* e e* e e)]
+      [(#f)
+       (error (string-append "Got #f from try->any-isexp* using non-sexp which"
+                             " does not return #f."))])))
+
+
+;(: try-any->isyntax (→ Any (U (List Any) #f)))
+#;(define (try-any->isyntax e)
+    (let*-values ([(e* status) (try-any->isexp*
+                                e
+                                (λ (non-sexp-e)
+                                  (values #f #f)))])
+      (case status
+        [(unmodified) (list e)]
+        [(modified) (list e*)]
+        [(#f) #f])))
+
diff --git a/comments/typed-syntax-predicate.rkt b/comments/typed-syntax-predicate.rkt
new file mode 100644
index 00000000..132fd5b6
--- /dev/null
+++ b/comments/typed-syntax-predicate.rkt
@@ -0,0 +1,52 @@
+#lang typed/racket
+
+(provide isexp?
+         CoreSexp)
+
+(module unsafe racket
+  (provide isexp?)
+
+  (define isexp/c
+    (flat-rec-contract isexp
+                       (or/c boolean?
+                             char?
+                             number?
+                             keyword?
+                             null?
+                             (and/c string? immutable?)
+                             symbol?
+                             (box/c isexp #:immutable #t)
+                             (cons/c isexp isexp)
+                             (vectorof isexp #:immutable #t))))
+  
+  (define sexp/c
+    (recursive-contract
+     (or/c boolean?
+           char?
+           number?
+           keyword?
+           null?
+           string?
+           symbol?
+           (box/c sexp/c)
+           (cons/c sexp/c sexp/c)
+           (vectorof sexp/c))))
+
+  (define isexp?
+    (flat-contract-predicate isexp/c)))
+
+(define-type CoreSexp (Rec core-sexp
+                           (U Boolean
+                              Char
+                              Number
+                              Keyword
+                              Null
+                              String
+                              Symbol
+                              #|(Boxof sexp)|#
+                              (Pairof core-sexp core-sexp)
+                              #|(Vectorof sexp)|#)))
+
+(require typed/racket/unsafe)
+(unsafe-require/typed 'unsafe
+                      [isexp? (→ Any Boolean : #:+ Sexp #:- (! CoreSexp))])
\ No newline at end of file
diff --git a/comments/typed-syntax.rkt b/comments/typed-syntax.rkt
new file mode 100644
index 00000000..651e597f
--- /dev/null
+++ b/comments/typed-syntax.rkt
@@ -0,0 +1,10 @@
+#lang typed/racket
+
+(provide isexp?
+         try-any->isexp
+         any->isexp+non-sexp
+         CoreSexp)
+
+(require "typed-syntax-convert.rkt"
+         "typed-syntax-predicate.rkt")
+
diff --git a/lang/meta-first-line.rkt b/lang/meta-first-line.rkt
index b0cc4a0c..094ac886 100644
--- a/lang/meta-first-line.rkt
+++ b/lang/meta-first-line.rkt
@@ -5,11 +5,11 @@
          racket/syntax
          syntax/strip-context
          "first-line-utils.rkt"
-         (only-in "../comment-reader.rkt" make-comment-readtable))
+         (only-in "../comment-reader.rkt" make-comment-readtable)
+         "../comments/hide-comments.rkt")
 
 (provide meta-read-inside
-         meta-read-syntax-inside
-         restore-#%comment)
+         meta-read-syntax-inside)
 
 (define (make-at-reader+comments #:syntax? [syntax? #t] #:inside? [inside? #f])
   (make-at-reader
@@ -28,7 +28,7 @@
                     args))
   `(,rd1 . ,rd))
 
-(begin
+#;(begin
   (require (rename-in syntax/parse [...+ …+])
            syntax/stx
            racket/match
@@ -357,7 +357,6 @@
                          a
                          ([#%comment c2] . b)
                          c)))
-  ;; TODO: test restore-comments on an expression which has an 'after-comments
   )
 
 (define (meta-read-syntax-inside source-name in . args)
diff --git a/restore-comments.rkt b/restore-comments.rkt
index c90bc38d..7d297911 100644
--- a/restore-comments.rkt
+++ b/restore-comments.rkt
@@ -1,3 +1,3 @@
 #lang racket
-(require "lang/meta-first-line.rkt")
+(require "comments/restore-comments.rkt")
 (provide restore-#%comment)
\ No newline at end of file
diff --git a/test/comments/annotate-syntax-typed.rkt b/test/comments/annotate-syntax-typed.rkt
new file mode 100644
index 00000000..8ad7be58
--- /dev/null
+++ b/test/comments/annotate-syntax-typed.rkt
@@ -0,0 +1,65 @@
+#lang typed/racket
+
+(require typed-map
+         "../../comments/typed-syntax.rkt")
+
+(provide annotate-syntax)
+
+(: annotate-syntax (->* (Syntax)
+                        (#:srcloc+scopes? Boolean)
+                        Sexp))
+(define (annotate-syntax e #:srcloc+scopes? [srcloc+scopes? #f])
+  (annotate-syntax1 e srcloc+scopes?))
+
+(: annotate-syntax1 (→ (U Syntax Syntax-E)
+                       Boolean
+                       Sexp))
+(define (annotate-syntax1 e srcloc+scopes?)
+  (cond
+    [(syntax? e)
+     (append
+      (list 'syntax
+            (append-map (λ ([kᵢ : Symbol])
+                          (if (and (or (eq? kᵢ 'first-comments)
+                                       (eq? kᵢ 'comments-after))
+                                   (not (syntax-property e kᵢ)))
+                              (list)
+                              (list kᵢ (any->isexp (syntax-property e kᵢ)))))
+                        (syntax-property-symbol-keys e)))
+      (if srcloc+scopes?
+          (list (any->isexp (syntax-source e))
+                (any->isexp (syntax-line e))
+                (any->isexp (syntax-column e))
+                (any->isexp (syntax-position e))
+                (any->isexp (syntax-span e))
+                (any->isexp (syntax-source-module e))
+                (any->isexp (hash-ref (syntax-debug-info e)
+                                      'context)))
+          (list))
+      (list (annotate-syntax1 (syntax-e e) srcloc+scopes?)))]
+    [(null? e)
+     'null]
+    [(list? e)
+     (list 'list
+           (map (λ (eᵢ) (annotate-syntax1 eᵢ srcloc+scopes?))
+                e))]
+    [(pair? e)
+     (list 'cons
+           (annotate-syntax1 (car e) srcloc+scopes?)
+           (annotate-syntax1 (cdr e) srcloc+scopes?))]
+    [(vector? e)
+     (list 'vector
+           (immutable? e)
+           (map (λ (eᵢ) (annotate-syntax1 eᵢ srcloc+scopes?))
+                (vector->list e)))]
+    [(symbol? e)
+     e]
+    [(string? e)
+     e]
+    [else
+     (raise-argument-error
+      'annotate-syntax
+      (string-append "a syntax object containing recursively on of the"
+                     " following: pair, null, vector, symbol, string")
+      0
+      e)]))
\ No newline at end of file
diff --git a/test/comments/annotate-syntax.rkt b/test/comments/annotate-syntax.rkt
new file mode 100644
index 00000000..afafde19
--- /dev/null
+++ b/test/comments/annotate-syntax.rkt
@@ -0,0 +1,52 @@
+#lang racket
+
+(provide annotate-syntax)
+
+(define (annotate-syntax e #:srcloc+scopes? [srcloc+scopes? #f])
+  (cond
+    [(syntax? e)
+     (append
+      (list 'syntax
+            (append-map (λ (kᵢ)
+                          (if (and (or (eq? kᵢ 'first-comments)
+                                       (eq? kᵢ 'comments-after))
+                                   (not (syntax-property e kᵢ)))
+                              (list)
+                              (list kᵢ (syntax-property e kᵢ))))
+                        (syntax-property-symbol-keys e)))
+      (if srcloc+scopes?
+          (list (syntax-source e)
+                (syntax-line e)
+                (syntax-column e)
+                (syntax-position e)
+                (syntax-span e)
+                (syntax-source-module e)
+                (hash-ref (syntax-debug-info e) 'context))
+          (list))
+      (list (annotate-syntax (syntax-e e) #:srcloc+scopes? srcloc+scopes?)))]
+    [(null? e)
+     'null]
+    [(list? e)
+     (list 'list
+           (map (λ (eᵢ) (annotate-syntax eᵢ #:srcloc+scopes? srcloc+scopes?))
+                e))]
+    [(pair? e)
+     (list 'cons
+           (annotate-syntax (car e) #:srcloc+scopes? srcloc+scopes?)
+           (annotate-syntax (cdr e) #:srcloc+scopes? srcloc+scopes?))]
+    [(vector? e)
+     (list 'vector
+           (immutable? e)
+           (map (λ (eᵢ) (annotate-syntax eᵢ #:srcloc+scopes? srcloc+scopes?))
+                (vector->list e)))]
+    [(symbol? e)
+     e]
+    [(string? e)
+     e]
+    [else
+     (raise-argument-error
+      'annotate-syntax
+      (string-append "a syntax object containing recursively on of the"
+                     " following: pair, null, vector, symbol, string")
+      0
+      e)]))
\ No newline at end of file
diff --git a/test/comments/same-syntax.rkt b/test/comments/same-syntax.rkt
new file mode 100644
index 00000000..2990f340
--- /dev/null
+++ b/test/comments/same-syntax.rkt
@@ -0,0 +1,25 @@
+#lang racket
+
+(require "annotate-syntax.rkt"
+         sexp-diff
+         rackunit)
+
+(provide check-same-syntax)
+
+(define (same-syntax! a b)
+  (define answer (equal? (annotate-syntax a #:srcloc+scopes? #f)
+                         (annotate-syntax b #:srcloc+scopes? #f)))
+  (unless answer
+    (pretty-write
+     (sexp-diff (annotate-syntax a)
+                (annotate-syntax b)))
+    (displayln a)
+    (displayln b))
+  answer)
+
+(define-syntax (check-same-syntax stx)
+  (syntax-case stx ()
+    [(_ a b)
+     (datum->syntax #'here
+                    `(check-true (same-syntax! ,#'a ,#'b))
+                    stx)]))
\ No newline at end of file
diff --git a/test/comments/test-comments-round-trip.rkt b/test/comments/test-comments-round-trip.rkt
new file mode 100644
index 00000000..d6e71d50
--- /dev/null
+++ b/test/comments/test-comments-round-trip.rkt
@@ -0,0 +1,55 @@
+#lang racket
+
+(require rackunit
+         "../../comments/hide-comments.rkt"
+         "../../comments/restore-comments.rkt"
+         "same-syntax.rkt")
+
+(define round-trip (compose restore-#%comment hide-#%comment))
+
+(define-syntax (check-round-trip stx)
+  (syntax-case stx ()
+    [(_ a)
+     (datum->syntax #'here
+                    `(begin
+                       (check-same-syntax (round-trip ,#'a) ,#'a)
+                       (check-equal? (syntax->datum (round-trip ,#'a))
+                                     (syntax->datum ,#'a)))
+                    stx)]))
+
+;; =============================================================================
+
+(let ([stx #'(a b c)])
+  (check-same-syntax stx (hide-#%comment stx)))
+
+(check-round-trip #'(a (#%comment "b") c))
+  
+(check-round-trip #'((#%comment "0") (#%comment "1")
+                                     a
+                                     (#%comment "b")
+                                     (#%comment "bb")
+                                     c
+                                     (#%comment "d")
+                                     (#%comment "dd")))
+(check-round-trip #'([#%comment c1]
+                     a
+                     [#%comment c2]
+                     . ([#%comment c3] b [#%comment c4])))
+(check-round-trip #'([#%comment c1]
+                     a
+                     [#%comment c2]
+                     . ([#%comment c3]
+                        . ([#%comment c4] b [#%comment c5]))))
+(check-round-trip #'([#%comment c1]
+                     a
+                     [#%comment c2]
+                     . ([#%comment c3]
+                        . ([#%comment c4] [#%comment c5]))))
+(check-round-trip #'([#%comment c1]
+                     a
+                     ([#%comment c2])
+                     b))
+(check-round-trip #'([#%comment c1]
+                     a
+                     ([#%comment c2] . b)
+                     c))
\ No newline at end of file