Updated for recent semantic engine changes

js/semantics/JS20/Lexer.lisp

@@ -19,9 +19,6 @@
 ;;; Waldemar Horwat (waldemar@netscape.com)
 ;;;
 
-(defun digit-char-16 (char)
-  (assert-non-null (digit-char-p char 16)))
-
 
 (progn
   (defparameter *lw*
@@ -57,18 +54,18 @@
                                                           (($default-action $default-action)))
                (:a-s-c-i-i-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
                                  (($default-action $default-action)
-                                  (decimal-value digit-value)))
+                                  (decimal-value $digit-value)))
                (:non-zero-digit (#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
-                                ((decimal-value digit-value)))
+                                ((decimal-value $digit-value)))
                (:octal-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7)
                              (($default-action $default-action)
-                              (octal-value digit-value)))
+                              (octal-value $digit-value)))
                (:zero-to-three (#\0 #\1 #\2 #\3)
-                               ((octal-value digit-value)))
+                               ((octal-value $digit-value)))
                (:four-to-seven (#\4 #\5 #\6 #\7)
-                               ((octal-value digit-value)))
+                               ((octal-value $digit-value)))
                (:hex-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\A #\B #\C #\D #\E #\F #\a #\b #\c #\d #\e #\f)
-                           ((hex-value digit-value)))
+                           ((hex-value $digit-value)))
                (:letter-e (#\E #\e) (($default-action $default-action)))
                (:letter-x (#\X #\x) (($default-action $default-action)))
                ((:literal-string-char single) (- :unicode-character (+ (#\' #\\) :line-terminator))
@@ -83,8 +80,8 @@
                 (($default-action $default-action)))
                ((:ordinary-reg-exp-char guillemet) (- :non-terminator (#\\ #?00BB))
                 (($default-action $default-action))))
-              (($default-action character identity (*))
-               (digit-value integer digit-char-16 ((:global-variable "digitValue") "(" * ")"))))
+              (($default-action character nil identity)
+               ($digit-value integer digit-value digit-char-36)))
        
        (rule :$next-token
              ((token token) (reg-exp-may-follow boolean))
@@ -250,10 +247,9 @@
        (define (member (id string) (list (vector string))) boolean
          (if (empty list)
            false
-           (let ((s string (first list)))
-             (if (string-equal id s)
-               true
-               (member id (rest list))))))
+           (if (string-equal id (nth list 0))
+             true
+             (member id (subseq list 1)))))
        
        (rule :identifier-or-reserved-word
              ((token token) (reg-exp-may-follow boolean))

js/semantics/JSECMA/Lexer.lisp

@@ -19,10 +19,6 @@
 ;;; Waldemar Horwat (waldemar@netscape.com)
 ;;;
 
-(defun digit-char-16 (char)
-  (assert-non-null (digit-char-p char 16)))
-
-
 (progn
   (defparameter *lw*
     (generate-world
@@ -42,26 +38,26 @@
                                    ((character-value character-value)))
                (:decimal-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
                                ((character-value character-value)
-                                (decimal-value digit-value)))
+                                (decimal-value $digit-value)))
                (:non-zero-digit (#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
-                                ((decimal-value digit-value)))
+                                ((decimal-value $digit-value)))
                (:octal-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7)
                              ((character-value character-value)
-                              (octal-value digit-value)))
+                              (octal-value $digit-value)))
                (:zero-to-three (#\0 #\1 #\2 #\3)
-                               ((octal-value digit-value)))
+                               ((octal-value $digit-value)))
                (:four-to-seven (#\4 #\5 #\6 #\7)
-                               ((octal-value digit-value)))
+                               ((octal-value $digit-value)))
                (:hex-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\A #\B #\C #\D #\E #\F #\a #\b #\c #\d #\e #\f)
-                           ((hex-value digit-value)))
+                           ((hex-value $digit-value)))
                (:exponent-indicator (#\E #\e) ())
                (:hex-indicator (#\X #\x) ())
                (:plain-string-char (- :unicode-character (+ (#\' #\" #\\) :octal-digit :line-terminator))
                                    ((character-value character-value)))
                (:string-non-escape (- :non-terminator (+ :octal-digit (#\x #\u #\' #\" #\\ #\b #\f #\n #\r #\t #\v)))
                                    ((character-value character-value))))
-              ((character-value character identity (*))
-               (digit-value integer digit-char-16 ((:global-variable "digitValue") "(" * ")"))))
+              ((character-value character nil identity)
+               ($digit-value integer digit-value digit-char-36)))
        
        (%section "Comments")
        (production :line-comment (#\/ #\/ :line-comment-characters) line-comment)
@@ -159,10 +155,10 @@
        (define (member (id string) (list (vector string))) boolean
          (if (empty list)
            false
-           (let ((s string (first list)))
+           (let ((s string (nth list 0)))
              (if (string-equal id s)
                true
-               (member id (rest list))))))
+               (member id (subseq list 1))))))
        
        (declare-action token :identifier-or-reserved-word token)
        (production :identifier-or-reserved-word (:identifier-name) identifier-or-reserved-word-identifier-name

js/semantics/JSECMA/Parser.lisp

@@ -234,19 +234,19 @@
          (eval (eval :primary-lvalue)))
        (production (:member-lvalue call) (:lvalue :arguments) member-lvalue-call-member-lvalue
          ((eval (e env))
-          (letexc (function-reference reference ((eval :lvalue) e))
-            (letexc (function value (reference-get-value function-reference))
+          (letexc (f-reference reference ((eval :lvalue) e))
+            (letexc (f value (reference-get-value f-reference))
               (letexc (arguments (vector value) ((eval :arguments) e))
                 (let ((this object-or-null
-                            (case function-reference
+                            (case f-reference
                               (((value-reference virtual-reference)) (oneof null-object-or-null))
                               ((place-reference p place) (oneof object-object-or-null (& base p))))))
-                  (call-object function this arguments)))))))
+                  (call-object f this arguments)))))))
        (production (:member-lvalue call) ((:member-expression no-call no-l-value) :arguments) member-lvalue-call-member-expression-no-call
          ((eval (e env))
-          (letexc (function value ((eval :member-expression) e))
+          (letexc (f value ((eval :member-expression) e))
             (letexc (arguments (vector value) ((eval :arguments) e))
-              (call-object function (oneof null-object-or-null) arguments)))))
+              (call-object f (oneof null-object-or-null) arguments)))))
        (production (:member-lvalue :member-expr-kind) ((:member-expression :member-expr-kind any-value) \[ :expression \]) member-lvalue-array
          ((eval (e env))
           (letexc (container value ((eval :member-expression) e))
@@ -311,8 +311,8 @@
            (letexc (name prop-name (coerce-to-string property))
              (oneof normal (oneof place-reference (tuple place obj name))))))
        
-       (define (call-object (function value) (this object-or-null) (arguments (vector value))) reference-or-exception
-         (case function
+       (define (call-object (f value) (this object-or-null) (arguments (vector value))) reference-or-exception
+         (case f
            (((undefined-value null-value boolean-value double-value string-value))
             (typed-oneof reference-or-exception abrupt (make-error (oneof coerce-to-object-error))))
            ((object-value o object)
@@ -551,13 +551,13 @@
              less
              (if (empty right)
                greater
-               (let ((left-char-code integer (character-to-code (first left)))
-                     (right-char-code integer (character-to-code (first right))))
+               (let ((left-char-code integer (character-to-code (nth left 0)))
+                     (right-char-code integer (character-to-code (nth right 0))))
                  (if (< left-char-code right-char-code)
                    less
                    (if (> left-char-code right-char-code)
                      greater
-                     (compare-strings (rest left) (rest right) less equal greater))))))))
+                     (compare-strings (subseq left 1) (subseq right 1) less equal greater))))))))
        
        (%section "Equality Operators")
        

