#!/bin/sh
# This is a shell archive (produced by GNU sharutils 4.2).
# To extract the files from this archive, save it to some FILE, remove
# everything before the `!/bin/sh' line above, then type `sh FILE'.
#
# Made on 1998-02-20 00:57 EST by <gsstark@localhost>.
# Source directory was `/u1/home/gsstark/src'.
#
# Existing files will *not* be overwritten unless `-c' is specified.
#
# This shar contains:
# length mode       name
# ------ ---------- ------------------------------------------
#    401 -rw-r--r-- jscript/Makefile
#   6452 -rw-r--r-- jscript/ecma.y
#   5353 -rw-rw-r-- jscript/ecma.el
#   7557 -rw-rw-r-- jscript/parser-ext.el
#   7359 -rw-rw-r-- jscript/parser.el
#
save_IFS="${IFS}"
IFS="${IFS}:"
gettext_dir=FAILED
locale_dir=FAILED
first_param="$1"
for dir in $PATH
do
  if test "$gettext_dir" = FAILED && test -f $dir/gettext \
     && ($dir/gettext --version >/dev/null 2>&1)
  then
    set `$dir/gettext --version 2>&1`
    if test "$3" = GNU
    then
      gettext_dir=$dir
    fi
  fi
  if test "$locale_dir" = FAILED && test -f $dir/shar \
     && ($dir/shar --print-text-domain-dir >/dev/null 2>&1)
  then
    locale_dir=`$dir/shar --print-text-domain-dir`
  fi
done
IFS="$save_IFS"
if test "$locale_dir" = FAILED || test "$gettext_dir" = FAILED
then
  echo=echo
else
  TEXTDOMAINDIR=$locale_dir
  export TEXTDOMAINDIR
  TEXTDOMAIN=sharutils
  export TEXTDOMAIN
  echo="$gettext_dir/gettext -s"
fi
touch -am 1231235999 $$.touch >/dev/null 2>&1
if test ! -f 1231235999 && test -f $$.touch; then
  shar_touch=touch
else
  shar_touch=:
  echo
  $echo 'WARNING: not restoring timestamps.  Consider getting and'
  $echo "installing GNU \`touch', distributed in GNU File Utilities..."
  echo
fi
rm -f 1231235999 $$.touch
#
if mkdir _sh27536; then
  $echo 'x -' 'creating lock directory'
else
  $echo 'failed to create lock directory'
  exit 1
fi
# ============= jscript/Makefile ==============
if test ! -d 'jscript'; then
  $echo 'x -' 'creating directory' 'jscript'
  mkdir 'jscript'
fi
if test -f 'jscript/Makefile' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'jscript/Makefile' '(file already exists)'
else
  $echo 'x -' extracting 'jscript/Makefile' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'jscript/Makefile' &&
YACC=bison
LEX=flex
CC=gcc -g -W
MV=mv
X
all: ecma.elc
X
ecma.act ecma.tab.c ecma.tab.h ecma.output: ecma.y
X	-$(YACC)  -d -n -v $<
X
ecma.elc: ecma.tab.c parser.elc parser-ext.elc
X
%.elc:	%.el
X	emacs -batch -q -no-site-file --eval '(setq load-path (cons "." load-path))' -f batch-byte-compile $<
X
clean:
X	$(RM) debug *.elc *.o jl.c ecma.act ecma.tab.c ecma.tab.h ecma.output j.c j *~ core a.out lex.yy.c
SHAR_EOF
  $shar_touch -am 0214200698 'jscript/Makefile' &&
  chmod 0644 'jscript/Makefile' ||
  $echo 'restore of' 'jscript/Makefile' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'jscript/Makefile:' 'MD5 check failed'
