Added /* and */ statements

js2/semantics/Calculus.lisp

@@ -3939,7 +3939,7 @@
 
 
 ; (// . <styled-text>)
-; Used to insert comment statements.
+; A one-paragraph comment using the given <styled-text>.
 (defun scan-// (world type-env rest-statements last special-form &rest text)
   (unless text
     (error "// should have non-empty text"))
@@ -3949,6 +3949,38 @@
             (cons (cons special-form text) rest-annotated-stmts))))
 
 
+; (/* . <styled-text>)
+; A one-paragraph comment using the given <styled-text>.  The subsequent statements are hidden until the next (*/) statement.
+; These comments cannot nest.
+(defun scan-/* (world type-env rest-statements last special-form &rest text)
+  (unless text
+    (error "/* should have non-empty text"))
+  (multiple-value-bind (rest-codes rest-live rest-annotated-stmts) (scan-statements world type-env rest-statements last)
+    (let ((end-special-form (assert-non-null (world-find-symbol world '*/))))
+      (loop
+        (when (endp rest-annotated-stmts)
+          (error "Missing */"))
+        (let* ((annotated-stmt (pop rest-annotated-stmts))
+               (stmt-keyword (first annotated-stmt)))
+          (cond
+           ((eq stmt-keyword special-form)
+            (error "/* comments can't nest"))
+           ((eq stmt-keyword end-special-form)
+            (return))))))
+    (values rest-codes
+            rest-live
+            (cons (cons special-form text) rest-annotated-stmts))))
+
+
+; (*/)
+; Terminates a /* comment.
+(defun scan-*/ (world type-env rest-statements last special-form)
+  (multiple-value-bind (rest-codes rest-live rest-annotated-stmts) (scan-statements world type-env rest-statements last)
+    (values rest-codes
+            rest-live
+            (cons (list special-form) rest-annotated-stmts))))
+
+
 ; (assert <condition-expr> . <styled-text>)
 ; Used to declare conditions that are known to be true if the semantics function correctly.  Don't use this to
 ; verify user input.
@@ -4586,6 +4618,8 @@
     
     (:statement
      (// scan-// depict-//)
+     (/* scan-/* depict-//)
+     (*/ scan-*/ depict-*/)
      (assert scan-assert depict-assert)
      (exec scan-exec depict-exec)
      (const scan-const depict-var)

js2/semantics/CalculusMarkup.lisp

@@ -965,12 +965,20 @@
 
 
 ; (// . <styled-text>)
+; (/* . <styled-text>)
 (defun depict-// (markup-stream world semicolon last-paragraph-style &rest text)
   (declare (ignore world semicolon))
   (depict-division-style (markup-stream :wrap)
     (depict-text-paragraph markup-stream last-paragraph-style text)))
 
 
+; (*/)
+; These should have been filtered out by scan-/*, so any that remain are errors.
+(defun depict-*/ (markup-stream world semicolon last-paragraph-style)
+  (declare (ignore markup-stream world semicolon last-paragraph-style))
+  (error "Unmatched */"))
+
+
 (defvar *assertion-depictor*)
 
 ; (assert <condition-expr> . <styled-text>)