js2/semantics/JS20/Lexer.lisp

@@ -19,9 +19,6 @@
 ;;; Waldemar Horwat (waldemar@netscape.com)
 ;;;
 
-(defun digit-char-16 (char)
-  (assert-non-null (digit-char-p char 16)))
-
 
 (progn
   (defparameter *lw*
@@ -57,18 +54,18 @@
                                                           (($default-action $default-action)))
                (:a-s-c-i-i-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
                                  (($default-action $default-action)
-                                  (decimal-value digit-value)))
+                                  (decimal-value $digit-value)))
                (:non-zero-digit (#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
-                                ((decimal-value digit-value)))
+                                ((decimal-value $digit-value)))
                (:octal-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7)
                              (($default-action $default-action)
-                              (octal-value digit-value)))
+                              (octal-value $digit-value)))
                (:zero-to-three (#\0 #\1 #\2 #\3)
-                               ((octal-value digit-value)))
+                               ((octal-value $digit-value)))
                (:four-to-seven (#\4 #\5 #\6 #\7)
-                               ((octal-value digit-value)))
+                               ((octal-value $digit-value)))
                (:hex-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\A #\B #\C #\D #\E #\F #\a #\b #\c #\d #\e #\f)
-                           ((hex-value digit-value)))
+                           ((hex-value $digit-value)))
                (:letter-e (#\E #\e) (($default-action $default-action)))
                (:letter-x (#\X #\x) (($default-action $default-action)))
                ((:literal-string-char single) (- :unicode-character (+ (#\' #\\) :line-terminator))
@@ -83,8 +80,8 @@
                 (($default-action $default-action)))
                ((:ordinary-reg-exp-char guillemet) (- :non-terminator (#\\ #?00BB))
                 (($default-action $default-action))))
-              (($default-action character identity (*))
-               (digit-value integer digit-char-16 ((:global-variable "digitValue") "(" * ")"))))
+              (($default-action character nil identity)
+               ($digit-value integer digit-value digit-char-36)))
        
        (rule :$next-token
              ((token token) (reg-exp-may-follow boolean))
@@ -250,10 +247,9 @@
        (define (member (id string) (list (vector string))) boolean
          (if (empty list)
            false
-           (let ((s string (first list)))
-             (if (string-equal id s)
-               true
-               (member id (rest list))))))
+           (if (string-equal id (nth list 0))
+             true
+             (member id (subseq list 1)))))
        
        (rule :identifier-or-reserved-word
              ((token token) (reg-exp-may-follow boolean))

js2/semantics/JSECMA/Lexer.lisp

@@ -19,10 +19,6 @@
 ;;; Waldemar Horwat (waldemar@netscape.com)
 ;;;
 
-(defun digit-char-16 (char)
-  (assert-non-null (digit-char-p char 16)))
-
-
 (progn
   (defparameter *lw*
     (generate-world
@@ -42,26 +38,26 @@
                                    ((character-value character-value)))
                (:decimal-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
                                ((character-value character-value)
-                                (decimal-value digit-value)))
+                                (decimal-value $digit-value)))
                (:non-zero-digit (#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
-                                ((decimal-value digit-value)))
+                                ((decimal-value $digit-value)))
                (:octal-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7)
                              ((character-value character-value)
-                              (octal-value digit-value)))
+                              (octal-value $digit-value)))
                (:zero-to-three (#\0 #\1 #\2 #\3)
-                               ((octal-value digit-value)))
+                               ((octal-value $digit-value)))
                (:four-to-seven (#\4 #\5 #\6 #\7)
-                               ((octal-value digit-value)))
+                               ((octal-value $digit-value)))
                (:hex-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\A #\B #\C #\D #\E #\F #\a #\b #\c #\d #\e #\f)
-                           ((hex-value digit-value)))
+                           ((hex-value $digit-value)))
                (:exponent-indicator (#\E #\e) ())
                (:hex-indicator (#\X #\x) ())
                (:plain-string-char (- :unicode-character (+ (#\' #\" #\\) :octal-digit :line-terminator))
                                    ((character-value character-value)))
                (:string-non-escape (- :non-terminator (+ :octal-digit (#\x #\u #\' #\" #\\ #\b #\f #\n #\r #\t #\v)))
                                    ((character-value character-value))))
-              ((character-value character identity (*))
-               (digit-value integer digit-char-16 ((:global-variable "digitValue") "(" * ")"))))
+              ((character-value character nil identity)
+               ($digit-value integer digit-value digit-char-36)))
        
        (%section "Comments")
        (production :line-comment (#\/ #\/ :line-comment-characters) line-comment)
@@ -159,10 +155,10 @@
        (define (member (id string) (list (vector string))) boolean
          (if (empty list)
            false
-           (let ((s string (first list)))
+           (let ((s string (nth list 0)))
              (if (string-equal id s)
                true
-               (member id (rest list))))))
+               (member id (subseq list 1))))))
        
        (declare-action token :identifier-or-reserved-word token)
        (production :identifier-or-reserved-word (:identifier-name) identifier-or-reserved-word-identifier-name

js2/semantics/JSECMA/Parser.lisp

@@ -234,19 +234,19 @@
          (eval (eval :primary-lvalue)))
        (production (:member-lvalue call) (:lvalue :arguments) member-lvalue-call-member-lvalue
          ((eval (e env))
-          (letexc (function-reference reference ((eval :lvalue) e))
-            (letexc (function value (reference-get-value function-reference))
+          (letexc (f-reference reference ((eval :lvalue) e))
+            (letexc (f value (reference-get-value f-reference))
               (letexc (arguments (vector value) ((eval :arguments) e))
                 (let ((this object-or-null
-                            (case function-reference
+                            (case f-reference
                               (((value-reference virtual-reference)) (oneof null-object-or-null))
                               ((place-reference p place) (oneof object-object-or-null (& base p))))))
-                  (call-object function this arguments)))))))
+                  (call-object f this arguments)))))))
        (production (:member-lvalue call) ((:member-expression no-call no-l-value) :arguments) member-lvalue-call-member-expression-no-call
          ((eval (e env))
-          (letexc (function value ((eval :member-expression) e))
+          (letexc (f value ((eval :member-expression) e))
             (letexc (arguments (vector value) ((eval :arguments) e))
-              (call-object function (oneof null-object-or-null) arguments)))))
+              (call-object f (oneof null-object-or-null) arguments)))))
        (production (:member-lvalue :member-expr-kind) ((:member-expression :member-expr-kind any-value) \[ :expression \]) member-lvalue-array
          ((eval (e env))
           (letexc (container value ((eval :member-expression) e))
@@ -311,8 +311,8 @@
            (letexc (name prop-name (coerce-to-string property))
              (oneof normal (oneof place-reference (tuple place obj name))))))
        
-       (define (call-object (function value) (this object-or-null) (arguments (vector value))) reference-or-exception
-         (case function
+       (define (call-object (f value) (this object-or-null) (arguments (vector value))) reference-or-exception
+         (case f
            (((undefined-value null-value boolean-value double-value string-value))
             (typed-oneof reference-or-exception abrupt (make-error (oneof coerce-to-object-error))))
            ((object-value o object)
@@ -551,13 +551,13 @@
              less
              (if (empty right)
                greater
-               (let ((left-char-code integer (character-to-code (first left)))
-                     (right-char-code integer (character-to-code (first right))))
+               (let ((left-char-code integer (character-to-code (nth left 0)))
+                     (right-char-code integer (character-to-code (nth right 0))))
                  (if (< left-char-code right-char-code)
                    less
                    (if (> left-char-code right-char-code)
                      greater
-                     (compare-strings (rest left) (rest right) less equal greater))))))))
+                     (compare-strings (subseq left 1) (subseq right 1) less equal greater))))))))
        
        (%section "Equality Operators")