ff9179446111c4ae6371bd361aec0da0  jscript/Makefile
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'jscript/Makefile'`"
    test 401 -eq "$shar_count" ||
    $echo 'jscript/Makefile:' 'original size' '401,' 'current size' "$shar_count!"
  fi
fi
# ============= jscript/ecma.y ==============
if test -f 'jscript/ecma.y' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'jscript/ecma.y' '(file already exists)'
else
  $echo 'x -' extracting 'jscript/ecma.y' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'jscript/ecma.y' &&
%start program
X
/* tokens etc. */
%token BREAK
%token FOR
%token NEW
%token VAR
%token CONTINUE
%token FUNCTION
%token RETURN
%token VOID
%token DELETE
%token IF
%token THIS
%token WHILE
%token ELSE
%token IN
%token TYPEOF
%token WITH
X
%token RESERVED
X
%token LIT_NULL
%token LIT_TRUE
%token LIT_FALSE
X
%token NUMBER
%token STRING
X
%token IDENTIFIER
X
%token EQ "=="
%token LE "<="
%token GE ">="
%token NE "!="
%token LAN "&&"
%token LOR "||"
%token INC "++"
%token DEC "--"
%token SL  "<<"
%token SR  ">>"
%token SRR ">>>"
%token IEQ "+="
%token DEQ "-="
%token MEQ "*="
%token SEQ "/="
%token AEQ "&="
%token OEQ "|="
%token XEQ "^="
%token MOEQ "%="
%token SLEQ "<<="
%token SREQ ">>="
%token SRREQ ">>>="
X
%left ','
%right '=' "*=" "/=" "%=" "+=" "-=" "<<=" ">>=" ">>>=" "&=" "^=" "|="
%left '?' ':'
%left "&&" "||"
%left '|'
%left '^'
%left '&'
%left "==" "!="
%left '<' '>' "<=" ">="
%left "<<" ">>" ">>>"
%left '+' '-'
%left '*' '/' '%'
%right DELETE TYPEOF "++" "--" UPLUS UMINUS VOID '~' '!'
%right POSTFIX
%left '.'
X
X
%%
X
/* rules */
X
primary_expr:
X	  THIS		{ (quote this) }
X	| IDENTIFIER	{ $1 }
X	| LIT_NULL	{ nil }
X	| LIT_TRUE	{ t }
X	| LIT_FALSE	{ nil }
X	| NUMBER	{ $1 }
X	| STRING	{ $1 }
X	| '(' expr ')'	{ $2 }
X	;
X
member_expr:
X	  primary_expr
X	| member_expr '.' IDENTIFIER 	{ `(get ,$1 ,$3) }
X	| member_expr '[' expr ']'	{ `(if (integerp ,$3) (aref ,$1 ,$3) (get ,$1 ,$3)) }
X	| NEW member_expr arguments	{ `(js-new ,$2 ,$3) }
X	;
X
new_expr:
X	  member_expr
X	| NEW new_expr			{ `(js-new ,$2) }
X	;
X
call_expr:
X	  member_expr arguments		{ `(funcall ,$1 . ,$2) }
X	| call_expr   arguments		{ `(funcall ,$1 . ,$2) }
X	| call_expr '[' expr ']'	{ `(if (integerp ,$3) (aref ,$1 ,$3) (get ,$1 ,$3)) }
X	| call_expr '.' IDENTIFIER      { `(get ,$1 ,$3) }
X	;
X
arguments:
X	  '(' ')'			{ nil }
X	| '(' arg_list ')'		{ (nreverse $2) }
X	;
X
arg_list:
X	  assign_expr			{ (list $1) }
X	| arg_list ',' assign_expr	{ (cons $3 $1) }
X	;
X
lhs_expr:
X	  new_expr
X	| call_expr
X	;
X
pf_expr: lhs_expr
X	| pf_expr {(setq ecma-newline-prohibitted t)} "++" %prec POSTFIX {`(1- (incf ,$1))}
X	| pf_expr {(setq ecma-newline-prohibitted t))} "--" %prec POSTFIX {`(1+ (decf ,$1))}
X	;
X
assign_expr:
X	pf_expr
X	| DELETE assign_expr
X	| VOID   assign_expr			{ `(progn ,$2 nil) }
X	| TYPEOF assign_expr 
X	| "++"   assign_expr			{ `(incf ,$2) }
X	| "--"   assign_expr			{ `(decf ,$2) }
X	| '+'    assign_expr %prec UPLUS	{ $2 }
X	| '-'    assign_expr %prec UMINUS	{ `(- ,$2) }
X	| '~'    assign_expr			{ `(lognot ,$2) }
X	| '!'    assign_expr			{ `(not ,$2) }
X	| assign_expr '*'   assign_expr	{ `(*   ,$1 ,$3) }
X	| assign_expr '/'   assign_expr { `(/   ,$1 ,$3) }
X	| assign_expr '%'   assign_expr { `(%   ,$1 ,$3) }
X	| assign_expr '+'   assign_expr { `(+   ,$1 ,$3) }
X	| assign_expr '-'   assign_expr { `(-   ,$1 ,$3) }
X	| assign_expr "<<"  assign_expr { `(ash ,$1 ,$3) }
X	| assign_expr ">>"  assign_expr { `(ash ,$1 (- ,$3)) }
X	| assign_expr ">>>" assign_expr { `(lsh ,$1 (- ,$3)) }
X	| assign_expr '<'   assign_expr { `(<   ,$1 ,$3) }
X	| assign_expr '>'   assign_expr { `(>   ,$1 ,$3) }
X	| assign_expr "<="  assign_expr { `(<=  ,$1 ,$3) }
X	| assign_expr ">="  assign_expr { `(>=  ,$1 ,$3) }
X	| assign_expr "=="  assign_expr { `(eql ,$1 ,$3) }
X	| assign_expr "!="  assign_expr { `(not (eql ,$1 ,$3)) }
X	| assign_expr "&&"  assign_expr { `(and ,$1 ,$3) }
X	| assign_expr "||"  assign_expr { `(or  ,$1 ,$3) }
X	| assign_expr '|'   assign_expr { `(logior ,$1 ,$3) }
X	| assign_expr '&'   assign_expr { `(logand ,$1 ,$3) }
X	| assign_expr '^'   assign_expr { `(logxor ,$1 ,$3) }
X	| assign_expr '='   assign_expr { `(setf ,$1 ,$3) }
X	| assign_expr "*="  assign_expr { `(setf ,$1 (* ,$1 ,$3)) }
X	| assign_expr "/="  assign_expr { `(setf ,$1 (/ ,$1 ,$3)) }
X	| assign_expr "%="  assign_expr { `(setf ,$1 (% ,$1 ,$3)) }
X	| assign_expr "+="  assign_expr { `(incf ,$1 ,$3) }
X	| assign_expr "-="  assign_expr { `(decf ,$1 ,$3) }
X	| assign_expr "<<=" assign_expr { `(setf ,$1 (ash ,$1 ,$3)) }
X	| assign_expr ">>=" assign_expr { `(setf ,$1 (ash ,$1 (- ,$3))) }
X	| assign_expr ">>>=" assign_expr  { `(setf ,$1 (lsh ,$1 (- ,$3))) }
X	| assign_expr "&="  assign_expr { `(setf ,$1 (logand ,$1 ,$3)) }
X	| assign_expr "^="  assign_expr { `(setf ,$1 (logxor ,$1 ,$3)) }
X	| assign_expr "|="  assign_expr { `(setf ,$1 (logior ,$1 ,$3)) }
X	| assign_expr '?' assign_expr ':' assign_expr
X					{`(if ,$1 ,$3 ,$5)}
X	/* XXX undocumented non-standard syntax */
X	| '[' arg_list ']' 		{ `(vector .,(reverse $2 )) }
X	| '[' ']' 			{ `(vector) }
X	;
X
expr:
X	assign_expr
X	| expr ',' assign_expr	{`(progn ,$1 ,$3)}
X	;
X
stmt:
X	  block
X	| var_stmt
X	| empty_stmt
X	| expr_stmt
X	| if_stmt
X	| iter_stmt
X	| cont_stmt
X	| break_stmt
X	| return_stmt
X	| with_stmt
X	;
X
block:
X	  '{' '}'		{ nil }
X	| '{' stmt_list '}' 	{ `(progn . ,(nreverse $2)) }
X	;
X
stmt_list:
X	  stmt			{ (list $1) }
X	| stmt_list stmt 	{ (cons $2 $1) }
X	;
X
var_stmt:
X	  VAR vardecl_list magic_semicolon
X	{ `(setq . ,(nreverse $2)) }
X	;
X
vardecl_list:
X	vardecl
X	| vardecl_list ',' vardecl	{ (nconc $3 $1) }
X	;
X
vardecl:
X	  IDENTIFIER			{ (list nil $1) }
X	| IDENTIFIER '=' assign_expr	{ (list $3 $1) }
X	;
X
empty_stmt:
X	';'			{nil}
X	;
X
expr_stmt:
X	expr magic_semicolon	
X	;
X
if_stmt:
X	  IF '(' expr ')' stmt ELSE stmt
X	{ `(if ,$3 ,$5 ,$7) }
X	| IF '(' expr ')' stmt 
X	{ `(if ,$3 ,$5) }
X
expr_opt: /* empty */ 		{nil}
X	| expr
X	;
X
iter_stmt:
X	  WHILE '(' expr ')' stmt
X	{`(while ,$3 ,$5)}
X	| FOR   '(' expr_opt ';' expr_opt ';' expr_opt ')' stmt
X	{ `(progn ,$3 (while ,$5 ,$9 ,$7)) }
X	| FOR   '(' VAR vardecl_list ';' expr_opt ';' expr_opt ')' stmt
X	{ `(progn (setq . ,(nreverse $4)) (while ,$6 ,$10 ,$8)) }
X	| FOR   '(' lhs_expr IN expr ')' stmt
X	| FOR   '(' VAR IDENTIFIER IN expr ')' stmt
X	{ `(mapcar (function (lambda (,$4) ,$8)) ,$6) }
X	| FOR   '(' VAR IDENTIFIER '=' assign_expr IN expr ')' stmt
X	;
X
cont_stmt:
X	CONTINUE magic_semicolon
X	;
X
break_stmt:
X	BREAK magic_semicolon
X	;
X
return_stmt:
X	RETURN {(setq ecma-newline-prohibitted t)} expr_opt magic_semicolon
X	;
X
with_stmt:
X	WITH '(' expr ')' stmt
X	;
X
magic_semicolon:
X	  ';'
X	| '\n'
X	| error { (or ecma-newline-found (error "Parse Error")) }
X	;
X
func_decl:
X	FUNCTION IDENTIFIER '(' formals_opt ')' block {`(defun ,$2 ,$4 ,$6)}
X	;
X
formals_opt: 
X	/* empty */			{nil}
X	| formals 			{(nreverse $1)}
X	;
X
formals:
X	  IDENTIFIER			{(list $1)}
X	| formals ',' IDENTIFIER	{(cons $3 $1)}
X	;
X
elems:
X	  elem				{(list $1)}
X	| elems elem			{(cons $2 $1)}
X	;
X
elem:
X	  stmt
X	| func_decl
X	;
X
program: elems				{`(progn .,(nreverse $1))}
X	;
X
%%
SHAR_EOF
  $shar_touch -am 0215005198 'jscript/ecma.y' &&
  chmod 0644 'jscript/ecma.y' ||
  $echo 'restore of' 'jscript/ecma.y' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'jscript/ecma.y:' 'MD5 check failed'
