diff --git a/js2/semantics/Calculus.lisp b/js2/semantics/Calculus.lisp index a0d8dfe8b968..1ba819777bce 100644 --- a/js2/semantics/Calculus.lisp +++ b/js2/semantics/Calculus.lisp @@ -1935,7 +1935,7 @@ ;;; ------------------------------------------------------------------------------------------------------ ;;; SPECIAL FORMS -;;; Control structures +;;; Constants (defun eval-bottom () (error "Reached a BOTTOM statement")) @@ -1950,6 +1950,34 @@ (list 'expr-annotation:special-form special-form))) +; (^ ) +; Alternative way of writing the integer or rational constant ^. +(defun scan-^ (world type-env special-form base exponent) + (declare (ignore type-env)) + (unless (and (integerp base) (integerp exponent) (plusp base)) + (error "Bad constant ~S^~S" base exponent)) + (values + (expt base exponent) + (if (minusp exponent) + (world-rational-type world) + (world-integer-type world)) + (list 'expr-annotation:special-form special-form base exponent))) + + +; (hex []) +; Alternative way of writing the integer in hexadecimal. length is the minimum number of digits to write. +(defun scan-hex (world type-env special-form n &optional (length 1)) + (declare (ignore type-env)) + (unless (and (integerp n) (integerp length) (>= length 0)) + (error "Bad hex constant ~S [~S]" n length)) + (values + n + (world-integer-type world) + (list 'expr-annotation:special-form special-form n length))) + + +;;; Control structures + ; (function (( [:unused]) ... ( [:unused])) ) (defun scan-function (world type-env special-form arg-binding-exprs body-expr) (flet @@ -2673,9 +2701,13 @@ (terminal-action scan-terminal-action depict-terminal-action)) (:special-form - ;;Control structures + ;;Constants (bottom scan-bottom depict-bottom) (todo scan-bottom depict-bottom) + (^ scan-^ depict-^) + (hex scan-hex depict-hex) + + ;;Control structures (function scan-function depict-function) (if scan-if depict-if) (progn scan-progn depict-progn) @@ -2743,7 +2775,7 @@ (neg (-> (integer) integer) #'- :unary :minus nil %suffix% %suffix%) (* (-> (integer integer) integer) #'* :infix "*" nil %factor% %factor% %factor%) - (mod (-> (integer integer) integer) #'mod :infix ((:semantic-keyword "mod")) nil %factor% %factor% %unary%) + (mod (-> (integer integer) integer) #'mod :infix ((:semantic-keyword "mod")) t %factor% %factor% %unary%) (+ (-> (integer integer) integer) #'+ :infix "+" t %term% %term% %term%) (- (-> (integer integer) integer) #'- :infix :minus t %term% %term% %factor%) (= (-> (integer integer) boolean) #'= :infix "=" t %relational% %term% %term%) @@ -2799,7 +2831,12 @@ (char<= (-> (character character) boolean) #'char<= :infix :less-or-equal t %relational% %term% %term%) (char>= (-> (character character) boolean) #'char>= :infix :greater-or-equal t %relational% %term% %term%) - (string-equal (-> (string string) boolean) #'string= :infix "=" t %relational% %term% %term%) + (string= (-> (string string) boolean) #'string= :infix "=" t %relational% %term% %term%) + (string/= (-> (string string) boolean) #'string/= :infix :not-equal t %relational% %term% %term%) + (string< (-> (string string) boolean) #'string< :infix "<" t %relational% %term% %term%) + (string> (-> (string string) boolean) #'string> :infix ">" t %relational% %term% %term%) + (string<= (-> (string string) boolean) #'string<= :infix :less-or-equal t %relational% %term% %term%) + (string>= (-> (string string) boolean) #'string>= :infix :greater-or-equal t %relational% %term% %term%) (integer-set-length (-> (integer-set) integer) #'intset-length :unary "|" "|" %primary% %expr%) (integer-set-min (-> (integer-set) integer) #'integer-set-min :unary ((:semantic-keyword "min") " ") nil %min-max% %prefix%) diff --git a/js2/semantics/CalculusMarkup.lisp b/js2/semantics/CalculusMarkup.lisp index 6cff31beb5be..755573a24947 100644 --- a/js2/semantics/CalculusMarkup.lisp +++ b/js2/semantics/CalculusMarkup.lisp @@ -456,6 +456,23 @@ (depict markup-stream ':bottom-10)) +; (^ ) +(defun depict-^ (markup-stream world level base exponent) + (declare (ignore world level)) + (depict-integer markup-stream base) + (depict-char-style (markup-stream ':superscript) + (depict-integer markup-stream exponent))) + + +; (hex []) +(defun depict-hex (markup-stream world level n length) + (if (minusp n) + (progn + (depict markup-stream "-") + (depict-hex markup-stream world level (- n) length)) + (depict markup-stream (format nil "0x~V,'0X" length n)))) + + (defun depict-function-bindings (markup-stream world arg-binding-exprs) (depict-list markup-stream #'(lambda (markup-stream arg-binding)