(require 'cl)
(require 'bytecomp)

(require 'parser)
(define-parser ecma ecma-yylex "ecma.tab.c" "ecma.tab.h" "ecma.act")

(defvar ecma-newline-found nil)
(defvar ecma-newline-prohibitted nil)
(defsubst ecma-skip-white-space nil
  (setq ecma-newline-found nil)
  (skip-chars-forward "\011\013\014\040")
  (while (cond ((and (eq ?/ (following-char)) (eq ?/ (char-after (1+ (point)))))
		(forward-char 2)
		(skip-chars-forward "^\n\r"))
	       ((and (eq ?/ (following-char)) (eq ?* (char-after (1+ (point)))))
		(forward-char 2)
		(search-forward "*/" nil t))
	       ((or (eq ?\n (following-char)) (eq ?\r (following-char)))
		(setq ecma-newline-found t)
		(when ecma-newline-prohibitted
		  (setq ecma-newline-prohibitted nil)
		  (throw 'token (eval-when-compile (parser-token-lookup 'ecma ?\n))))
		(skip-chars-forward "\n\r")))
    (skip-chars-forward "\011\013\014\040"))
  (setq ecma-newline-prohibitted nil)
  (and (eobp) (setq ecma-newline-found t)))

(defun ecma-read-string nil
  (cond ((looking-at "'\\([^\\\\'\n]\\|\\\\.\\)*'")
	 (narrow-to-region (match-beginning 0) (match-end 0))
	 (while (re-search-forward "\\`\\([^\\\\\"]\\|\\\\.\\)*\"" nil t)
	   (backward-char)
	   (insert-char ?\\ 1)
	   (goto-char (point-min)))
	 (goto-char (point-min))
	 (delete-char 1)
	 (insert-char ?\" 1)
	 (goto-char (1- (point-max)))
	 (delete-char 1)
	 (insert-char ?\" 1)
	 (goto-char (point-min)))
	((looking-at "\"\\([^\\\\\"\n]\\|\\\\.\\)*\"")
	 (narrow-to-region (match-beginning 0) (match-end 0)))
	(t 
	 (error "Parse error")))
  (prog1 (read (current-buffer))
    (assert (eobp))
    (widen)))

(defun ecma-read-octal nil
  (narrow-to-region (match-beginning 0) (match-end 0))
  (goto-char (point-min))
  (prog1
      (let ((val 0))
	(while (and (>= (following-char) ?0) (<= (following-char) ?9))
	  (setq val (+ (* val 8) (- (following-char) 48)))
	  (forward-char 1))
	val)
    (assert (eobp))
    (widen)))

(defun ecma-read-hex nil
  (narrow-to-region (+ 2 (match-beginning 0)) (match-end 0))
  (upcase-region (point-min) (point-max))
  (goto-char (point-min))
  (prog1
      (let ((val 0))
	(while (looking-at "[0-9A-F]")
	  (setq val (+ (* val 16) (- (following-char) (if (>= (following-char) 65) 55 48))))
	  (forward-char 1))
	val)
    (assert (eobp))
    (widen)))
    
(eval-and-compile
  (defconst ecma-tokens
    (mapcar (function (lambda (tok)
			(setf (second tok) 
			      (parser-token-lookup 'ecma (second tok)))
			tok))
	    `(
	      ("break" 	BREAK)
	      ("for"	FOR)
	      ("new"	NEW)
	      ("var"	VAR)
	      ("continue" CONTINUE)
	      ("function" FUNCTION)
	      ("return"	RETURN)
	      ("void"	VOID)
	      ("delete"	DELETE)
	      ("if"	IF)
	      ("this"	THIS)
	      ("while"	WHILE)
	      ("else"	ELSE)
	      ("in"	IN)
	      ("typeof"	TYPEOF)
	      ("with"	WITH)
	      ("null"	LIT_NULL)
	      ("false"	LIT_FALSE)
	      ("true"	LIT_TRUE)
	      ("[a-zA-Z$_][a-zA-Z$_0-9]*" 
	       IDENTIFIER
	       t)
	      ("0[xX][0-9a-fA-F]*"
	       NUMBER
	       ecma-read-hex);;XXX Hex
	      ("[0-9]+\\.?[0-9]*[eE][+-]?[0-9]*\\|[0-9]+\\.[0-9]*\\|[0-9]*\\.?[0-9]+[eE][+-]?[0-9]*\\|[0-9]*\\.[0-9]+\\|[1-9][0-9]*"
	       NUMBER
	       t)
	      ("0[0-7]*"
	       NUMBER
	       ecma-read-octal);;XXX octal
	      ("[\"\']"
	       STRING
	       ecma-read-string)
	      ("=="	EQ)
	      ("<="	LE)
	      (">="	GE)
	      ("!="	NE)
	      ("&&"	LAN)
	      ("||"	LOR)
	      ("++"	INC)
	      ("--"	DEC)
	      ("<<"	SL)
	      (">>"	SR)
	      (">>>"	SRR)
	      ("+="	IEQ)
	      ("-="	DEQ)
	      ("*="	MEQ)
	      ("/="	SEQ)
	      ("&="	AEQ)
	      ("|="	OEQ)
	      ("^="	XEQ)
	      ("%="	MOEQ)
	      ("<<="	SLEQ)
	      (">>="	SREQ)
	      (">>>="	SRREQ)
	      ("="	?=)
	      (">"	?>)
	      ("<"	?<)
	      (","	?,)
	      ("!"	?!)
	      ("~"	?~)
	      ("?"	??)
	      (":"	?:)
	      ("."	?.)
	      ("+"	?+)
	      ("-"	?-)
	      ("*"	?*)
	      ("/"	?/)
	      ("&"	?&)
	      ("|"	?|)
	      ("^"	?^)
	      ("%"	?%)
	      ("("	?\()
	      (")"	?\))
	      ("{"	?{)
	      ("}"	?})
	      ("["	?\[)
	      ("]"	?\])
	      (";"	?\;)
	      ))
    "regexps should not contain subexpressions, 
and there should be less than 10 regexps
the fewer the regexps the better the performance

strings will be read as symbols,
regexps will be read unquoted using read, 
or maybe one day using buffer-substring")
  )
(define-lexer ecma ecma-tokens ecma-skip-white-space)

(defun ecma-parse-region (beg end)
  (interactive "r")
  (with-output-to-temp-buffer "*JavaScript Parse Results*"
    (save-excursion
      (let ((buf (current-buffer))
	    result before after delta)
	(set-buffer (generate-new-buffer " *js parse temp*"))
	(buffer-disable-undo)
	(insert-buffer-substring buf beg end)
	(goto-char (point-min))
	(setq before (memory-use-counts)
	      result (ecma)
	      after (memory-use-counts)
	      result (cl-macroexpand-all result)
	      )
	(while before
	  (push (- (pop after) (pop before)) delta))
	(setq delta (nreverse delta))
	(decf (car delta) 7)
	(kill-buffer (current-buffer))
	(pp result)
	(princ (apply 'format "\n\n%d tokens, %d cycles\ncons:%d fl:%d vec:%d sym:%d str:%d misc:%d int:%d"
		      parser-tokens parser-cycles delta))
	))))

(defun ecma-lex nil
  (interactive)
  (let ((yytname (get 'ecma 'yytname)))
    (message "%s (%s)" (aref yytname (ecma-yylex)) yylval)))