c57eb7349d0d5eea62b289f7ca118065  jscript/ecma.y
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'jscript/ecma.y'`"
    test 6452 -eq "$shar_count" ||
    $echo 'jscript/ecma.y:' 'original size' '6452,' 'current size' "$shar_count!"
  fi
fi
# ============= jscript/ecma.el ==============
if test -f 'jscript/ecma.el' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'jscript/ecma.el' '(file already exists)'
else
  $echo 'x -' extracting 'jscript/ecma.el' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'jscript/ecma.el' &&
(require 'cl)
(require 'bytecomp)
X
(require 'parser)
(define-parser ecma ecma-yylex "ecma.tab.c" "ecma.tab.h" "ecma.act")
X
(defvar ecma-newline-found nil)
(defvar ecma-newline-prohibitted nil)
(defsubst ecma-skip-white-space nil
X  (setq ecma-newline-found nil)
X  (skip-chars-forward "\011\013\014\040")
X  (while (cond ((and (eq ?/ (following-char)) (eq ?/ (char-after (1+ (point)))))
X		(forward-char 2)
X		(skip-chars-forward "^\n\r"))
X	       ((and (eq ?/ (following-char)) (eq ?* (char-after (1+ (point)))))
X		(forward-char 2)
X		(search-forward "*/" nil t))
X	       ((or (eq ?\n (following-char)) (eq ?\r (following-char)))
X		(setq ecma-newline-found t)
X		(when ecma-newline-prohibitted
X		  (setq ecma-newline-prohibitted nil)
X		  (throw 'token (eval-when-compile (parser-token-lookup 'ecma ?\n))))
X		(skip-chars-forward "\n\r")))
X    (skip-chars-forward "\011\013\014\040"))
X  (setq ecma-newline-prohibitted nil)
X  (and (eobp) (setq ecma-newline-found t)))
X
(defun ecma-read-string nil
X  (cond ((looking-at "'\\([^\\\\'\n]\\|\\\\.\\)*'")
X	 (narrow-to-region (match-beginning 0) (match-end 0))
X	 (while (re-search-forward "\\`\\([^\\\\\"]\\|\\\\.\\)*\"" nil t)
X	   (backward-char)
X	   (insert-char ?\\ 1)
X	   (goto-char (point-min)))
X	 (goto-char (point-min))
X	 (delete-char 1)
X	 (insert-char ?\" 1)
X	 (goto-char (1- (point-max)))
X	 (delete-char 1)
X	 (insert-char ?\" 1)
X	 (goto-char (point-min)))
X	((looking-at "\"\\([^\\\\\"\n]\\|\\\\.\\)*\"")
X	 (narrow-to-region (match-beginning 0) (match-end 0)))
X	(t 
X	 (error "Parse error")))
X  (prog1 (read (current-buffer))
X    (assert (eobp))
X    (widen)))
X
(defun ecma-read-octal nil
X  (narrow-to-region (match-beginning 0) (match-end 0))
X  (goto-char (point-min))
X  (prog1
X      (let ((val 0))
X	(while (and (>= (following-char) ?0) (<= (following-char) ?9))
X	  (setq val (+ (* val 8) (- (following-char) 48)))
X	  (forward-char 1))
X	val)
X    (assert (eobp))
X    (widen)))
X
(defun ecma-read-hex nil
X  (narrow-to-region (+ 2 (match-beginning 0)) (match-end 0))
X  (upcase-region (point-min) (point-max))
X  (goto-char (point-min))
X  (prog1
X      (let ((val 0))
X	(while (looking-at "[0-9A-F]")
X	  (setq val (+ (* val 16) (- (following-char) (if (>= (following-char) 65) 55 48))))
X	  (forward-char 1))
X	val)
X    (assert (eobp))
X    (widen)))
X    
(eval-and-compile
X  (defconst ecma-tokens
X    (mapcar (function (lambda (tok)
X			(setf (second tok) 
X			      (parser-token-lookup 'ecma (second tok)))
X			tok))
X	    `(
X	      ("break" 	BREAK)
X	      ("for"	FOR)
X	      ("new"	NEW)
X	      ("var"	VAR)
X	      ("continue" CONTINUE)
X	      ("function" FUNCTION)
X	      ("return"	RETURN)
X	      ("void"	VOID)
X	      ("delete"	DELETE)
X	      ("if"	IF)
X	      ("this"	THIS)
X	      ("while"	WHILE)
X	      ("else"	ELSE)
X	      ("in"	IN)
X	      ("typeof"	TYPEOF)
X	      ("with"	WITH)
X	      ("null"	LIT_NULL)
X	      ("false"	LIT_FALSE)
X	      ("true"	LIT_TRUE)
X	      ("[a-zA-Z$_][a-zA-Z$_0-9]*" 
X	       IDENTIFIER
X	       t)
X	      ("0[xX][0-9a-fA-F]*"
X	       NUMBER
X	       ecma-read-hex);;XXX Hex
X	      ("[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]*"
X	       NUMBER
X	       t)
X	      ("0[0-7]*"
X	       NUMBER
X	       ecma-read-octal);;XXX octal
X	      ("[\"\']"
X	       STRING
X	       ecma-read-string)
X	      ("=="	EQ)
X	      ("<="	LE)
X	      (">="	GE)
X	      ("!="	NE)
X	      ("&&"	LAN)
X	      ("||"	LOR)
X	      ("++"	INC)
X	      ("--"	DEC)
X	      ("<<"	SL)
X	      (">>"	SR)
X	      (">>>"	SRR)
X	      ("+="	IEQ)
X	      ("-="	DEQ)
X	      ("*="	MEQ)
X	      ("/="	SEQ)
X	      ("&="	AEQ)
X	      ("|="	OEQ)
X	      ("^="	XEQ)
X	      ("%="	MOEQ)
X	      ("<<="	SLEQ)
X	      (">>="	SREQ)
X	      (">>>="	SRREQ)
X	      ("="	?=)
X	      (">"	?>)
X	      ("<"	?<)
X	      (","	?,)
X	      ("!"	?!)
X	      ("~"	?~)
X	      ("?"	??)
X	      (":"	?:)
X	      ("."	?.)
X	      ("+"	?+)
X	      ("-"	?-)
X	      ("*"	?*)
X	      ("/"	?/)
X	      ("&"	?&)
X	      ("|"	?|)
X	      ("^"	?^)
X	      ("%"	?%)
X	      ("("	?\()
X	      (")"	?\))
X	      ("{"	?{)
X	      ("}"	?})
X	      ("["	?\[)
X	      ("]"	?\])
X	      (";"	?\;)
X	      ))
X    "regexps should not contain subexpressions, 
and there should be less than 10 regexps
the fewer the regexps the better the performance
X
strings will be read as symbols,
regexps will be read unquoted using read, 
or maybe one day using buffer-substring")
X  )
(define-lexer ecma ecma-tokens ecma-skip-white-space)
X
(defun ecma-parse-region (beg end)
X  (interactive "r")
X  (with-output-to-temp-buffer "*JavaScript Parse Results*"
X    (save-excursion
X      (let ((buf (current-buffer))
X	    result before after delta)
X	(set-buffer (generate-new-buffer " *js parse temp*"))
X	(buffer-disable-undo)
X	(insert-buffer-substring buf beg end)
X	(goto-char (point-min))
X	(setq before (memory-use-counts)
X	      result (ecma)
X	      after (memory-use-counts)
X	      result (cl-macroexpand-all result)
X	      )
X	(while before
X	  (push (- (pop after) (pop before)) delta))
X	(setq delta (nreverse delta))
X	(decf (car delta) 7)
X	(kill-buffer (current-buffer))
X	(pp result)
X	(princ (apply 'format "\n\n%d tokens, %d cycles\ncons:%d fl:%d vec:%d sym:%d str:%d misc:%d int:%d"
X		      parser-tokens parser-cycles delta))
X	))))
X
(defun ecma-lex nil
X  (interactive)
X  (let ((yytname (get 'ecma 'yytname)))
X    (message "%s (%s)" (aref yytname (ecma-yylex)) yylval)))
SHAR_EOF
  $shar_touch -am 0215012998 'jscript/ecma.el' &&
  chmod 0664 'jscript/ecma.el' ||
  $echo 'restore of' 'jscript/ecma.el' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'jscript/ecma.el:' 'MD5 check failed'
742243ec206bf83dbfe950d1d3d77940  jscript/ecma.el
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'jscript/ecma.el'`"
    test 5353 -eq "$shar_count" ||
    $echo 'jscript/ecma.el:' 'original size' '5353,' 'current size' "$shar_count!"
  fi
fi
# ============= jscript/parser-ext.el ==============
if test -f 'jscript/parser-ext.el' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'jscript/parser-ext.el' '(file already exists)'
else
  $echo 'x -' extracting 'jscript/parser-ext.el' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'jscript/parser-ext.el' &&
(require 'parser)
X
;;; LEXER
X
(eval-when-compile
X (defmacro lex-var (symbol)
X   `(intern (concat (symbol-name name) "-" (symbol-name ',symbol))))
X )
X
(defmacro define-lexer (name token-list &optional pretoken-hook obarray-len)
X  (let ((token-list (eval token-list)) regexp subexps
X	toks tok regexp1 regs strs kwds)
X    (setq toks token-list)
X    (while (setq tok (pop toks))
X      (when (eq t (third tok))
X	(setf (third tok) 'parser-unquoted-read))
X      (if (third tok)
X	  (push tok regs)
X	(push tok strs)))
X    (setq regs (nreverse regs)
X	  regexp1 (concat "\\`\\(" (mapconcat 'car regs "\\|") "\\)")
X	  kwds (remove-if (function (lambda (tok) (string-match regexp1 (first tok)))) strs)
X	  kwds (sort kwds (function (lambda (a b) (> (length (car a)) (length (car b))))))
X	  regexp
X	  (mapconcat (function (lambda (tok)
X				 (if (third tok)
X				     (concat "\\(" (first tok) "\\)")
X				   (regexp-quote (first tok)))))
X		     (append regs kwds) "\\|")
X	  subexps
X	  (mapcar (function (lambda (tok)
X			      (cons (second tok) (third tok))))
X		  regs)
X	  )
X    `(progn
X       (defconst ,(lex-var tokens-regexp)   ,regexp)
X       (defconst ,(lex-var tokens-re-list) ',subexps)
X       ;; this one can't be inlined because you can't prin->read an obarray
X       (defconst ,(lex-var tokens-obarray)  (let ((oba (make-vector ,(or obarray-len 13) nil)))
X					      (mapcar (function (lambda (cell)
X								  (fset (intern (car cell) oba)
X									'keyword)
X								  (set (intern (car cell) oba)
X								       (cadr cell))))
X						      ',strs)
X					      oba))
X       ;;XXX(defconst ,(lex-var real-obarray) obarray "obarry to restore to")
X       (defconst ,(lex-var i) nil 	"lexer temporary variable")
X       (defconst ,(lex-var subexps) nil 	"lexer-temporary variable")
X       (defun ,(lex-var yylex) nil
X	 (catch 'token
X	   ,(if pretoken-hook
X		(list pretoken-hook))
X	   (when (looking-at ,(lex-var tokens-regexp))
X	     (setq ,(lex-var i) 0
X		   ,(lex-var subexps) ,(lex-var tokens-re-list))
X	     (let ((obarray ,(lex-var tokens-obarray))) ;; XXX
X	       (while (and ,(lex-var subexps) (null (match-beginning (incf ,(lex-var i)))))
X		 (pop  ,(lex-var subexps)))
X	       (cond ((null (car ,(lex-var subexps)))
X		      (setq yylval (parser-quoted-read))
X		      (symbol-value yylval))
X		     (t
X		      (setq yylval (funcall (cdar ,(lex-var subexps))))
X		      (if (and (symbolp yylval)
X			       (fboundp yylval)
X			       (eq (symbol-function yylval) 'keyword)
X			       (boundp yylval))
X			  (symbol-value yylval)
X			(caar ,(lex-var subexps)))))
X	       ))))
X       )))
X
X
X
X
;;; PARSER
(defmacro define-parser (name lexer file hfile action-file)
X  "Define a parser function NAME based on bison output files to parser LEXER
This function just calls yyparse with its name as an argument,
it's name has a property list that contains the grammar tables and lexer"
X  (save-excursion (parser-grab-data name file hfile action-file))
X  `(progn
X     (setplist ',name ',(symbol-plist name))
X     (put ',name 'yylex ',lexer)
X     (defun ,name nil
X       ,(format "A parser generated from bison output files\n(lexer is %s bison files were %s, %s, %s)"
X		(symbol-name lexer)
X		file hfile action-file)
X       (yyparse (quote ,name)))))
X
(defun parser-grab-data (name file hfile action-file)
X  (let (tmp (buf (generate-new-buffer file)))
X    (switch-to-buffer buf)
X    (buffer-disable-undo buf)
X    (insert-file-contents file)
X	
X    (mapcar '(lambda (v) (put name v (parser-grab-define v)))
X	    parser-defines)
X    (mapcar '(lambda (v) (put name v (parser-grab-array v)))
X	    parser-arrays)
X    
X    (mapcar '(lambda (v) (parser-fix-array (get name v)
X					   (get name 'YYFLAG)))
X	    parser-arrays)
X    
X    (put name 'yytname (parser-grab-yytname (get name 'YYNTOKENS) 
X					    (get name 'YYNNTS)))
X
X    (insert-file-contents hfile nil nil nil t)
X    (put name 'tokens (parser-grab-tokens (get name 'yytranslate)))
X    
X    (insert-file-contents action-file nil nil nil t)
X    (put name 'actions (parser-grab-actions (get name 'YYNRULES) 
X					    action-file))
X    (kill-buffer buf)))
X
X
(defun parser-grab-define (def)
X  (goto-char (point-min))
X  (re-search-forward (concat "#define[ \t]+"
X				 (regexp-quote (symbol-name def))
X				 "[ \t]+"))
X  (read (current-buffer)))
X
(defun parser-grab-array (arr)
X  (goto-char (point-min))
X  (re-search-forward (concat (regexp-quote (symbol-name arr))
X				 (regexp-quote "[]")
X				 "[ \t]*"
X				 (regexp-quote "=")
X				 "[ \t]*"
X				 "\\([[{][^}]*[]}]\\)"
X				 ))
X  (subst-char-in-region (match-beginning 1)
X			(match-end 1)
X			?, ? t)
X  (subst-char-in-region (match-beginning 1)
X			(1+ (match-beginning 1))
X			?{ ?\[ t)
X  (subst-char-in-region (match-end 1)
X			(1- (match-end 1))
X			?} ?\] t)
X  (goto-char (match-beginning 1))
X  (read (current-buffer)))
X
(defun parser-fix-array (arr yyflag)
X  (let ((i (length arr)))
X    (while (>= (decf i) 0)
X      (if (= (aref arr i) yyflag)
X	  (aset arr i nil)))))
X
(defun parser-grab-actions (maxrule filename)
X  (let (rule 
X	(byte-compile-current-file filename)
X	(byte-compile-current-form "Grammar Rules")
X	(vars (append parser-vars '(yyvsp)))
X	(acts (make-vector (1+ maxrule) nil)))
X    (goto-char (point-min))
X    (while (re-search-forward "yylsp\\[-1\\]" nil t)
X      (replace-match "@"))
X    (goto-char (point-min))
X    (while (re-search-forward "yyvsp\\[-?\\([0-9]+\\)\\]" nil t)
X      (replace-match "(nth \\1 yyvsp)"))
X    (goto-char (point-min))
X    (while (re-search-forward "^case \\([0-9]+\\):\n#line [0-9]+[^\n]*\n{\\([^}]*\\)break;}\n\\(case\\|\\'\\)" nil t)
X      (aset acts
X	    (progn
X	      (subst-char-in-region (match-end 1) (1+ (match-end 1)) ?: ? )
X	      (goto-char (match-beginning 1))
X	      (setq rule (read (current-buffer))))
X	    (progn
X	      (goto-char (match-beginning 2))
X	      (narrow-to-region (match-beginning 2) (match-end 2))
X	      (goto-char (point-min))
X					; (if yydebug
X	      (list 'lambda nil (macroexpand (read (current-buffer))))
X	      ;; this crud is to avoid turning off free-vars
X	      ;; maybe i should just do that
X					; (displaying-byte-compile-warnings
X					; (byte-compile-close-variables
X					; (setq byte-compile-bound-variables vars
X					; byte-compile-current-form (format "Rule %d" rule))
X					; (byte-compile-lambda (list 'lambda nil (read (current-buffer))))
X	      ))
X      (goto-char (point-max))
X      (widen))
X    acts))
X
(defun parser-grab-tokens (yytranslate)
X  (goto-char (point-min))
X  (flush-lines "YYSTYPE")
X  (keep-lines  "^#define")
X  (goto-char (point-min))
X  (while (re-search-forward "^#define[\t ]+\\([a-zA-Z_0-9]+\\)[\t ]+\\([0-9]+\\)" nil t)
X    (replace-match "(\\1 . \\2)"))
X  (goto-char (point-min))
X  (insert "(\n")
X  (goto-char (point-max))
X  (insert ")")
X  (goto-char (point-min))
X  (let ((tokens (read (current-buffer))) 
X	(i (length yytranslate)))
X    (setq tokens (mapcar (function (lambda (tok)
X				     (cons (car tok)
X					   (aref yytranslate (cdr tok)))))
X			 tokens))
X    (while (>= (decf i) 0)
X      (or (rassq (aref yytranslate i) tokens)
X	  (<= (aref yytranslate i) 2)
X	  (push (cons (concat "'" (char-to-string i) "'")
X		      (aref yytranslate i))
X		tokens)))
X    (push (cons "end-of-file" 0) tokens)
X    tokens))
X
(defun parser-grab-yytname (yyntokens yynnts)
X  (let ((yytname (make-vector (+ yyntokens yynnts) nil)) 
X	(i -1))
X    (goto-char (point-min))
X    (re-search-forward "yytname\\[\\][ 	]*=[ 	]*{[^\"]*")
X    (while (= (following-char) ?\")
X      (aset yytname (incf i) (read (current-buffer)))
X      (skip-chars-forward ", \n\t"))
X    yytname))
X
X
(provide 'parser-ext)
SHAR_EOF
  $shar_touch -am 0220005298 'jscript/parser-ext.el' &&
  chmod 0664 'jscript/parser-ext.el' ||
  $echo 'restore of' 'jscript/parser-ext.el' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'jscript/parser-ext.el:' 'MD5 check failed'
73816183ab75c646f83c0d7958376d03  jscript/parser-ext.el
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'jscript/parser-ext.el'`"
    test 7557 -eq "$shar_count" ||
    $echo 'jscript/parser-ext.el:' 'original size' '7557,' 'current size' "$shar_count!"
  fi
fi
# ============= jscript/parser.el ==============
if test -f 'jscript/parser.el' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'jscript/parser.el' '(file already exists)'
else
  $echo 'x -' extracting 'jscript/parser.el' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'jscript/parser.el' &&
X
(require 'cl)
X
(autoload 'define-parser "parser-ext" "Define parser" nil 'macro)
(autoload 'define-lexer  "parser-ext" "Define lexer"  nil 'macro)
X
(eval-when-compile
X  (defconst parser-bad-chars 
X    (eval-when-compile
X      (let ((i 256)
X	    (obarray (make-vector 13 nil)) ;; don't clutter up the real obarray
X	    e)
X	(while (>= (decf i) 0)
X	  (if (string=  (prin1-to-string (intern (char-to-string i)))
X			(char-to-string i)) nil
X	    (push i e)))
X	;; ensure ] is at the start if present
X	;; ensure - is at the start if present
X	;; ensure ^ is _not_ at the start if present
X	(if (eq (car e) ?^)
X	    (setq e (nconc (delq ?^ e) (list ?^)))) ;; don't make that '(?^) or nconc will shoot you in the foot
X	(if (memq ?-  e)
X	    (setq e (cons ?- (delq ?- e))))
X	(if (memq ?\] e)
X	    (setq e (cons ?\] (delq ?\] e))))
X	e))
X    "A list of characters that may have to be escaped to be read in a symbol
Tries to put ] and - at the beginning and ^ at the end so it can be easily
used to construct character sets and strings for skip-chars-forward")
X  )
X
(eval-and-compile  
;;  (defconst parser-bad-chars-str
;;    (eval-when-compile
;;      (mapconcat (function (lambda (c)
;;			     (if (memq c '(?^ ?- ?\\))
;;				 (format "\\%c" c)
;;			       (char-to-string c))))
;;		 parser-bad-chars
;;		 ""))
;;    "A skip-chars-forward string of characters that should be escaped before reading")
;;  
;;  (defconst parser-bad-chars-charset
;;    (eval-when-compile
;;      (concat "["
;;	      (mapconcat 'char-to-string parser-bad-chars "")
;;	      "]"))
;;    "A regexp character set of characters that should be escaped before reading")
X
X  (defconst parser-except-bad-chars-str 
X    (eval-when-compile (concat "^" parser-bad-chars))
X    "A inverse set of parser-bad-chars, just that with a ^ prepended")
X
;;  (defconst parser-except-bad-charset
;;    (eval-when-compile
;;      (concat "[^"
;;	      (mapconcat 'char-to-string parser-bad-chars "")
;;	      "]"))
;;    "A regexp character set of characters that should not escaped before reading")
X  )
X
X
;;; The functions that actually form the lexer
(defun parser-quoted-read nil
X  "Read a token using read to return a symbol, quoting any characters needed.
Must be called with match-beginning...match-end across the token to read"
X  (narrow-to-region (match-beginning 0) (match-end 0))
X  (goto-char (point-min))
X  (while (progn
X	   (skip-chars-forward parser-except-bad-chars-str (point-max))
X	   (not (eobp)))
X    (insert-char ?\\ 1)
X    (forward-char 1))
X  (goto-char (point-min))
X  (prog1 (read (current-buffer))
X    (assert (eobp) )
X    (widen)))
X
(defun parser-unquoted-read nil
X  "Read a token using read to return whatever data type is in the buffer.
Must be called with match-beginning...match-end across the token to read"
X  (narrow-to-region (match-beginning 0) (match-end 0))
X  (goto-char (point-min))
X  (prog1
X      (read (current-buffer))
X    (assert (eobp))
X    (widen)))
X
X
X
;;; PARSER  
X
X
(defun parser-token-lookup (parser tok)
X  (cond ((symbolp tok)
X	 (cdr (assq  tok (get parser 'tokens))))
X	((numberp tok)
X	 (aref (get parser 'yytranslate) tok))
X	(t
X	 tok)))
X
(eval-and-compile
X  (defconst parser-defines '(YYFINAL YYNTBASE YYNTOKENS YYFLAG
X				     YYNNTS YYNRULES YYNSTATES YYLAST YYMAXUTOK))
X  (defconst parser-arrays  '(yytranslate yyprhs yyrhs yyrline ;; don't put yytname in!
X					 yyr1 yyr2 yydefact yydefgoto yypact yypgoto
X					 yytable yycheck))
X  (defconst parser-vars (append parser-defines
X				parser-arrays 
X				'(yylex
X				  actions
X				  tokens
X				  yytname)))
X  )
(eval-when-compile
X  (defvar yydebug nil
X    "*If this is t then message every shift and reduction in yyparse")
X  
X  (defmacro parser-token-name (val)
X    `(aref yytname ,val))
X  
X  (defmacro parser-rule (rulen)
X    `(let ((i (1- (aref yyprhs ,rulen)))
X	   l)
X       (while (/= 0 (aref yyrhs (incf i)))
X	 (push (parser-token-name (aref yyrhs i)) l))
X       (push "->" l)
X       (push (parser-token-name (aref yyr1 ,rulen)) l)
X       (format "Rule %d (line %d): %s" ,rulen (aref yyrline ,rulen) (mapconcat 'identity (nreverse l) " "))))
X  
X  (defmacro with-parser-variables (parser &rest forms)
X    `(let ,(mapcar '(lambda (v)
X		      (list v (list 'get
X				    parser
X				    (list 'quote v))))
X		   parser-vars)
X       ,@forms))
X  
X  
X  (defmacro yydebug (msg &rest args)
X    (if yydebug
X	(cons 'message (cons msg args))))
X  
X  (defmacro yycheck (yyn yychar)
X    `(and (numberp ,yyn)
X	  (>= ,yyn 0)
X	  (< ,yyn YYLAST)
X	  (= (aref yycheck ,yyn) ,yychar)))
X  )
X
;;;###autoload
(defvar parser-cycles nil "Number of cycles last parse took")
(defvar parser-tokens nil "Number of tokens last parse read")
(defvar yylval nil "variable lexer uses to return token")
X
(defun yyparse (parser)
X  (with-parser-variables parser
X    (let ((yystate 0) yyn yyssp yyvsp yychar yyval yylval yylen yyact)
X      (setq parser-cycles 0 parser-tokens 0)
X      (push nil yyvsp)
X      (push yystate yyssp)
X      (message "Beginning parse")
X      ;; yynewstate:
X      (while (/= yystate YYFINAL)
X	(yydebug "Entering state: %d" yystate)
X
X	(incf parser-cycles)
X
X	(when (setq yyn (aref yypact yystate))
X	  (incf parser-tokens)
X	  (setq yychar (or yychar (funcall yylex) 0))
X	  (yydebug "Read token: %s" (parser-token-name yychar))
X	  (setq yyn (+ yyn yychar)))
X
X	(if (yycheck yyn yychar)
X	    (setq yyn (aref yytable yyn))
X	  (setq yyn (- (aref yydefact yystate))))
X
X	;; if we're going to shift it discard the lookahead character
X	(and (numberp yyn) (> yyn 0) 
X	     (setq yychar nil))
X	;; error handling XXX this only handles simple cases
X	(when (or (null yyn)
X		  (zerop yyn))
X	  (setq yyn (aref yypact yystate))
X	  (unless (and yyn
X		       (incf yyn)
X		       (yycheck yyn 1)
X		       (setq yyn (aref yytable yyn))
X		       (/= 0 yyn))
X	    (error "Parse error")))
X	  
X	(if (< yyn 0);; REDUCE
X	    (progn
X	      (setq yyn (- yyn)
X		    yylen (aref yyr2 yyn)
X		    ;; default value of actions
X		    yyact (aref actions yyn))
X	      (yydebug "Reducing using %s { %s }"
X		       (parser-rule yyn)
X		       ;;yylen
X		       (cond ((null yyact)
X			      "Default action ($1)")
X			     ((byte-code-function-p yyact)
X			      "Byte compiled action")
X			     (t
X			      yyact)))
X	      (if yyact
X		  (setq yyval (funcall yyact))
X		(setq yyval (nth (1- yylen) yyvsp)))
X	      
X	      (setq yyvsp (nthcdr yylen yyvsp)
X		    yyssp (nthcdr yylen yyssp))
X	      
X	      (yydebug "Action result: %s" yyval)
X	      (yydebug "Value stack now: %s" yyvsp)
X	      (yydebug "State stack now: %s" yyssp)
X	  
X	      (setq yyn (aref yyr1 yyn)
X		    yystate (aref yypgoto (- yyn YYNTBASE)))
X	      (if yystate
X		  (incf yystate (car yyssp)))
X	      
X	      (if (or (null yystate)
X		      (< yystate 0)
X		      (> yystate YYLAST)
X		      (/= (aref yycheck yystate) (car yyssp)))
X		  (push (setq yystate (aref yydefgoto (- yyn YYNTBASE))) yyssp)
X		(push (setq yystate (aref yytable yystate)) yyssp))
X	      (push yyval yyvsp)
X	      nil)
X	  ;; SHIFT
X	  (yydebug "Shifting token")
X	  (push yylval yyvsp)
X	  (push yyn    yyssp)
X	  (yydebug "Value stack now: %s" yyvsp)
X	  (yydebug "State stack now: %s" yyssp)
X	  (setq yystate yyn)
X	  nil
X	  ))
X      (message "Parse Finished (%d tokens, %d cycles)" parser-tokens parser-cycles)
X      yyval)))
X
X
(provide 'parser)
X
;;; Local Variables:
;;; eval: (put 'with-parser-variables 'lisp-indent-function 1)  
;;; End:
SHAR_EOF
  $shar_touch -am 0214211198 'jscript/parser.el' &&
  chmod 0664 'jscript/parser.el' ||
  $echo 'restore of' 'jscript/parser.el' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'jscript/parser.el:' 'MD5 check failed'
2584b00fbd7a3527cf19158476ca56e4  jscript/parser.el
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'jscript/parser.el'`"
    test 7359 -eq "$shar_count" ||
    $echo 'jscript/parser.el:' 'original size' '7359,' 'current size' "$shar_count!"
  fi
fi
rm -fr _sh27536
exit 0
