Compare commits
1 Commits
JS2_DIKDIK
...
src
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
258dc9fead |
@@ -1 +0,0 @@
|
||||
|
||||
@@ -1,29 +0,0 @@
|
||||
The contents of this file are subject to the Netscape Public
|
||||
License Version 1.1 (the "License"); you may not use this file
|
||||
except in compliance with the License. You may obtain a copy of
|
||||
the License at http://www.mozilla.org/NPL/
|
||||
|
||||
Software distributed under the License is distributed on an "AS
|
||||
IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
implied. See the License for the specific language governing
|
||||
rights and limitations under the License.
|
||||
|
||||
The Original Code is the JavaScript 2 Prototype.
|
||||
|
||||
The Initial Developer of the Original Code is Netscape
|
||||
Communications Corporation. Portions created by Netscape are
|
||||
Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
Rights Reserved.
|
||||
|
||||
Alternatively, the contents of this file may be used under the
|
||||
terms of the GNU Public License (the "GPL"), in which case the
|
||||
provisions of the GPL are applicable instead of those above.
|
||||
If you wish to allow use of your version of this file only
|
||||
under the terms of the GPL and not to allow others to use your
|
||||
version of this file under the NPL, indicate your decision by
|
||||
deleting the provisions above and replace them with the notice
|
||||
and other provisions required by the GPL. If you do not delete
|
||||
the provisions above, a recipient may use your version of this
|
||||
file under either the NPL or the GPL.
|
||||
|
||||
|
||||
@@ -1,14 +0,0 @@
|
||||
2001-01-30 <rginda@netscape.com>
|
||||
|
||||
* broke apart some classes contained parser.* and utilities.* into
|
||||
seperate files.
|
||||
parser.* begat lexer.*, token.*, reader.*
|
||||
utilities.* begat mem.*, stlcfg.h, ds.h, strings.*, exception.*,
|
||||
formatter.*, and algo.h
|
||||
* parser reorg compile time data:
|
||||
|
||||
new layout: 0:48.01elapsed 86%CPU
|
||||
old layout: 0:55.85elapsed 57%CPU
|
||||
|
||||
(old layout includes only hash numerics utilities parser world object
|
||||
files)
|
||||
@@ -1 +0,0 @@
|
||||
|
||||
@@ -1,2 +0,0 @@
|
||||
|
||||
SUBDIRS = src tests
|
||||
@@ -1 +0,0 @@
|
||||
|
||||
@@ -1,98 +0,0 @@
|
||||
parse functions
|
||||
parseIdentifierQualifiers(ExprNode *e, bool &foundQualifiers,
|
||||
parseParenthesesAndIdentifierQualifiers(const Token &tParen,
|
||||
parseQualifiedIdentifier(const Token &t, bool preferRegExp)
|
||||
parseArrayLiteral(const Token &initialToken)
|
||||
parseObjectLiteral(const Token &initialToken)
|
||||
parsePrimaryExpression()
|
||||
parseMember(ExprNode *target, const Token &tOperator,
|
||||
parseInvoke(ExprNode *target, uint32 pos,
|
||||
parsePostfixExpression(bool newExpression)
|
||||
parseUnaryExpression()
|
||||
parseExpression(bool noIn, bool noAssignment, bool noComma)
|
||||
parseParenthesizedExpression()
|
||||
parseTypeExpression(bool noIn)
|
||||
parseTypedIdentifier(ExprNode *&type)
|
||||
parseTypeBinding(Token::Kind kind, bool noIn)
|
||||
parseTypeListBinding(Token::Kind kind)
|
||||
parseVariableBinding(bool noQualifiers, bool noIn)
|
||||
parseFunctionName(FunctionName &fn)
|
||||
parseFunctionSignature(FunctionDefinition &fd)
|
||||
parseBlock(bool inSwitch, bool noCloseBrace)
|
||||
parseBody(SemicolonState *semicolonState)
|
||||
parseAttributeStatement(uint32 pos, IdentifierList *attributes,
|
||||
parseAttributesAndStatement(const Token *t, AttributeStatement as,
|
||||
parseAnnotatedBlock()
|
||||
parseFor(uint32 pos, SemicolonState &semicolonState)
|
||||
parseTry(uint32 pos)
|
||||
parseStatement(bool /*topLevel*/, bool inSwitch,
|
||||
parseStatementAndSemicolon(SemicolonState &semicolonState)
|
||||
parseIdentifier()
|
||||
parseLiteralField()
|
||||
parseFieldName()
|
||||
parseArgumentList(NodeQueue<ExprPairList> &args)
|
||||
parseArgumentListPrime(NodeQueue<ExprPairList> &args)
|
||||
parseNamedArgumentListPrime(NodeQueue<ExprPairList> &args)
|
||||
parseAllParameters(FunctionDefinition &fd,
|
||||
parseOptionalNamedRestParameters (FunctionDefinition &fd,
|
||||
parseNamedRestParameters(FunctionDefinition &fd,
|
||||
parseNamedParameters(FunctionDefinition &fd,
|
||||
parseRestParameter()
|
||||
parseParameter()
|
||||
parseOptionalParameter()
|
||||
parseOptionalParameterPrime(VariableBinding *first)
|
||||
parseNamedParameter(NodeQueue<IdentifierList> &aliases)
|
||||
parseResultSignature()
|
||||
|
||||
|
||||
1/28/01
|
||||
|
||||
Files:
|
||||
|
||||
cpucfg.h
|
||||
|
||||
formatter.cpp formatter.h
|
||||
"Formatter" class, iostream like wrapper around stdio.
|
||||
|
||||
gc_allocator.h, gc_container.h
|
||||
boehm gc stuff.
|
||||
|
||||
hash.cpp hash.h
|
||||
a hash
|
||||
|
||||
lexer.cpp lexer.h
|
||||
main lexer.
|
||||
|
||||
mem.cpp mem.h
|
||||
zone, arena, and pool classes for memory management.
|
||||
|
||||
nodefactory.h
|
||||
parse node factory.
|
||||
|
||||
numerics.cpp numerics.h
|
||||
numbers and stuff.
|
||||
|
||||
parser.cpp parser.h
|
||||
main parser source.
|
||||
tables in parser.h:
|
||||
enum ExprNode::Kind; types of expressions
|
||||
enum StmtNode::Kind; types of statements
|
||||
|
||||
|
||||
reader.cpp reader.h
|
||||
"Reader" class, feeds source to the parser/lexer.
|
||||
|
||||
stlcfg.h
|
||||
stupid stl tricks
|
||||
.
|
||||
systemtypes.h
|
||||
basic typedefs.
|
||||
|
||||
token.cpp token.h
|
||||
token class.
|
||||
|
||||
utilities.cpp utilities.h
|
||||
random things.
|
||||
|
||||
world.cpp world.h
|
||||
the whole world.
|
||||
@@ -1,26 +0,0 @@
|
||||
redo parseAllPArameters code
|
||||
|
||||
|
||||
move js/js2 to js2/src
|
||||
move js/semantics to js2/semantics
|
||||
|
||||
compile on mac and windows
|
||||
|
||||
parser:
|
||||
|
||||
1. Parser is out of date (by 10%?)
|
||||
a. rework parser to reflect grammer productions.
|
||||
b. functional attrs.
|
||||
c. parser node struct changes.
|
||||
|
||||
2. Parser Restructuring (2 weeks.)
|
||||
|
||||
3. Common lisp generator running?
|
||||
|
||||
4. const-ness
|
||||
a. compile time detection.
|
||||
b. read before assign.
|
||||
c. runtime assignment prevention.
|
||||
d. class/ function/ const equivalence.
|
||||
|
||||
export, namespace, import, package ?
|
||||
140
mozilla/js2/aclocal.m4
vendored
140
mozilla/js2/aclocal.m4
vendored
@@ -1,140 +0,0 @@
|
||||
dnl aclocal.m4 generated automatically by aclocal 1.4
|
||||
|
||||
dnl Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc.
|
||||
dnl This file is free software; the Free Software Foundation
|
||||
dnl gives unlimited permission to copy and/or distribute it,
|
||||
dnl with or without modifications, as long as this notice is preserved.
|
||||
|
||||
dnl This program is distributed in the hope that it will be useful,
|
||||
dnl but WITHOUT ANY WARRANTY, to the extent permitted by law; without
|
||||
dnl even the implied warranty of MERCHANTABILITY or FITNESS FOR A
|
||||
dnl PARTICULAR PURPOSE.
|
||||
|
||||
# Do all the work for Automake. This macro actually does too much --
|
||||
# some checks are only needed if your package does certain things.
|
||||
# But this isn't really a big deal.
|
||||
|
||||
# serial 1
|
||||
|
||||
dnl Usage:
|
||||
dnl AM_INIT_AUTOMAKE(package,version, [no-define])
|
||||
|
||||
AC_DEFUN(AM_INIT_AUTOMAKE,
|
||||
[AC_REQUIRE([AC_PROG_INSTALL])
|
||||
PACKAGE=[$1]
|
||||
AC_SUBST(PACKAGE)
|
||||
VERSION=[$2]
|
||||
AC_SUBST(VERSION)
|
||||
dnl test to see if srcdir already configured
|
||||
if test "`cd $srcdir && pwd`" != "`pwd`" && test -f $srcdir/config.status; then
|
||||
AC_MSG_ERROR([source directory already configured; run "make distclean" there first])
|
||||
fi
|
||||
ifelse([$3],,
|
||||
AC_DEFINE_UNQUOTED(PACKAGE, "$PACKAGE", [Name of package])
|
||||
AC_DEFINE_UNQUOTED(VERSION, "$VERSION", [Version number of package]))
|
||||
AC_REQUIRE([AM_SANITY_CHECK])
|
||||
AC_REQUIRE([AC_ARG_PROGRAM])
|
||||
dnl FIXME This is truly gross.
|
||||
missing_dir=`cd $ac_aux_dir && pwd`
|
||||
AM_MISSING_PROG(ACLOCAL, aclocal, $missing_dir)
|
||||
AM_MISSING_PROG(AUTOCONF, autoconf, $missing_dir)
|
||||
AM_MISSING_PROG(AUTOMAKE, automake, $missing_dir)
|
||||
AM_MISSING_PROG(AUTOHEADER, autoheader, $missing_dir)
|
||||
AM_MISSING_PROG(MAKEINFO, makeinfo, $missing_dir)
|
||||
AC_REQUIRE([AC_PROG_MAKE_SET])])
|
||||
|
||||
#
|
||||
# Check to make sure that the build environment is sane.
|
||||
#
|
||||
|
||||
AC_DEFUN(AM_SANITY_CHECK,
|
||||
[AC_MSG_CHECKING([whether build environment is sane])
|
||||
# Just in case
|
||||
sleep 1
|
||||
echo timestamp > conftestfile
|
||||
# Do `set' in a subshell so we don't clobber the current shell's
|
||||
# arguments. Must try -L first in case configure is actually a
|
||||
# symlink; some systems play weird games with the mod time of symlinks
|
||||
# (eg FreeBSD returns the mod time of the symlink's containing
|
||||
# directory).
|
||||
if (
|
||||
set X `ls -Lt $srcdir/configure conftestfile 2> /dev/null`
|
||||
if test "[$]*" = "X"; then
|
||||
# -L didn't work.
|
||||
set X `ls -t $srcdir/configure conftestfile`
|
||||
fi
|
||||
if test "[$]*" != "X $srcdir/configure conftestfile" \
|
||||
&& test "[$]*" != "X conftestfile $srcdir/configure"; then
|
||||
|
||||
# If neither matched, then we have a broken ls. This can happen
|
||||
# if, for instance, CONFIG_SHELL is bash and it inherits a
|
||||
# broken ls alias from the environment. This has actually
|
||||
# happened. Such a system could not be considered "sane".
|
||||
AC_MSG_ERROR([ls -t appears to fail. Make sure there is not a broken
|
||||
alias in your environment])
|
||||
fi
|
||||
|
||||
test "[$]2" = conftestfile
|
||||
)
|
||||
then
|
||||
# Ok.
|
||||
:
|
||||
else
|
||||
AC_MSG_ERROR([newly created file is older than distributed files!
|
||||
Check your system clock])
|
||||
fi
|
||||
rm -f conftest*
|
||||
AC_MSG_RESULT(yes)])
|
||||
|
||||
dnl AM_MISSING_PROG(NAME, PROGRAM, DIRECTORY)
|
||||
dnl The program must properly implement --version.
|
||||
AC_DEFUN(AM_MISSING_PROG,
|
||||
[AC_MSG_CHECKING(for working $2)
|
||||
# Run test in a subshell; some versions of sh will print an error if
|
||||
# an executable is not found, even if stderr is redirected.
|
||||
# Redirect stdin to placate older versions of autoconf. Sigh.
|
||||
if ($2 --version) < /dev/null > /dev/null 2>&1; then
|
||||
$1=$2
|
||||
AC_MSG_RESULT(found)
|
||||
else
|
||||
$1="$3/missing $2"
|
||||
AC_MSG_RESULT(missing)
|
||||
fi
|
||||
AC_SUBST($1)])
|
||||
|
||||
# Define a conditional.
|
||||
|
||||
AC_DEFUN(AM_CONDITIONAL,
|
||||
[AC_SUBST($1_TRUE)
|
||||
AC_SUBST($1_FALSE)
|
||||
if $2; then
|
||||
$1_TRUE=
|
||||
$1_FALSE='#'
|
||||
else
|
||||
$1_TRUE='#'
|
||||
$1_FALSE=
|
||||
fi])
|
||||
|
||||
# Like AC_CONFIG_HEADER, but automatically create stamp file.
|
||||
|
||||
AC_DEFUN(AM_CONFIG_HEADER,
|
||||
[AC_PREREQ([2.12])
|
||||
AC_CONFIG_HEADER([$1])
|
||||
dnl When config.status generates a header, we must update the stamp-h file.
|
||||
dnl This file resides in the same directory as the config header
|
||||
dnl that is generated. We must strip everything past the first ":",
|
||||
dnl and everything past the last "/".
|
||||
AC_OUTPUT_COMMANDS(changequote(<<,>>)dnl
|
||||
ifelse(patsubst(<<$1>>, <<[^ ]>>, <<>>), <<>>,
|
||||
<<test -z "<<$>>CONFIG_HEADERS" || echo timestamp > patsubst(<<$1>>, <<^\([^:]*/\)?.*>>, <<\1>>)stamp-h<<>>dnl>>,
|
||||
<<am_indx=1
|
||||
for am_file in <<$1>>; do
|
||||
case " <<$>>CONFIG_HEADERS " in
|
||||
*" <<$>>am_file "*<<)>>
|
||||
echo timestamp > `echo <<$>>am_file | sed -e 's%:.*%%' -e 's%[^/]*$%%'`stamp-h$am_indx
|
||||
;;
|
||||
esac
|
||||
am_indx=`expr "<<$>>am_indx" + 1`
|
||||
done<<>>dnl>>)
|
||||
changequote([,]))])
|
||||
|
||||
@@ -1,20 +0,0 @@
|
||||
|
||||
BOEHM_DIR = $(top_srcdir)/../gc/boehm/
|
||||
LIBBOEHM = $(BOEHM_DIR)/gc.a
|
||||
|
||||
JS2_DIR = $(top_srcdir)/src/
|
||||
LIBJS2 = $(JS2_DIR)/libjs2.a
|
||||
|
||||
WFLAGS = -Wmissing-prototypes -Wstrict-prototypes -Wunused \
|
||||
-Wswitch -Wall -Wconversion
|
||||
|
||||
if DEBUG
|
||||
CXXFLAGS = -DXP_UNIX -g -DDEBUG $(WFLAGS)
|
||||
JS1x_BINDIR = Linux_All_DBG.OBJ
|
||||
else
|
||||
CXXFLAGS = -DXP_UNIX -O2 -Wuninitialized $(WFLAGS)
|
||||
JS1x_BINDIR = Linux_All_OPT.OBJ
|
||||
endif
|
||||
|
||||
FDLIBM_DIR = $(top_srcdir)/../js/src/fdlibm/$(JS1x_BINDIR)
|
||||
LIBFDLIBM = $(FDLIBM_DIR)/libfdm.a
|
||||
@@ -1,42 +0,0 @@
|
||||
/* config.h.in. Generated automatically from configure.in by autoheader. */
|
||||
|
||||
/* Define if using alloca.c. */
|
||||
#undef C_ALLOCA
|
||||
|
||||
/* Define to one of _getb67, GETB67, getb67 for Cray-2 and Cray-YMP systems.
|
||||
This function is required for alloca.c support on those systems. */
|
||||
#undef CRAY_STACKSEG_END
|
||||
|
||||
/* Define if you have alloca, as a function or macro. */
|
||||
#undef HAVE_ALLOCA
|
||||
|
||||
/* Define if you have <alloca.h> and it should be used (not on Ultrix). */
|
||||
#undef HAVE_ALLOCA_H
|
||||
|
||||
/* Define if you have a working `mmap' system call. */
|
||||
#undef HAVE_MMAP
|
||||
|
||||
/* If using the C implementation of alloca, define if you know the
|
||||
direction of stack growth for your system; otherwise it will be
|
||||
automatically deduced at run-time.
|
||||
STACK_DIRECTION > 0 => grows toward higher addresses
|
||||
STACK_DIRECTION < 0 => grows toward lower addresses
|
||||
STACK_DIRECTION = 0 => direction of growth unknown
|
||||
*/
|
||||
#undef STACK_DIRECTION
|
||||
|
||||
/* Define if you have the ANSI C header files. */
|
||||
#undef STDC_HEADERS
|
||||
|
||||
/* Define if you have the getpagesize function. */
|
||||
#undef HAVE_GETPAGESIZE
|
||||
|
||||
/* Define if you have the <unistd.h> header file. */
|
||||
#undef HAVE_UNISTD_H
|
||||
|
||||
/* Name of package */
|
||||
#undef PACKAGE
|
||||
|
||||
/* Version number of package */
|
||||
#undef VERSION
|
||||
|
||||
2407
mozilla/js2/configure
vendored
2407
mozilla/js2/configure
vendored
File diff suppressed because it is too large
Load Diff
@@ -1,57 +0,0 @@
|
||||
dnl Process this file with autoconf to produce a configure script.
|
||||
|
||||
PACKAGE=JavaScript2
|
||||
VERSION=0.1
|
||||
AC_INIT(src/parser.h)
|
||||
AM_INIT_AUTOMAKE(JavaScript2, 0.1)
|
||||
|
||||
AC_ARG_ENABLE(debug,
|
||||
[ --enable-debug Turn on debugging],
|
||||
[case "${enableval}" in
|
||||
yes) debug=true ;;
|
||||
no) debug=false ;;
|
||||
*) AC_MSG_ERROR(bad value ${enableval} for --enable-debug) ;;
|
||||
esac],[debug=false])
|
||||
AM_CONDITIONAL(DEBUG, test x$debug = xtrue)
|
||||
|
||||
AM_CONFIG_HEADER(config.h)
|
||||
dnl Checks for programs.
|
||||
AC_PROG_CXX
|
||||
AC_PROG_AWK
|
||||
AC_PROG_CC
|
||||
AC_PROG_INSTALL
|
||||
AC_PROG_LN_S
|
||||
AC_PROG_MAKE_SET
|
||||
AC_PROG_RANLIB
|
||||
dnl AM_PATH_GTK(1.2.0, ,
|
||||
dnl AC_MSG_ERROR(Cannot find GTK: Is gtk-config in path?))
|
||||
|
||||
dnl Checks for libraries.
|
||||
dnl Replace `main' with a function in -ldl:
|
||||
dnl AC_CHECK_LIB(dl, main)
|
||||
dnl Replace `main' with a function in -lgdk:
|
||||
dnl AC_CHECK_LIB(gdk, main)
|
||||
dnl Replace `main' with a function in -lglib:
|
||||
dnl AC_CHECK_LIB(glib, main)
|
||||
dnl Replace `main' with a function in -lgmodule:
|
||||
dnl AC_CHECK_LIB(gmodule, main)
|
||||
dnl Replace `main' with a function in -lgtk:
|
||||
dnl AC_CHECK_LIB(gtk, main)
|
||||
dnl Replace `main' with a function in -lm:
|
||||
dnl AC_CHECK_LIB(m, main)
|
||||
|
||||
dnl Checks for header files.
|
||||
AC_HEADER_STDC
|
||||
dnl AC_CHECK_HEADERS(fcntl.h limits.h malloc.h strings.h unistd.h)
|
||||
|
||||
dnl Checks for typedefs, structures, and compiler characteristics.
|
||||
dnl AC_C_CONST
|
||||
dnl AC_C_INLINE
|
||||
dnl AC_TYPE_SIZE_T
|
||||
|
||||
dnl Checks for library functions.
|
||||
AC_FUNC_ALLOCA
|
||||
AC_FUNC_MMAP
|
||||
dnl AC_CHECK_FUNCS(getcwd getwd putenv strdup strerror tcgetattr)
|
||||
|
||||
AC_OUTPUT(./Makefile src/Makefile tests/Makefile tests/cpp/Makefile tests/js/Makefile)
|
||||
@@ -1,251 +0,0 @@
|
||||
#!/bin/sh
|
||||
#
|
||||
# install - install a program, script, or datafile
|
||||
# This comes from X11R5 (mit/util/scripts/install.sh).
|
||||
#
|
||||
# Copyright 1991 by the Massachusetts Institute of Technology
|
||||
#
|
||||
# Permission to use, copy, modify, distribute, and sell this software and its
|
||||
# documentation for any purpose is hereby granted without fee, provided that
|
||||
# the above copyright notice appear in all copies and that both that
|
||||
# copyright notice and this permission notice appear in supporting
|
||||
# documentation, and that the name of M.I.T. not be used in advertising or
|
||||
# publicity pertaining to distribution of the software without specific,
|
||||
# written prior permission. M.I.T. makes no representations about the
|
||||
# suitability of this software for any purpose. It is provided "as is"
|
||||
# without express or implied warranty.
|
||||
#
|
||||
# Calling this script install-sh is preferred over install.sh, to prevent
|
||||
# `make' implicit rules from creating a file called install from it
|
||||
# when there is no Makefile.
|
||||
#
|
||||
# This script is compatible with the BSD install script, but was written
|
||||
# from scratch. It can only install one file at a time, a restriction
|
||||
# shared with many OS's install programs.
|
||||
|
||||
|
||||
# set DOITPROG to echo to test this script
|
||||
|
||||
# Don't use :- since 4.3BSD and earlier shells don't like it.
|
||||
doit="${DOITPROG-}"
|
||||
|
||||
|
||||
# put in absolute paths if you don't have them in your path; or use env. vars.
|
||||
|
||||
mvprog="${MVPROG-mv}"
|
||||
cpprog="${CPPROG-cp}"
|
||||
chmodprog="${CHMODPROG-chmod}"
|
||||
chownprog="${CHOWNPROG-chown}"
|
||||
chgrpprog="${CHGRPPROG-chgrp}"
|
||||
stripprog="${STRIPPROG-strip}"
|
||||
rmprog="${RMPROG-rm}"
|
||||
mkdirprog="${MKDIRPROG-mkdir}"
|
||||
|
||||
transformbasename=""
|
||||
transform_arg=""
|
||||
instcmd="$mvprog"
|
||||
chmodcmd="$chmodprog 0755"
|
||||
chowncmd=""
|
||||
chgrpcmd=""
|
||||
stripcmd=""
|
||||
rmcmd="$rmprog -f"
|
||||
mvcmd="$mvprog"
|
||||
src=""
|
||||
dst=""
|
||||
dir_arg=""
|
||||
|
||||
while [ x"$1" != x ]; do
|
||||
case $1 in
|
||||
-c) instcmd="$cpprog"
|
||||
shift
|
||||
continue;;
|
||||
|
||||
-d) dir_arg=true
|
||||
shift
|
||||
continue;;
|
||||
|
||||
-m) chmodcmd="$chmodprog $2"
|
||||
shift
|
||||
shift
|
||||
continue;;
|
||||
|
||||
-o) chowncmd="$chownprog $2"
|
||||
shift
|
||||
shift
|
||||
continue;;
|
||||
|
||||
-g) chgrpcmd="$chgrpprog $2"
|
||||
shift
|
||||
shift
|
||||
continue;;
|
||||
|
||||
-s) stripcmd="$stripprog"
|
||||
shift
|
||||
continue;;
|
||||
|
||||
-t=*) transformarg=`echo $1 | sed 's/-t=//'`
|
||||
shift
|
||||
continue;;
|
||||
|
||||
-b=*) transformbasename=`echo $1 | sed 's/-b=//'`
|
||||
shift
|
||||
continue;;
|
||||
|
||||
*) if [ x"$src" = x ]
|
||||
then
|
||||
src=$1
|
||||
else
|
||||
# this colon is to work around a 386BSD /bin/sh bug
|
||||
:
|
||||
dst=$1
|
||||
fi
|
||||
shift
|
||||
continue;;
|
||||
esac
|
||||
done
|
||||
|
||||
if [ x"$src" = x ]
|
||||
then
|
||||
echo "install: no input file specified"
|
||||
exit 1
|
||||
else
|
||||
true
|
||||
fi
|
||||
|
||||
if [ x"$dir_arg" != x ]; then
|
||||
dst=$src
|
||||
src=""
|
||||
|
||||
if [ -d $dst ]; then
|
||||
instcmd=:
|
||||
chmodcmd=""
|
||||
else
|
||||
instcmd=mkdir
|
||||
fi
|
||||
else
|
||||
|
||||
# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
|
||||
# might cause directories to be created, which would be especially bad
|
||||
# if $src (and thus $dsttmp) contains '*'.
|
||||
|
||||
if [ -f $src -o -d $src ]
|
||||
then
|
||||
true
|
||||
else
|
||||
echo "install: $src does not exist"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
if [ x"$dst" = x ]
|
||||
then
|
||||
echo "install: no destination specified"
|
||||
exit 1
|
||||
else
|
||||
true
|
||||
fi
|
||||
|
||||
# If destination is a directory, append the input filename; if your system
|
||||
# does not like double slashes in filenames, you may need to add some logic
|
||||
|
||||
if [ -d $dst ]
|
||||
then
|
||||
dst="$dst"/`basename $src`
|
||||
else
|
||||
true
|
||||
fi
|
||||
fi
|
||||
|
||||
## this sed command emulates the dirname command
|
||||
dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
|
||||
|
||||
# Make sure that the destination directory exists.
|
||||
# this part is taken from Noah Friedman's mkinstalldirs script
|
||||
|
||||
# Skip lots of stat calls in the usual case.
|
||||
if [ ! -d "$dstdir" ]; then
|
||||
defaultIFS='
|
||||
'
|
||||
IFS="${IFS-${defaultIFS}}"
|
||||
|
||||
oIFS="${IFS}"
|
||||
# Some sh's can't handle IFS=/ for some reason.
|
||||
IFS='%'
|
||||
set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
|
||||
IFS="${oIFS}"
|
||||
|
||||
pathcomp=''
|
||||
|
||||
while [ $# -ne 0 ] ; do
|
||||
pathcomp="${pathcomp}${1}"
|
||||
shift
|
||||
|
||||
if [ ! -d "${pathcomp}" ] ;
|
||||
then
|
||||
$mkdirprog "${pathcomp}"
|
||||
else
|
||||
true
|
||||
fi
|
||||
|
||||
pathcomp="${pathcomp}/"
|
||||
done
|
||||
fi
|
||||
|
||||
if [ x"$dir_arg" != x ]
|
||||
then
|
||||
$doit $instcmd $dst &&
|
||||
|
||||
if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
|
||||
if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
|
||||
if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
|
||||
if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
|
||||
else
|
||||
|
||||
# If we're going to rename the final executable, determine the name now.
|
||||
|
||||
if [ x"$transformarg" = x ]
|
||||
then
|
||||
dstfile=`basename $dst`
|
||||
else
|
||||
dstfile=`basename $dst $transformbasename |
|
||||
sed $transformarg`$transformbasename
|
||||
fi
|
||||
|
||||
# don't allow the sed command to completely eliminate the filename
|
||||
|
||||
if [ x"$dstfile" = x ]
|
||||
then
|
||||
dstfile=`basename $dst`
|
||||
else
|
||||
true
|
||||
fi
|
||||
|
||||
# Make a temp file name in the proper directory.
|
||||
|
||||
dsttmp=$dstdir/#inst.$$#
|
||||
|
||||
# Move or copy the file name to the temp name
|
||||
|
||||
$doit $instcmd $src $dsttmp &&
|
||||
|
||||
trap "rm -f ${dsttmp}" 0 &&
|
||||
|
||||
# and set any options; do chmod last to preserve setuid bits
|
||||
|
||||
# If any of these fail, we abort the whole thing. If we want to
|
||||
# ignore errors from any of these, just make sure not to ignore
|
||||
# errors from the above "$doit $instcmd $src $dsttmp" command.
|
||||
|
||||
if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
|
||||
if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
|
||||
if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
|
||||
if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
|
||||
|
||||
# Now rename the file to the real destination.
|
||||
|
||||
$doit $rmcmd -f $dstdir/$dstfile &&
|
||||
$doit $mvcmd $dsttmp $dstdir/$dstfile
|
||||
|
||||
fi &&
|
||||
|
||||
|
||||
exit 0
|
||||
@@ -1,190 +0,0 @@
|
||||
#! /bin/sh
|
||||
# Common stub for a few missing GNU programs while installing.
|
||||
# Copyright (C) 1996, 1997 Free Software Foundation, Inc.
|
||||
# Franc,ois Pinard <pinard@iro.umontreal.ca>, 1996.
|
||||
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||
# 02111-1307, USA.
|
||||
|
||||
if test $# -eq 0; then
|
||||
echo 1>&2 "Try \`$0 --help' for more information"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
case "$1" in
|
||||
|
||||
-h|--h|--he|--hel|--help)
|
||||
echo "\
|
||||
$0 [OPTION]... PROGRAM [ARGUMENT]...
|
||||
|
||||
Handle \`PROGRAM [ARGUMENT]...' for when PROGRAM is missing, or return an
|
||||
error status if there is no known handling for PROGRAM.
|
||||
|
||||
Options:
|
||||
-h, --help display this help and exit
|
||||
-v, --version output version information and exit
|
||||
|
||||
Supported PROGRAM values:
|
||||
aclocal touch file \`aclocal.m4'
|
||||
autoconf touch file \`configure'
|
||||
autoheader touch file \`config.h.in'
|
||||
automake touch all \`Makefile.in' files
|
||||
bison create \`y.tab.[ch]', if possible, from existing .[ch]
|
||||
flex create \`lex.yy.c', if possible, from existing .c
|
||||
lex create \`lex.yy.c', if possible, from existing .c
|
||||
makeinfo touch the output file
|
||||
yacc create \`y.tab.[ch]', if possible, from existing .[ch]"
|
||||
;;
|
||||
|
||||
-v|--v|--ve|--ver|--vers|--versi|--versio|--version)
|
||||
echo "missing - GNU libit 0.0"
|
||||
;;
|
||||
|
||||
-*)
|
||||
echo 1>&2 "$0: Unknown \`$1' option"
|
||||
echo 1>&2 "Try \`$0 --help' for more information"
|
||||
exit 1
|
||||
;;
|
||||
|
||||
aclocal)
|
||||
echo 1>&2 "\
|
||||
WARNING: \`$1' is missing on your system. You should only need it if
|
||||
you modified \`acinclude.m4' or \`configure.in'. You might want
|
||||
to install the \`Automake' and \`Perl' packages. Grab them from
|
||||
any GNU archive site."
|
||||
touch aclocal.m4
|
||||
;;
|
||||
|
||||
autoconf)
|
||||
echo 1>&2 "\
|
||||
WARNING: \`$1' is missing on your system. You should only need it if
|
||||
you modified \`configure.in'. You might want to install the
|
||||
\`Autoconf' and \`GNU m4' packages. Grab them from any GNU
|
||||
archive site."
|
||||
touch configure
|
||||
;;
|
||||
|
||||
autoheader)
|
||||
echo 1>&2 "\
|
||||
WARNING: \`$1' is missing on your system. You should only need it if
|
||||
you modified \`acconfig.h' or \`configure.in'. You might want
|
||||
to install the \`Autoconf' and \`GNU m4' packages. Grab them
|
||||
from any GNU archive site."
|
||||
files=`sed -n 's/^[ ]*A[CM]_CONFIG_HEADER(\([^)]*\)).*/\1/p' configure.in`
|
||||
test -z "$files" && files="config.h"
|
||||
touch_files=
|
||||
for f in $files; do
|
||||
case "$f" in
|
||||
*:*) touch_files="$touch_files "`echo "$f" |
|
||||
sed -e 's/^[^:]*://' -e 's/:.*//'`;;
|
||||
*) touch_files="$touch_files $f.in";;
|
||||
esac
|
||||
done
|
||||
touch $touch_files
|
||||
;;
|
||||
|
||||
automake)
|
||||
echo 1>&2 "\
|
||||
WARNING: \`$1' is missing on your system. You should only need it if
|
||||
you modified \`Makefile.am', \`acinclude.m4' or \`configure.in'.
|
||||
You might want to install the \`Automake' and \`Perl' packages.
|
||||
Grab them from any GNU archive site."
|
||||
find . -type f -name Makefile.am -print |
|
||||
sed 's/\.am$/.in/' |
|
||||
while read f; do touch "$f"; done
|
||||
;;
|
||||
|
||||
bison|yacc)
|
||||
echo 1>&2 "\
|
||||
WARNING: \`$1' is missing on your system. You should only need it if
|
||||
you modified a \`.y' file. You may need the \`Bison' package
|
||||
in order for those modifications to take effect. You can get
|
||||
\`Bison' from any GNU archive site."
|
||||
rm -f y.tab.c y.tab.h
|
||||
if [ $# -ne 1 ]; then
|
||||
eval LASTARG="\${$#}"
|
||||
case "$LASTARG" in
|
||||
*.y)
|
||||
SRCFILE=`echo "$LASTARG" | sed 's/y$/c/'`
|
||||
if [ -f "$SRCFILE" ]; then
|
||||
cp "$SRCFILE" y.tab.c
|
||||
fi
|
||||
SRCFILE=`echo "$LASTARG" | sed 's/y$/h/'`
|
||||
if [ -f "$SRCFILE" ]; then
|
||||
cp "$SRCFILE" y.tab.h
|
||||
fi
|
||||
;;
|
||||
esac
|
||||
fi
|
||||
if [ ! -f y.tab.h ]; then
|
||||
echo >y.tab.h
|
||||
fi
|
||||
if [ ! -f y.tab.c ]; then
|
||||
echo 'main() { return 0; }' >y.tab.c
|
||||
fi
|
||||
;;
|
||||
|
||||
lex|flex)
|
||||
echo 1>&2 "\
|
||||
WARNING: \`$1' is missing on your system. You should only need it if
|
||||
you modified a \`.l' file. You may need the \`Flex' package
|
||||
in order for those modifications to take effect. You can get
|
||||
\`Flex' from any GNU archive site."
|
||||
rm -f lex.yy.c
|
||||
if [ $# -ne 1 ]; then
|
||||
eval LASTARG="\${$#}"
|
||||
case "$LASTARG" in
|
||||
*.l)
|
||||
SRCFILE=`echo "$LASTARG" | sed 's/l$/c/'`
|
||||
if [ -f "$SRCFILE" ]; then
|
||||
cp "$SRCFILE" lex.yy.c
|
||||
fi
|
||||
;;
|
||||
esac
|
||||
fi
|
||||
if [ ! -f lex.yy.c ]; then
|
||||
echo 'main() { return 0; }' >lex.yy.c
|
||||
fi
|
||||
;;
|
||||
|
||||
makeinfo)
|
||||
echo 1>&2 "\
|
||||
WARNING: \`$1' is missing on your system. You should only need it if
|
||||
you modified a \`.texi' or \`.texinfo' file, or any other file
|
||||
indirectly affecting the aspect of the manual. The spurious
|
||||
call might also be the consequence of using a buggy \`make' (AIX,
|
||||
DU, IRIX). You might want to install the \`Texinfo' package or
|
||||
the \`GNU make' package. Grab either from any GNU archive site."
|
||||
file=`echo "$*" | sed -n 's/.*-o \([^ ]*\).*/\1/p'`
|
||||
if test -z "$file"; then
|
||||
file=`echo "$*" | sed 's/.* \([^ ]*\) *$/\1/'`
|
||||
file=`sed -n '/^@setfilename/ { s/.* \([^ ]*\) *$/\1/; p; q; }' $file`
|
||||
fi
|
||||
touch $file
|
||||
;;
|
||||
|
||||
*)
|
||||
echo 1>&2 "\
|
||||
WARNING: \`$1' is needed, and you do not seem to have it handy on your
|
||||
system. You might have modified some files without having the
|
||||
proper tools for further handling them. Check the \`README' file,
|
||||
it often tells you about the needed prerequirements for installing
|
||||
this package. You may also peek at any GNU archive site, in case
|
||||
some other package would contain this missing \`$1' program."
|
||||
exit 1
|
||||
;;
|
||||
esac
|
||||
|
||||
exit 0
|
||||
@@ -1,40 +0,0 @@
|
||||
#! /bin/sh
|
||||
# mkinstalldirs --- make directory hierarchy
|
||||
# Author: Noah Friedman <friedman@prep.ai.mit.edu>
|
||||
# Created: 1993-05-16
|
||||
# Public domain
|
||||
|
||||
# $Id: mkinstalldirs,v 1.1 2001-02-07 21:20:46 rginda%netscape.com Exp $
|
||||
|
||||
errstatus=0
|
||||
|
||||
for file
|
||||
do
|
||||
set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'`
|
||||
shift
|
||||
|
||||
pathcomp=
|
||||
for d
|
||||
do
|
||||
pathcomp="$pathcomp$d"
|
||||
case "$pathcomp" in
|
||||
-* ) pathcomp=./$pathcomp ;;
|
||||
esac
|
||||
|
||||
if test ! -d "$pathcomp"; then
|
||||
echo "mkdir $pathcomp"
|
||||
|
||||
mkdir "$pathcomp" || lasterr=$?
|
||||
|
||||
if test ! -d "$pathcomp"; then
|
||||
errstatus=$lasterr
|
||||
fi
|
||||
fi
|
||||
|
||||
pathcomp="$pathcomp/"
|
||||
done
|
||||
done
|
||||
|
||||
exit $errstatus
|
||||
|
||||
# mkinstalldirs ends here
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -1,550 +0,0 @@
|
||||
;;; The contents of this file are subject to the Mozilla Public
|
||||
;;; License Version 1.1 (the "License"); you may not use this file
|
||||
;;; except in compliance with the License. You may obtain a copy of
|
||||
;;; the License at http://www.mozilla.org/MPL/
|
||||
;;;
|
||||
;;; Software distributed under the License is distributed on an "AS
|
||||
;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
;;; implied. See the License for the specific language governing
|
||||
;;; rights and limitations under the License.
|
||||
;;;
|
||||
;;; The Original Code is the Language Design and Prototyping Environment.
|
||||
;;;
|
||||
;;; The Initial Developer of the Original Code is Netscape Communications
|
||||
;;; Corporation. Portions created by Netscape Communications Corporation are
|
||||
;;; Copyright (C) 1999 Netscape Communications Corporation. All
|
||||
;;; Rights Reserved.
|
||||
;;;
|
||||
;;; Contributor(s): Waldemar Horwat <waldemar@acm.org>
|
||||
|
||||
;;;
|
||||
;;; LALR(1) and LR(1) parametrized grammar utilities
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; UTILITIES
|
||||
|
||||
(declaim (inline identifier?))
|
||||
(defun identifier? (form)
|
||||
(and form (symbolp form) (not (keywordp form))))
|
||||
|
||||
(deftype identifier () '(satisfies identifier?))
|
||||
|
||||
|
||||
; Make sure that form is one of the following:
|
||||
; A symbol
|
||||
; An integer
|
||||
; A float
|
||||
; A character
|
||||
; A string
|
||||
; A list of zero or more forms that also satisfy ensure-proper-form;
|
||||
; the list cannot be dotted.
|
||||
; Return the form.
|
||||
(defun ensure-proper-form (form)
|
||||
(labels
|
||||
((ensure-list-form (form)
|
||||
(or (null form)
|
||||
(and (consp form)
|
||||
(progn
|
||||
(ensure-proper-form (car form))
|
||||
(ensure-list-form (cdr form)))))))
|
||||
(unless
|
||||
(or (symbolp form)
|
||||
(integerp form)
|
||||
(floatp form)
|
||||
(characterp form)
|
||||
(stringp form)
|
||||
(ensure-list-form form))
|
||||
(error "Bad form: ~S" form))
|
||||
form))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; TERMINALS
|
||||
|
||||
; A terminal is any of the following:
|
||||
; A symbol that is neither nil nor a keyword
|
||||
; A string;
|
||||
; A character;
|
||||
; An integer.
|
||||
(defun terminal? (x)
|
||||
(and x
|
||||
(or (and (symbolp x) (not (keywordp x)))
|
||||
(stringp x)
|
||||
(characterp x)
|
||||
(integerp x))))
|
||||
|
||||
; The following terminals are reserved and may not be used in user input:
|
||||
; $$ Marker for end of token stream
|
||||
(defconstant *end-marker* '$$)
|
||||
(defconstant *end-marker-terminal-number* 0)
|
||||
|
||||
(deftype terminal () '(satisfies terminal?))
|
||||
(deftype user-terminal () `(and terminal (not (eql ,*end-marker*))))
|
||||
|
||||
|
||||
; Emit markup for a terminal. subscript is an optional integer.
|
||||
(defun depict-terminal (markup-stream terminal &optional subscript)
|
||||
(cond
|
||||
((characterp terminal)
|
||||
(depict-char-style (markup-stream ':character-literal)
|
||||
(depict-character markup-stream terminal)
|
||||
(when subscript
|
||||
(depict-char-style (markup-stream ':plain-subscript)
|
||||
(depict-integer markup-stream subscript)))))
|
||||
((and terminal (symbolp terminal))
|
||||
(let ((name (symbol-name terminal)))
|
||||
(if (and (> (length name) 0) (char= (char name 0) #\$))
|
||||
(depict-char-style (markup-stream ':terminal)
|
||||
(depict markup-stream (subseq (symbol-upper-mixed-case-name terminal) 1))
|
||||
(when subscript
|
||||
(depict-char-style (markup-stream ':plain-subscript)
|
||||
(depict-integer markup-stream subscript))))
|
||||
(progn
|
||||
(depict-char-style (markup-stream ':terminal-keyword)
|
||||
(depict markup-stream (string-downcase name)))
|
||||
(when subscript
|
||||
(depict-char-style (markup-stream ':terminal)
|
||||
(depict-char-style (markup-stream ':plain-subscript)
|
||||
(depict-integer markup-stream subscript))))))))
|
||||
(t (error "Don't know how to emit markup for terminal ~S" terminal))))
|
||||
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; NONTERMINAL PARAMETERS
|
||||
|
||||
(declaim (inline nonterminal-parameter?))
|
||||
(defun nonterminal-parameter? (x)
|
||||
(symbolp x))
|
||||
(deftype nonterminal-parameter () 'symbol)
|
||||
|
||||
|
||||
; Return true if this nonterminal parameter is a constant.
|
||||
(declaim (inline nonterminal-attribute?))
|
||||
(defun nonterminal-attribute? (parameter)
|
||||
(and (symbolp parameter) (not (keywordp parameter))))
|
||||
(deftype nonterminal-attribute () '(and symbol (not keyword)))
|
||||
|
||||
|
||||
(defun depict-nonterminal-attribute (markup-stream attribute)
|
||||
(depict-char-style (markup-stream ':nonterminal)
|
||||
(depict-char-style (markup-stream ':nonterminal-attribute)
|
||||
(depict markup-stream (symbol-lower-mixed-case-name attribute)))))
|
||||
|
||||
|
||||
; Return true if this nonterminal parameter is a variable.
|
||||
(declaim (inline nonterminal-argument?))
|
||||
(defun nonterminal-argument? (parameter)
|
||||
(keywordp parameter))
|
||||
(deftype nonterminal-argument () 'keyword)
|
||||
|
||||
|
||||
(defparameter *special-nonterminal-arguments*
|
||||
'(:alpha :beta :gamma :delta :epsilon :zeta :eta :theta :iota :kappa :lambda :mu :nu
|
||||
:xi :omicron :pi :rho :sigma :tau :upsilon :phi :chi :psi :omega))
|
||||
|
||||
(defun depict-nonterminal-argument-symbol (markup-stream argument)
|
||||
(depict-char-style (markup-stream ':nonterminal-argument)
|
||||
(let ((argument (symbol-abbreviation argument)))
|
||||
(depict markup-stream
|
||||
(if (member argument *special-nonterminal-arguments*)
|
||||
argument
|
||||
(symbol-upper-mixed-case-name argument))))))
|
||||
|
||||
(defun depict-nonterminal-argument (markup-stream argument)
|
||||
(depict-char-style (markup-stream ':nonterminal)
|
||||
(depict-nonterminal-argument-symbol markup-stream argument)))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; ATTRIBUTED NONTERMINALS
|
||||
|
||||
; An attributed-nonterminal is a specific instantiation of a generic-nonterminal.
|
||||
(defstruct (attributed-nonterminal (:constructor allocate-attributed-nonterminal (symbol attributes))
|
||||
(:copier nil)
|
||||
(:predicate attributed-nonterminal?))
|
||||
(symbol nil :type keyword :read-only t) ;The name of the attributed nonterminal
|
||||
(attributes nil :type list :read-only t)) ;Ordered list of nonterminal attributes
|
||||
|
||||
|
||||
; Make an attributed nonterminal with the given symbol and attributes. If there
|
||||
; are no attributes, return the symbol as a plain nonterminal.
|
||||
; Nonterminals are eq whenever they have identical symbols and attribute lists.
|
||||
(defun make-attributed-nonterminal (symbol attributes)
|
||||
(assert-type symbol keyword)
|
||||
(assert-type attributes (list nonterminal-attribute))
|
||||
(if attributes
|
||||
(let ((generic-nonterminals (get symbol 'generic-nonterminals)))
|
||||
(or (cdr (assoc attributes generic-nonterminals :test #'equal))
|
||||
(let ((attributed-nonterminal (allocate-attributed-nonterminal symbol attributes)))
|
||||
(setf (get symbol 'generic-nonterminals)
|
||||
(acons attributes attributed-nonterminal generic-nonterminals))
|
||||
attributed-nonterminal)))
|
||||
symbol))
|
||||
|
||||
|
||||
(defmethod print-object ((attributed-nonterminal attributed-nonterminal) stream)
|
||||
(print-unreadable-object (attributed-nonterminal stream)
|
||||
(format stream "a ~@_~W~{ ~:_~W~}"
|
||||
(attributed-nonterminal-symbol attributed-nonterminal)
|
||||
(attributed-nonterminal-attributes attributed-nonterminal))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; GENERIC NONTERMINALS
|
||||
|
||||
; A generic-nonterminal is a parametrized nonterminal that can expand into two or more
|
||||
; attributed-nonterminals.
|
||||
(defstruct (generic-nonterminal (:constructor allocate-generic-nonterminal (symbol parameters))
|
||||
(:copier nil)
|
||||
(:predicate generic-nonterminal?))
|
||||
(symbol nil :type keyword :read-only t) ;The name of the generic nonterminal
|
||||
(parameters nil :type list :read-only t)) ;Ordered list of nonterminal attributes or arguments
|
||||
|
||||
|
||||
; Make a generic nonterminal with the given symbol and parameters. If none of
|
||||
; the parameters is an argument, make an attributed nonterminal instead. If there
|
||||
; are no parameters, return the symbol as a plain nonterminal.
|
||||
; Nonterminals are eq whenever they have identical symbols and parameter lists.
|
||||
(defun make-generic-nonterminal (symbol parameters)
|
||||
(assert-type symbol keyword)
|
||||
(if parameters
|
||||
(let ((generic-nonterminals (get symbol 'generic-nonterminals)))
|
||||
(or (cdr (assoc parameters generic-nonterminals :test #'equal))
|
||||
(progn
|
||||
(assert-type parameters (list nonterminal-parameter))
|
||||
(let ((generic-nonterminal (if (every #'nonterminal-attribute? parameters)
|
||||
(allocate-attributed-nonterminal symbol parameters)
|
||||
(allocate-generic-nonterminal symbol parameters))))
|
||||
(setf (get symbol 'generic-nonterminals)
|
||||
(acons parameters generic-nonterminal generic-nonterminals))
|
||||
generic-nonterminal))))
|
||||
symbol))
|
||||
|
||||
|
||||
(defmethod print-object ((generic-nonterminal generic-nonterminal) stream)
|
||||
(print-unreadable-object (generic-nonterminal stream)
|
||||
(format stream "g ~@_~W~{ ~:_~W~}"
|
||||
(generic-nonterminal-symbol generic-nonterminal)
|
||||
(generic-nonterminal-parameters generic-nonterminal))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; NONTERMINALS
|
||||
|
||||
;;; A nonterminal is a keyword or an attributed-nonterminal.
|
||||
(declaim (inline nonterminal?))
|
||||
(defun nonterminal? (x)
|
||||
(or (keywordp x) (attributed-nonterminal? x)))
|
||||
|
||||
; The following nonterminals are reserved and may not be used in user input:
|
||||
; :% Nonterminal that expands to the start nonterminal
|
||||
|
||||
(defconstant *start-nonterminal* :%)
|
||||
|
||||
(deftype nonterminal () '(or keyword attributed-nonterminal))
|
||||
(deftype user-nonterminal () `(and nonterminal (not (eql ,*start-nonterminal*))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; GENERAL NONTERMINALS
|
||||
|
||||
;;; A general-nonterminal is a nonterminal or a generic-nonterminal.
|
||||
(declaim (inline general-nonterminal?))
|
||||
(defun general-nonterminal? (x)
|
||||
(or (nonterminal? x) (generic-nonterminal? x)))
|
||||
|
||||
(deftype general-nonterminal () '(or nonterminal generic-nonterminal))
|
||||
|
||||
|
||||
; Return the list of parameters in the general-nonterminal. The list is empty if the
|
||||
; general-nonterminal is a plain nonterminal.
|
||||
(defun general-nonterminal-parameters (general-nonterminal)
|
||||
(cond
|
||||
((attributed-nonterminal? general-nonterminal) (attributed-nonterminal-attributes general-nonterminal))
|
||||
((generic-nonterminal? general-nonterminal) (generic-nonterminal-parameters general-nonterminal))
|
||||
(t (progn
|
||||
(assert-true (keywordp general-nonterminal))
|
||||
nil))))
|
||||
|
||||
|
||||
; Emit markup for a general-nonterminal. subscript is an optional integer.
|
||||
; link should be one of:
|
||||
; :reference if this is a reference of this general-nonterminal;
|
||||
; :external if this is an external reference of this general-nonterminal;
|
||||
; :definition if this is a definition of this general-nonterminal;
|
||||
; nil if this use of the general-nonterminal should not be cross-referenced.
|
||||
(defun depict-general-nonterminal (markup-stream general-nonterminal link &optional subscript)
|
||||
(labels
|
||||
((depict-nonterminal-name (markup-stream symbol)
|
||||
(let ((name (symbol-upper-mixed-case-name symbol)))
|
||||
(depict-link (markup-stream link "N-" name t)
|
||||
(depict markup-stream name))))
|
||||
|
||||
(depict-nonterminal-parameter (markup-stream parameter)
|
||||
(if (nonterminal-attribute? parameter)
|
||||
(depict-char-style (markup-stream ':nonterminal-attribute)
|
||||
(depict markup-stream (symbol-lower-mixed-case-name parameter)))
|
||||
(depict-nonterminal-argument-symbol markup-stream parameter)))
|
||||
|
||||
(depict-parametrized-nonterminal (markup-stream symbol parameters)
|
||||
(depict-nonterminal-name markup-stream symbol)
|
||||
(depict-char-style (markup-stream ':superscript)
|
||||
(depict-list markup-stream #'depict-nonterminal-parameter parameters
|
||||
:separator ",")))
|
||||
|
||||
(depict-general (markup-stream)
|
||||
(depict-char-style (markup-stream ':nonterminal)
|
||||
(cond
|
||||
((keywordp general-nonterminal)
|
||||
(depict-nonterminal-name markup-stream general-nonterminal))
|
||||
((attributed-nonterminal? general-nonterminal)
|
||||
(depict-parametrized-nonterminal markup-stream
|
||||
(attributed-nonterminal-symbol general-nonterminal)
|
||||
(attributed-nonterminal-attributes general-nonterminal)))
|
||||
((generic-nonterminal? general-nonterminal)
|
||||
(depict-parametrized-nonterminal markup-stream
|
||||
(generic-nonterminal-symbol general-nonterminal)
|
||||
(generic-nonterminal-parameters general-nonterminal)))
|
||||
(t (error "Bad nonterminal ~S" general-nonterminal)))
|
||||
(when subscript
|
||||
(depict-char-style (markup-stream ':plain-subscript)
|
||||
(depict-integer markup-stream subscript))))))
|
||||
|
||||
(if (or (eq link :definition)
|
||||
(and (or (eq link :reference) (eq link :external))
|
||||
(keywordp general-nonterminal)
|
||||
(null subscript)))
|
||||
(depict-link (markup-stream link "N-" (symbol-upper-mixed-case-name (general-grammar-symbol-symbol general-nonterminal)) t)
|
||||
(setq link nil)
|
||||
(depict-general markup-stream))
|
||||
(depict-general markup-stream))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; GRAMMAR SYMBOLS
|
||||
|
||||
;;; A grammar-symbol is either a terminal or a nonterminal.
|
||||
(deftype grammar-symbol () '(or terminal nonterminal))
|
||||
(deftype user-grammar-symbol () '(or user-terminal user-nonterminal))
|
||||
|
||||
;;; A general-grammar-symbol is either a terminal or a general-nonterminal.
|
||||
(deftype general-grammar-symbol () '(or terminal general-nonterminal))
|
||||
|
||||
; Return true if x is a general-grammar-symbol. x can be any object.
|
||||
(defun general-grammar-symbol? (x)
|
||||
(or (terminal? x) (general-nonterminal? x)))
|
||||
|
||||
|
||||
; Return true if the two grammar symbols are the same symbol.
|
||||
(declaim (inline grammar-symbol-=))
|
||||
(defun grammar-symbol-= (grammar-symbol1 grammar-symbol2)
|
||||
(eql grammar-symbol1 grammar-symbol2))
|
||||
; A version of grammar-symbol-= suitable for being the test function for hash tables.
|
||||
(defparameter *grammar-symbol-=* #'eql)
|
||||
|
||||
|
||||
; Return the general-grammar-symbol's symbol. Return it unchanged if it is not
|
||||
; an attributed or generic nonterminal.
|
||||
(defun general-grammar-symbol-symbol (general-grammar-symbol)
|
||||
(cond
|
||||
((attributed-nonterminal? general-grammar-symbol) (attributed-nonterminal-symbol general-grammar-symbol))
|
||||
((generic-nonterminal? general-grammar-symbol) (generic-nonterminal-symbol general-grammar-symbol))
|
||||
(t (assert-type general-grammar-symbol (or keyword terminal)))))
|
||||
|
||||
|
||||
; Return the list of arguments in the general-grammar-symbol. The list is empty if the
|
||||
; general-grammar-symbol is not a generic nonterminal.
|
||||
(defun general-grammar-symbol-arguments (general-grammar-symbol)
|
||||
(and (generic-nonterminal? general-grammar-symbol)
|
||||
(remove-if (complement #'nonterminal-argument?) (generic-nonterminal-parameters general-grammar-symbol))))
|
||||
|
||||
|
||||
; Return the general-grammar-symbol expanded into source form that can be interned to yield the same
|
||||
; general-grammar-symbol.
|
||||
(defun general-grammar-symbol-source (general-grammar-symbol)
|
||||
(cond
|
||||
((attributed-nonterminal? general-grammar-symbol)
|
||||
(cons (attributed-nonterminal-symbol general-grammar-symbol) (attributed-nonterminal-attributes general-grammar-symbol)))
|
||||
((generic-nonterminal? general-grammar-symbol)
|
||||
(cons (generic-nonterminal-symbol general-grammar-symbol) (generic-nonterminal-parameters general-grammar-symbol)))
|
||||
(t (assert-type general-grammar-symbol (or keyword terminal)))))
|
||||
|
||||
|
||||
; Emit markup for a general-grammar-symbol. subscript is an optional integer.
|
||||
; link should be one of:
|
||||
; :reference if this is a reference of this general-grammar-symbol;
|
||||
; :external if this is an external reference of this general-grammar-symbol;
|
||||
; :definition if this is a definition of this general-grammar-symbol;
|
||||
; nil if this use of the general-grammar-symbol should not be cross-referenced.
|
||||
(defun depict-general-grammar-symbol (markup-stream general-grammar-symbol link &optional subscript)
|
||||
(if (general-nonterminal? general-grammar-symbol)
|
||||
(depict-general-nonterminal markup-stream general-grammar-symbol link subscript)
|
||||
(depict-terminal markup-stream general-grammar-symbol subscript)))
|
||||
|
||||
|
||||
; Styled text can include (:grammar-symbol <grammar-symbol-source> [<subscript>]) as long as
|
||||
; *styled-text-grammar-parametrization* is bound around the call to depict-styled-text.
|
||||
(defvar *styled-text-grammar-parametrization*)
|
||||
|
||||
(defun depict-grammar-symbol-styled-text (markup-stream grammar-symbol-source &optional subscript)
|
||||
(depict-general-grammar-symbol markup-stream
|
||||
(grammar-parametrization-intern *styled-text-grammar-parametrization* grammar-symbol-source)
|
||||
:reference
|
||||
subscript))
|
||||
|
||||
(setf (styled-text-depictor :grammar-symbol) #'depict-grammar-symbol-styled-text)
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; GRAMMAR PARAMETRIZATIONS
|
||||
|
||||
; A grammar parametrization holds the rules for converting nonterminal arguments into nonterminal attributes.
|
||||
(defstruct (grammar-parametrization (:constructor allocate-grammar-parametrization (argument-attributes))
|
||||
(:predicate grammar-parametrization?))
|
||||
(argument-attributes nil :type hash-table :read-only t)) ;Hash table of nonterminal-argument -> list of nonterminal-attributes
|
||||
|
||||
|
||||
(defun make-grammar-parametrization ()
|
||||
(allocate-grammar-parametrization (make-hash-table :test #'eq)))
|
||||
|
||||
|
||||
; Return true if the two grammar-parametrizations are the same.
|
||||
(defun grammar-parametrization-= (grammar-parametrization1 grammar-parametrization2)
|
||||
(hash-table-= (grammar-parametrization-argument-attributes grammar-parametrization1)
|
||||
(grammar-parametrization-argument-attributes grammar-parametrization2)
|
||||
:test #'equal))
|
||||
|
||||
|
||||
; Declare that nonterminal arguments with the given name can hold any of the
|
||||
; given nonterminal attributes given. At least one attribute must be provided.
|
||||
(defun grammar-parametrization-declare-argument (grammar-parametrization argument attributes)
|
||||
(assert-type argument nonterminal-argument)
|
||||
(assert-type attributes (list nonterminal-attribute))
|
||||
(assert-true attributes)
|
||||
(when (gethash argument (grammar-parametrization-argument-attributes grammar-parametrization))
|
||||
(error "Duplicate parametrized grammar argument ~S" argument))
|
||||
(setf (gethash argument (grammar-parametrization-argument-attributes grammar-parametrization)) attributes))
|
||||
|
||||
|
||||
; Return the attributes to which the given argument may expand.
|
||||
(defun grammar-parametrization-lookup-argument (grammar-parametrization argument)
|
||||
(assert-non-null (gethash argument (grammar-parametrization-argument-attributes grammar-parametrization))))
|
||||
|
||||
|
||||
; Create a plain, attributed, or generic grammar symbol from the specification in grammar-symbol-source.
|
||||
; If grammar-symbol-source is not a cons, it is a plain grammar symbol. If it is a list, its first element
|
||||
; must be a keyword that is a nonterminal's symbol and the other elements must be nonterminal
|
||||
; parameters.
|
||||
; Return two values:
|
||||
; the grammar symbol
|
||||
; a list of arguments used in the grammar symbol.
|
||||
; If allowed-arguments is given, check that each argument is in the allowed-arguments list;
|
||||
; if not, allow any arguments declared in grammar-parametrization but do not allow duplicates.
|
||||
(defun grammar-parametrization-intern (grammar-parametrization grammar-symbol-source &optional (allowed-arguments nil allow-duplicates))
|
||||
(if (consp grammar-symbol-source)
|
||||
(progn
|
||||
(assert-type grammar-symbol-source (cons keyword (list nonterminal-parameter)))
|
||||
(let* ((symbol (car grammar-symbol-source))
|
||||
(parameters (cdr grammar-symbol-source))
|
||||
(arguments (remove-if (complement #'nonterminal-argument?) parameters)))
|
||||
(mapl #'(lambda (arguments)
|
||||
(let ((argument (car arguments)))
|
||||
(if allow-duplicates
|
||||
(unless (member argument allowed-arguments :test #'eq)
|
||||
(error "Undefined nonterminal argument ~S" argument))
|
||||
(progn
|
||||
(unless (gethash argument (grammar-parametrization-argument-attributes grammar-parametrization))
|
||||
(error "Undeclared nonterminal argument ~S" argument))
|
||||
(when (member argument (cdr arguments) :test #'eq)
|
||||
(error "Duplicate nonterminal argument ~S" argument))))))
|
||||
arguments)
|
||||
(values (make-generic-nonterminal symbol parameters) arguments)))
|
||||
(values (assert-type grammar-symbol-source (or keyword terminal)) nil)))
|
||||
|
||||
|
||||
; Call f on each possible binding permutation of the given arguments concatenated with the bindings in
|
||||
; bound-argument-alist. f takes one argument, an association list that maps arguments to attributes.
|
||||
(defun grammar-parametrization-each-permutation (grammar-parametrization f arguments &optional bound-argument-alist)
|
||||
(if arguments
|
||||
(let ((argument (car arguments))
|
||||
(rest-arguments (cdr arguments)))
|
||||
(dolist (attribute (grammar-parametrization-lookup-argument grammar-parametrization argument))
|
||||
(grammar-parametrization-each-permutation grammar-parametrization f rest-arguments (acons argument attribute bound-argument-alist))))
|
||||
(funcall f bound-argument-alist)))
|
||||
|
||||
|
||||
; If general-grammar-symbol is a generic-nonterminal, return one possible binding permutation of its arguments;
|
||||
; otherwise return nil.
|
||||
(defun nonterminal-sample-bound-argument-alist (grammar-parametrization general-grammar-symbol)
|
||||
(when (generic-nonterminal? general-grammar-symbol)
|
||||
(grammar-parametrization-each-permutation
|
||||
grammar-parametrization
|
||||
#'(lambda (bound-argument-alist) (return-from nonterminal-sample-bound-argument-alist bound-argument-alist))
|
||||
(general-grammar-symbol-arguments general-grammar-symbol))))
|
||||
|
||||
|
||||
; If the grammar symbol is a generic nonterminal, convert it into an attributed nonterminal
|
||||
; by instantiating its arguments with the corresponding attributes from the bound-argument-alist.
|
||||
; If the grammar symbol is already an attributed or plain nonterminal, return it unchanged.
|
||||
(defun instantiate-general-grammar-symbol (bound-argument-alist general-grammar-symbol)
|
||||
(if (generic-nonterminal? general-grammar-symbol)
|
||||
(make-attributed-nonterminal
|
||||
(generic-nonterminal-symbol general-grammar-symbol)
|
||||
(mapcar #'(lambda (parameter)
|
||||
(if (nonterminal-argument? parameter)
|
||||
(let ((binding (assoc parameter bound-argument-alist :test #'eq)))
|
||||
(if binding
|
||||
(cdr binding)
|
||||
(error "Unbound nonterminal argument ~S" parameter)))
|
||||
parameter))
|
||||
(generic-nonterminal-parameters general-grammar-symbol)))
|
||||
(assert-type general-grammar-symbol grammar-symbol)))
|
||||
|
||||
|
||||
; If the grammar symbol is a generic nonterminal parametrized on argument, substitute
|
||||
; attribute for argument in it and return the modified grammar symbol. Otherwise, return it unchanged.
|
||||
(defun general-grammar-symbol-substitute (attribute argument general-grammar-symbol)
|
||||
(assert-type attribute nonterminal-attribute)
|
||||
(assert-type argument nonterminal-argument)
|
||||
(if (and (generic-nonterminal? general-grammar-symbol)
|
||||
(member argument (generic-nonterminal-parameters general-grammar-symbol) :test #'eq))
|
||||
(make-generic-nonterminal
|
||||
(generic-nonterminal-symbol general-grammar-symbol)
|
||||
(substitute attribute argument (generic-nonterminal-parameters general-grammar-symbol) :test #'eq))
|
||||
(assert-type general-grammar-symbol general-grammar-symbol)))
|
||||
|
||||
|
||||
; If the general grammar symbol is a generic nonterminal, return a list of all possible attributed nonterminals
|
||||
; that can be instantiated from it; otherwise, return a one-element list containing the given general grammar symbol.
|
||||
(defun general-grammar-symbol-instances (grammar-parametrization general-grammar-symbol)
|
||||
(if (generic-nonterminal? general-grammar-symbol)
|
||||
(let ((instances nil))
|
||||
(grammar-parametrization-each-permutation
|
||||
grammar-parametrization
|
||||
#'(lambda (bound-argument-alist)
|
||||
(push (instantiate-general-grammar-symbol bound-argument-alist general-grammar-symbol) instances))
|
||||
(general-grammar-symbol-arguments general-grammar-symbol))
|
||||
(nreverse instances))
|
||||
(list (assert-type general-grammar-symbol grammar-symbol))))
|
||||
|
||||
|
||||
; Return true if grammar-symbol can be obtained by calling instantiate-general-grammar-symbol on
|
||||
; general-grammar-symbol.
|
||||
(defun general-nonterminal-is-instance? (grammar-parametrization general-grammar-symbol grammar-symbol)
|
||||
(or (grammar-symbol-= general-grammar-symbol grammar-symbol)
|
||||
(and (generic-nonterminal? general-grammar-symbol)
|
||||
(attributed-nonterminal? grammar-symbol)
|
||||
(let ((parameters (generic-nonterminal-parameters general-grammar-symbol))
|
||||
(attributes (attributed-nonterminal-attributes grammar-symbol)))
|
||||
(and (= (length parameters) (length attributes))
|
||||
(every #'(lambda (parameter attribute)
|
||||
(or (eq parameter attribute)
|
||||
(and (nonterminal-argument? parameter)
|
||||
(member attribute (grammar-parametrization-lookup-argument grammar-parametrization parameter) :test #'eq))))
|
||||
parameters
|
||||
attributes))))))
|
||||
@@ -1,485 +0,0 @@
|
||||
;;; The contents of this file are subject to the Mozilla Public
|
||||
;;; License Version 1.1 (the "License"); you may not use this file
|
||||
;;; except in compliance with the License. You may obtain a copy of
|
||||
;;; the License at http://www.mozilla.org/MPL/
|
||||
;;;
|
||||
;;; Software distributed under the License is distributed on an "AS
|
||||
;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
;;; implied. See the License for the specific language governing
|
||||
;;; rights and limitations under the License.
|
||||
;;;
|
||||
;;; The Original Code is the Language Design and Prototyping Environment.
|
||||
;;;
|
||||
;;; The Initial Developer of the Original Code is Netscape Communications
|
||||
;;; Corporation. Portions created by Netscape Communications Corporation are
|
||||
;;; Copyright (C) 1999 Netscape Communications Corporation. All
|
||||
;;; Rights Reserved.
|
||||
;;;
|
||||
;;; Contributor(s): Waldemar Horwat <waldemar@acm.org>
|
||||
|
||||
;;;
|
||||
;;; Custom HTML-to-RTF Converter
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
|
||||
(defconstant *missing-marker* "*****")
|
||||
|
||||
|
||||
; Return the html-name-token of the tag of the given html element.
|
||||
(defun tag-name (element)
|
||||
(html-parser:name (instance-of element)))
|
||||
|
||||
|
||||
(defun match-tag-name (element tag-name)
|
||||
(eq (tag-name element) tag-name))
|
||||
|
||||
|
||||
; Return the value of the given attribute in <element> or nil if not found.
|
||||
(defun attribute-value (element attribute-name)
|
||||
(cdr (assoc attribute-name (attr-values element) :key #'html-parser:name)))
|
||||
|
||||
|
||||
; Return true if the element has the given given <tag-name>, all of required-attributes, and perhaps
|
||||
; the optional-attributes.
|
||||
(defun match-element (element tag-name required-attributes optional-attributes)
|
||||
(and (match-tag-name element tag-name)
|
||||
(let ((attribute-values (attr-values element)))
|
||||
(and
|
||||
(every #'(lambda (required-attribute)
|
||||
(assoc required-attribute attribute-values :key #'html-parser:name))
|
||||
required-attributes)
|
||||
(every #'(lambda (attribute-value)
|
||||
(let ((attribute (html-parser:name (car attribute-value))))
|
||||
(or (member attribute required-attributes)
|
||||
(member attribute optional-attributes))))
|
||||
attribute-values)))))
|
||||
|
||||
|
||||
; Ensure that <element> has the given given <tag-name>, all of required-attributes, and perhaps
|
||||
; the optional-attributes.
|
||||
(defun ensure-element (element tag-name required-attributes optional-attributes)
|
||||
(unless (match-element element tag-name required-attributes optional-attributes)
|
||||
(error "Tag ~S ~S ~S expected; got ~S" tag-name required-attributes optional-attributes element)))
|
||||
|
||||
|
||||
; Return the children of <element> that have the given <tag-name>, all of required-attributes, and perhaps
|
||||
; the optional-attributes.
|
||||
(defun matching-parts (element tag-name required-attributes optional-attributes)
|
||||
(remove-if-not #'(lambda (child) (match-element child tag-name required-attributes optional-attributes))
|
||||
(parts element)))
|
||||
|
||||
|
||||
; Return the unique child of <element> that has the given <tag-name>, all of required-attributes, and perhaps
|
||||
; the optional-attributes.
|
||||
(defun matching-part (element tag-name required-attributes optional-attributes)
|
||||
(let ((parts (matching-parts element tag-name required-attributes optional-attributes)))
|
||||
(unless (and parts (endp (cdr parts)))
|
||||
(error "Element ~S should have only one ~S child" element tag-name))
|
||||
(car parts)))
|
||||
|
||||
|
||||
; Convert control characters in the given string into spaces.
|
||||
(defun normalize (string)
|
||||
(let ((l nil))
|
||||
(dotimes (i (length string))
|
||||
(let ((ch (char string i)))
|
||||
(if (<= (char-code ch) 32)
|
||||
(unless (eql (car l) #\Space)
|
||||
(push #\Space l))
|
||||
(push ch l))))
|
||||
(coerce (nreverse l) 'string)))
|
||||
|
||||
|
||||
(defun normalize-preformatted (string)
|
||||
(map 'list #'(lambda (ch)
|
||||
(if (< (char-code ch) 32)
|
||||
'line
|
||||
(string ch)))
|
||||
string))
|
||||
|
||||
|
||||
(defvar *preformatted* nil)
|
||||
|
||||
(defun emit-string (markup-stream string)
|
||||
(if *preformatted*
|
||||
(dolist (segment (normalize-preformatted string))
|
||||
(depict markup-stream segment))
|
||||
(depict markup-stream (normalize string))))
|
||||
|
||||
|
||||
(defparameter *special-char-code-map*
|
||||
'((#x0097 . endash)
|
||||
(#x00AB . :left-angle-quote)
|
||||
(#x00BB . :right-angle-quote)
|
||||
(#x2018 . :left-single-quote)
|
||||
(#x2019 . :right-single-quote)
|
||||
(#x201C . :left-double-quote)
|
||||
(#x201D . :right-double-quote)))
|
||||
|
||||
|
||||
(defun emit-special-character (markup-stream char-num)
|
||||
(let ((code (cdr (assoc char-num *special-char-code-map*))))
|
||||
(if code
|
||||
(depict markup-stream code)
|
||||
(progn
|
||||
(depict markup-stream *missing-marker*)
|
||||
(format *terminal-io* "Ignoring character code ~S~%" char-num)))))
|
||||
|
||||
|
||||
(defparameter *character-style-map*
|
||||
'(("control" . :character-literal-control)
|
||||
("terminal" . :terminal)
|
||||
("terminal-keyword" . :terminal-keyword)
|
||||
("nonterminal" . :nonterminal)
|
||||
("nonterminal-attribute" . :nonterminal-attribute)
|
||||
("nonterminal-argument" . :nonterminal-argument)
|
||||
("semantic-keyword" . :semantic-keyword)
|
||||
("type-expression" . :type-expression)
|
||||
("type-name" . :type-name)
|
||||
("field-name" . :field-name)
|
||||
("id-name" . :id-name)
|
||||
("global-variable" . :global-variable)
|
||||
("local-variable" . :local-variable)
|
||||
("action-name" . :action-name)
|
||||
("sub" . sub)
|
||||
("sub-num" . :plain-subscript)))
|
||||
|
||||
|
||||
(defun class-to-character-style (element)
|
||||
(let ((class (attribute-value element '#t"CLASS")))
|
||||
(if (null class)
|
||||
nil
|
||||
(let ((style (cdr (assoc class *character-style-map* :test #'equal))))
|
||||
(unless style
|
||||
(format *terminal-io* "Ignoring character style ~S~%" class))
|
||||
style))))
|
||||
|
||||
|
||||
(defparameter *u-styles*
|
||||
'(("U_bull" . :bullet)
|
||||
("U_ne" . :not-equal)
|
||||
("U_le" . :less-or-equal)
|
||||
("U_ge" . :greater-or-equal)
|
||||
("U_infin" . :infinity)
|
||||
("U_perp" . :bottom-10)
|
||||
("U_larr" . :vector-assign-10)
|
||||
("U_uarr" . :up-arrow-10)
|
||||
("U_rarr" . :function-arrow-10)
|
||||
("U_times" . :cartesian-product-10)
|
||||
("U_equiv" . :identical-10)
|
||||
("U_oplus" . :circle-plus-10)
|
||||
("U_empty" . :empty-10)
|
||||
("U_cap" . :intersection-10)
|
||||
("U_cup" . :union-10)
|
||||
("U_isin" . :member-10)
|
||||
("U_notin" . :not-member-10)
|
||||
("U_rArr" . :derives-10)
|
||||
("U_lang" . :left-triangle-bracket-10)
|
||||
("U_rang" . :right-triangle-bracket-10)
|
||||
|
||||
("U_alpha" . :alpha)
|
||||
("U_beta" . :beta)
|
||||
("U_chi" . :chi)
|
||||
("U_delta" . :delta)
|
||||
("U_epsilon" . :epsilon)
|
||||
("U_phi" . :phi)
|
||||
("U_gamma" . :gamma)
|
||||
("U_eta" . :eta)
|
||||
("U_iota" . :iota)
|
||||
("U_kappa" . :kappa)
|
||||
("U_lambda" . :lambda)
|
||||
("U_mu" . :mu)
|
||||
("U_nu" . :nu)
|
||||
("U_omicron" . :omicron)
|
||||
("U_pi" . :pi)
|
||||
("U_theta" . :theta)
|
||||
("U_rho" . :rho)
|
||||
("U_sigma" . :sigma)
|
||||
("U_tau" . :tau)
|
||||
("U_upsilon" . :upsilon)
|
||||
("U_omega" . :omega)
|
||||
("U_xi" . :xi)
|
||||
("U_psi" . :psi)
|
||||
("U_zeta" . :zeta)
|
||||
|
||||
("U_Omega" . :capital-omega)))
|
||||
|
||||
(defun emit-script-element (markup-stream element)
|
||||
(let* ((children (parts element))
|
||||
(child (first children)))
|
||||
(if (and
|
||||
(= (length children) 1)
|
||||
(stringp child)
|
||||
(> (length child) 16)
|
||||
(equal (subseq child 0 15) "document.write(")
|
||||
(eql (char child (1- (length child))) #\)))
|
||||
(let* ((u-name (subseq child 15 (1- (length child))))
|
||||
(u-style (cdr (assoc u-name *u-styles* :test #'equal))))
|
||||
(if u-style
|
||||
(depict markup-stream u-style)
|
||||
(progn
|
||||
(depict markup-stream *missing-marker*)
|
||||
(format *terminal-io* "Ignoring SCRIPT element ~S ~S~%" element child))))
|
||||
(progn
|
||||
(depict markup-stream *missing-marker*)
|
||||
(format *terminal-io* "Ignoring SCRIPT element ~S ~S~%" element children)))))
|
||||
|
||||
|
||||
(defparameter *entity-map*
|
||||
'((#e"nbsp" . ~)
|
||||
(#e"lt" . "<")
|
||||
(#e"gt" . ">")
|
||||
(#e"amp" . "&")
|
||||
(#e"quot" . "\"")))
|
||||
|
||||
(defun emit-entity (markup-stream entity)
|
||||
(let ((rtf (cdr (assoc entity *entity-map*))))
|
||||
(if rtf
|
||||
(depict markup-stream rtf)
|
||||
(progn
|
||||
(depict markup-stream "*****[" (html-parser:token-name entity) "]")
|
||||
(format *terminal-io* "Ignoring entity ~S~%" entity)))))
|
||||
|
||||
|
||||
(defparameter *inline-element-map*
|
||||
'((#t"VAR" . :variable)
|
||||
(#t"B" . b)
|
||||
(#t"I" . i)
|
||||
(#t"TT" . :courier)
|
||||
(#t"SUB" . sub)))
|
||||
|
||||
(defun emit-inline-element (markup-stream element)
|
||||
(cond
|
||||
((stringp element)
|
||||
(emit-string markup-stream element))
|
||||
((integerp element)
|
||||
(emit-special-character markup-stream element))
|
||||
((typep element 'html-entity-token)
|
||||
(emit-entity markup-stream element))
|
||||
((match-element element '#t"SCRIPT" '(#t"TYPE") nil)
|
||||
(emit-script-element markup-stream element))
|
||||
((or
|
||||
(match-element element '#t"A" nil '(#t"CLASS" #t"HREF" #t"NAME"))
|
||||
(match-element element '#t"SPAN" nil '(#t"CLASS"))
|
||||
(match-element element '#t"VAR" '(#t"CLASS") nil))
|
||||
(depict-char-style (markup-stream (class-to-character-style element))
|
||||
(emit-inline-parts markup-stream element)))
|
||||
((match-element element '#t"CODE" nil '(#t"CLASS"))
|
||||
(let ((class (attribute-value element '#t"CLASS")))
|
||||
(if (equal class "terminal-keyword")
|
||||
(depict-char-style (markup-stream (class-to-character-style element))
|
||||
(emit-inline-parts markup-stream element))
|
||||
(progn
|
||||
(when class
|
||||
(format *terminal-io* "Ignoring CODE character style ~S~%" class))
|
||||
(depict-char-style (markup-stream :character-literal)
|
||||
(emit-inline-parts markup-stream element))))))
|
||||
((match-element element '#t"SUP" nil '(#t"CLASS"))
|
||||
(depict-char-style (markup-stream 'super)
|
||||
(depict-char-style (markup-stream (class-to-character-style element))
|
||||
(emit-inline-parts markup-stream element))))
|
||||
((match-element element '#t"BR" nil nil)
|
||||
(depict markup-stream :new-line))
|
||||
(t (let ((inline-style (cdr (assoc (tag-name element) *inline-element-map*))))
|
||||
(if (and inline-style (endp (attr-values element)))
|
||||
(depict-char-style (markup-stream inline-style)
|
||||
(emit-inline-parts markup-stream element))
|
||||
(progn
|
||||
(depict markup-stream *missing-marker*)
|
||||
(format *terminal-io* "Ignoring inline element ~S~%" element)))))))
|
||||
|
||||
|
||||
; Emit the children of the given element as inline elements.
|
||||
(defun emit-inline-parts (markup-stream element)
|
||||
(dolist (child (parts element))
|
||||
(emit-inline-element markup-stream child)))
|
||||
|
||||
|
||||
; Emit the children of the given element as inline elements in a paragraph of the given style.
|
||||
; However, if some children are paragraph-level elements, emit them as separate paragraphs.
|
||||
(defun emit-inline-or-paragraph-parts (markup-stream element paragraph-style)
|
||||
(emit-inline-or-paragraph-elements markup-stream (parts element) paragraph-style ))
|
||||
|
||||
(defparameter *paragraph-elements*
|
||||
'(#t"P" #t"TH" #t"TD" #t"PRE" #t"UL" #t"OL" #t"DIV" #t"HR" #t"TABLE" #t"H1" #t"H2" #t"H3" #t"H4"))
|
||||
|
||||
(defun paragraph-element? (element)
|
||||
(and (typep element 'html-tag-instance)
|
||||
(member (tag-name element) *paragraph-elements*)))
|
||||
|
||||
(defun emit-inline-or-paragraph-elements (markup-stream elements paragraph-style)
|
||||
(let* ((paragraph-element (member-if #'paragraph-element? elements))
|
||||
(inline-parts (ldiff elements paragraph-element)))
|
||||
(when inline-parts
|
||||
(depict-paragraph (markup-stream paragraph-style)
|
||||
(dolist (child inline-parts)
|
||||
(emit-inline-element markup-stream child))))
|
||||
(when paragraph-element
|
||||
(emit-paragraph-element markup-stream (car paragraph-element))
|
||||
(emit-inline-or-paragraph-elements markup-stream (cdr paragraph-element) paragraph-style))))
|
||||
|
||||
|
||||
(defparameter *class-paragraph-styles*
|
||||
'(("mod-date" . :mod-date)
|
||||
("grammar-argument" . :grammar-argument)
|
||||
("indent" . :body-text)
|
||||
("operator-heading" . :heading4)
|
||||
("semantics" . :semantics)
|
||||
("semantics-next" . :semantics-next)))
|
||||
|
||||
|
||||
(defun class-to-paragraph-style (element)
|
||||
(let ((class (attribute-value element '#t"CLASS")))
|
||||
(if class
|
||||
(let ((style (cdr (assoc class *class-paragraph-styles* :test #'equal))))
|
||||
(or style
|
||||
(progn
|
||||
(format *terminal-io* "Ignoring paragraph style ~S~%" class)
|
||||
:body-text)))
|
||||
:body-text)))
|
||||
|
||||
|
||||
(defun grammar-rule-child-style (element last)
|
||||
(and
|
||||
(match-element element '#t"DIV" '(#t"CLASS") nil)
|
||||
(let ((class (attribute-value element '#t"CLASS")))
|
||||
(cond
|
||||
((equal class "grammar-lhs")
|
||||
(if last :grammar-lhs-last :grammar-lhs))
|
||||
((equal class "grammar-rhs")
|
||||
(if last :grammar-rhs-last :grammar-rhs))
|
||||
(t nil)))))
|
||||
|
||||
|
||||
(defparameter *divs-containing-divs*
|
||||
'("indent"))
|
||||
|
||||
(defun emit-div (markup-stream element class)
|
||||
(cond
|
||||
((equal class "grammar-rule")
|
||||
(let ((children (parts element)))
|
||||
(do ()
|
||||
((endp children))
|
||||
(let* ((child (pop children))
|
||||
(style (grammar-rule-child-style child (endp children))))
|
||||
(unless style
|
||||
(format *terminal-io* "Bad grammar-rule child ~S~%" child)
|
||||
(setq style :body-text))
|
||||
(depict-paragraph (markup-stream style)
|
||||
(emit-inline-parts markup-stream child))))))
|
||||
((member class *divs-containing-divs* :test #'equal)
|
||||
(depict-paragraph (markup-stream :body-text)
|
||||
(depict markup-stream "***** BEGIN DIV" class))
|
||||
(emit-paragraph-elements markup-stream element)
|
||||
(depict-paragraph (markup-stream :body-text)
|
||||
(depict markup-stream "***** END DIV" class)))
|
||||
(t (emit-inline-or-paragraph-parts markup-stream element (class-to-paragraph-style element)))))
|
||||
|
||||
|
||||
(defparameter *paragraph-element-map*
|
||||
'((#t"H1" . :heading1)
|
||||
(#t"H2" . :heading2)
|
||||
(#t"H3" . :heading3)
|
||||
(#t"H4" . :heading4)))
|
||||
|
||||
|
||||
; Emit the paragraph-level element.
|
||||
(defun emit-paragraph-element (markup-stream element)
|
||||
(cond
|
||||
((or
|
||||
(match-element element '#t"P" nil '(#t"CLASS"))
|
||||
(match-element element '#t"TH" nil '(#t"CLASS" #t"COLSPAN" #t"ROWSPAN" #t"NOWRAP" #t"VALIGN" #t"ALIGN"))
|
||||
(match-element element '#t"TD" nil '(#t"CLASS" #t"COLSPAN" #t"ROWSPAN" #t"NOWRAP" #t"VALIGN" #t"ALIGN")))
|
||||
(emit-inline-or-paragraph-parts markup-stream element (class-to-paragraph-style element)))
|
||||
((match-element element '#t"PRE" nil nil)
|
||||
(depict-paragraph (markup-stream :sample-code)
|
||||
(let ((*preformatted* t))
|
||||
(emit-inline-parts markup-stream element))))
|
||||
((or (match-element element '#t"UL" nil nil)
|
||||
(match-element element '#t"OL" nil nil))
|
||||
(depict-paragraph (markup-stream :body-text)
|
||||
(depict markup-stream "***** BEGIN LIST"))
|
||||
(dolist (child (parts element))
|
||||
(ensure-element child '#t"LI" nil nil)
|
||||
(emit-inline-or-paragraph-parts markup-stream child :body-text))
|
||||
(depict-paragraph (markup-stream :body-text)
|
||||
(depict markup-stream "***** END LIST")))
|
||||
((match-element element '#t"DIV" nil '(#t"CLASS"))
|
||||
(let ((class (attribute-value element '#t"CLASS")))
|
||||
(if class
|
||||
(emit-div markup-stream element class)
|
||||
(emit-paragraph-elements markup-stream element))))
|
||||
((match-element element '#t"HR" nil nil))
|
||||
((match-element element '#t"TABLE" nil '(#t"BORDER" #t"CELLSPACING" #t"CELLPADDING"))
|
||||
(depict-paragraph (markup-stream :body-text)
|
||||
(depict markup-stream "***** BEGIN TABLE"))
|
||||
(emit-paragraph-elements markup-stream element)
|
||||
(depict-paragraph (markup-stream :body-text)
|
||||
(depict markup-stream "***** END TABLE")))
|
||||
((match-element element '#t"THEAD" nil nil)
|
||||
(emit-paragraph-elements markup-stream element))
|
||||
((match-element element '#t"TR" nil nil)
|
||||
(emit-paragraph-elements markup-stream element))
|
||||
(t (let ((paragraph-style (cdr (assoc (tag-name element) *paragraph-element-map*))))
|
||||
(if (and paragraph-style (endp (attr-values element)))
|
||||
(emit-inline-or-paragraph-parts markup-stream element paragraph-style)
|
||||
(progn
|
||||
(depict-paragraph (markup-stream :body-text)
|
||||
(depict markup-stream *missing-marker*))
|
||||
(format *terminal-io* "Ignoring paragraph element ~S~%" element)))))))
|
||||
|
||||
|
||||
; Emit the children of the given element as paragraph-level elements.
|
||||
(defun emit-paragraph-elements (markup-stream element)
|
||||
(dolist (child (parts element))
|
||||
(emit-paragraph-element markup-stream child)))
|
||||
|
||||
|
||||
(defun emit-html-file (markup-stream element)
|
||||
(ensure-element element '#t"HTML" nil nil)
|
||||
(let* ((body (matching-part element '#t"BODY" nil nil))
|
||||
(body-elements (parts body)))
|
||||
(when (and body-elements (match-tag-name (first body-elements) '#t"TABLE"))
|
||||
(setq body-elements (rest body-elements)))
|
||||
(when (and body-elements (match-tag-name (car (last body-elements)) '#t"TABLE"))
|
||||
(setq body-elements (butlast body-elements)))
|
||||
(dolist (body-element body-elements)
|
||||
(emit-paragraph-element markup-stream body-element))))
|
||||
|
||||
|
||||
(defun translate-html-to-rtf (html-file-name rtf-path title)
|
||||
(let* ((source-text (file->string html-file-name))
|
||||
(element (html-parser::simple-parser source-text)))
|
||||
(depict-rtf-to-local-file
|
||||
rtf-path
|
||||
title
|
||||
#'(lambda (markup-stream)
|
||||
(emit-html-file markup-stream element))
|
||||
*html-to-rtf-definitions*)))
|
||||
|
||||
#|
|
||||
(setq s (html-parser:file->string "Huit:Mozilla:Docs:mozilla-org:html:js:language:js20:formal:index.html"))
|
||||
(setq p (html-parser::simple-parser s))
|
||||
|
||||
(depict-rtf-to-local-file
|
||||
"HTML-To-RTF/Test.rtf"
|
||||
"Test"
|
||||
#'(lambda (markup-stream)
|
||||
(emit-html-file markup-stream p))
|
||||
*html-to-rtf-definitions*)
|
||||
|
||||
(translate-html-to-rtf "Huit:Mozilla:Docs:mozilla-org:html:js:language:js20:formal:index.html" "HTML-To-RTF/Test.rtf" "Test")
|
||||
(translate-html-to-rtf "Huit:Mozilla:Docs:mozilla-org:html:js:language:js20:introduction:notation.html"
|
||||
"HTML-To-RTF/Notation.rtf" "Notation")
|
||||
(translate-html-to-rtf "Huit:Mozilla:Docs:mozilla-org:html:js:language:es4:core:expressions.html"
|
||||
"HTML-To-RTF/Expressions.rtf" "Expressions")
|
||||
(translate-html-to-rtf "Huit:Mozilla:Moz:mozilla:js2:semantics:HTML-To-RTF:Expressions.html"
|
||||
"HTML-To-RTF/Expressions.rtf" "Expressions")
|
||||
|
||||
(translate-html-to-rtf "Huit:Mozilla:Docs:mozilla-org:html:js:language:js20:formal:stages.html"
|
||||
"HTML-To-RTF/Stages.rtf" "Stages")
|
||||
(translate-html-to-rtf "Huit:Mozilla:Docs:mozilla-org:html:js:language:js20:formal:notation.html"
|
||||
"HTML-To-RTF/FormalNotation.rtf" "Formal Notation")
|
||||
|#
|
||||
@@ -1,96 +0,0 @@
|
||||
;;; The contents of this file are subject to the Mozilla Public
|
||||
;;; License Version 1.1 (the "License"); you may not use this file
|
||||
;;; except in compliance with the License. You may obtain a copy of
|
||||
;;; the License at http://www.mozilla.org/MPL/
|
||||
;;;
|
||||
;;; Software distributed under the License is distributed on an "AS
|
||||
;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
;;; implied. See the License for the specific language governing
|
||||
;;; rights and limitations under the License.
|
||||
;;;
|
||||
;;; The Original Code is the Language Design and Prototyping Environment.
|
||||
;;;
|
||||
;;; The Initial Developer of the Original Code is Netscape Communications
|
||||
;;; Corporation. Portions created by Netscape Communications Corporation are
|
||||
;;; Copyright (C) 1999 Netscape Communications Corporation. All
|
||||
;;; Rights Reserved.
|
||||
;;;
|
||||
;;; Contributor(s): Waldemar Horwat <waldemar@acm.org>
|
||||
|
||||
;;;
|
||||
;;; Custom HTML-to-RTF Converter
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
|
||||
(defparameter *html-to-rtf-filenames*
|
||||
'("../Utilities" "../Markup" "../RTF" "Convert"))
|
||||
|
||||
(defparameter *html-to-rtf-directory*
|
||||
(make-pathname
|
||||
#+lispworks :host #+lispworks (pathname-host *load-truename*)
|
||||
:directory (pathname-directory #-mcl *load-truename*
|
||||
#+mcl (truename *loading-file-source-file*))))
|
||||
|
||||
(defparameter *semantic-engine-directory*
|
||||
(merge-pathnames (make-pathname :directory '(:relative :up)) *html-to-rtf-directory*))
|
||||
|
||||
|
||||
; Convert a filename string possibly containing slashes into a Lisp relative pathname.
|
||||
(defun filename-to-relative-pathname (filename)
|
||||
(let ((directories nil))
|
||||
(loop
|
||||
(let ((slash (position #\/ filename)))
|
||||
(if slash
|
||||
(let ((dir-name (subseq filename 0 slash)))
|
||||
(push (if (equal dir-name "..") :up dir-name) directories)
|
||||
(setq filename (subseq filename (1+ slash))))
|
||||
(return (if directories
|
||||
(make-pathname :directory (cons ':relative (nreverse directories)) :name filename #+lispworks :type #+lispworks "lisp")
|
||||
#-lispworks filename
|
||||
#+lispworks (make-pathname :name filename :type "lisp"))))))))
|
||||
|
||||
|
||||
; Convert a filename string possibly containing slashes relative to *html-to-rtf-directory*
|
||||
; into a Lisp absolute pathname.
|
||||
(defun filename-to-html-to-rtf-pathname (filename)
|
||||
(merge-pathnames (filename-to-relative-pathname filename) *html-to-rtf-directory*))
|
||||
|
||||
|
||||
; Convert a filename string possibly containing slashes relative to *semantic-engine-directory*
|
||||
; into a Lisp absolute pathname.
|
||||
(defun filename-to-semantic-engine-pathname (filename)
|
||||
(merge-pathnames (filename-to-relative-pathname filename) *semantic-engine-directory*))
|
||||
|
||||
|
||||
(defun operate-on-files (f files &rest options)
|
||||
(with-compilation-unit ()
|
||||
(dolist (filename files)
|
||||
(apply f (filename-to-html-to-rtf-pathname filename) :verbose t options))))
|
||||
|
||||
(defun compile-html-to-rtf ()
|
||||
(operate-on-files #'compile-file *html-to-rtf-filenames* :load t))
|
||||
|
||||
(defun load-html-to-rtf ()
|
||||
(operate-on-files #-allegro #'load #+allegro #'load-compiled *html-to-rtf-filenames*))
|
||||
|
||||
|
||||
(defmacro with-local-output ((stream filename) &body body)
|
||||
`(with-open-file (,stream (filename-to-html-to-rtf-pathname ,filename)
|
||||
:direction :output
|
||||
:if-exists :supersede)
|
||||
,@body))
|
||||
|
||||
|
||||
(load (filename-to-html-to-rtf-pathname "../HTML-Parser/mac-sysdcl"))
|
||||
(html-parser:initialize-parser)
|
||||
(import '(html-parser:file->string
|
||||
html-parser:instance-of
|
||||
html-parser:parts
|
||||
html-parser:part-of
|
||||
html-parser:attr-values
|
||||
html-parser:html-entity-token
|
||||
html-parser:html-tag-instance))
|
||||
|
||||
(load-html-to-rtf)
|
||||
@@ -1,696 +0,0 @@
|
||||
;;; The contents of this file are subject to the Mozilla Public
|
||||
;;; License Version 1.1 (the "License"); you may not use this file
|
||||
;;; except in compliance with the License. You may obtain a copy of
|
||||
;;; the License at http://www.mozilla.org/MPL/
|
||||
;;;
|
||||
;;; Software distributed under the License is distributed on an "AS
|
||||
;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
;;; implied. See the License for the specific language governing
|
||||
;;; rights and limitations under the License.
|
||||
;;;
|
||||
;;; The Original Code is the Language Design and Prototyping Environment.
|
||||
;;;
|
||||
;;; The Initial Developer of the Original Code is Netscape Communications
|
||||
;;; Corporation. Portions created by Netscape Communications Corporation are
|
||||
;;; Copyright (C) 1999 Netscape Communications Corporation. All
|
||||
;;; Rights Reserved.
|
||||
;;;
|
||||
;;; Contributor(s): Waldemar Horwat <waldemar@acm.org>
|
||||
|
||||
;;;
|
||||
;;; HTML output generator
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; ELEMENTS
|
||||
|
||||
(defstruct (html-element (:constructor make-html-element (name self-closing indent
|
||||
newlines-before newlines-begin newlines-end newlines-after))
|
||||
(:predicate html-element?))
|
||||
(name nil :type symbol :read-only t) ;Name of the tag
|
||||
(self-closing nil :type bool :read-only t) ;True if the closing tag should be omitted
|
||||
(indent nil :type integer :read-only t) ;Number of spaces by which to indent this tag's contents in HTML source
|
||||
(newlines-before nil :type integer :read-only t) ;Number of HTML source newlines preceding the opening tag
|
||||
(newlines-begin nil :type integer :read-only t) ;Number of HTML source newlines immediately following the opening tag
|
||||
(newlines-end nil :type integer :read-only t) ;Number of HTML source newlines immediately preceding the closing tag
|
||||
(newlines-after nil :type integer :read-only t)) ;Number of HTML source newlines following the closing tag
|
||||
|
||||
|
||||
; Define symbol to refer to the given html-element.
|
||||
(defun define-html (symbol newlines-before newlines-begin newlines-end newlines-after &key self-closing (indent 0))
|
||||
(setf (get symbol 'html-element) (make-html-element symbol self-closing indent
|
||||
newlines-before newlines-begin newlines-end newlines-after)))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; ELEMENT DEFINITIONS
|
||||
|
||||
(define-html 'a 0 0 0 0)
|
||||
(define-html 'b 0 0 0 0)
|
||||
(define-html 'blockquote 1 0 0 1 :indent 2)
|
||||
(define-html 'body 1 1 1 1)
|
||||
(define-html 'br 0 0 0 1 :self-closing t)
|
||||
(define-html 'code 0 0 0 0)
|
||||
(define-html 'dd 1 0 0 1 :indent 2)
|
||||
(define-html 'del 0 0 0 0)
|
||||
(define-html 'div 1 0 0 1 :indent 2)
|
||||
(define-html 'dl 1 0 0 2 :indent 2)
|
||||
(define-html 'dt 1 0 0 1 :indent 2)
|
||||
(define-html 'em 0 0 0 0)
|
||||
(define-html 'h1 2 0 0 2 :indent 2)
|
||||
(define-html 'h2 2 0 0 2 :indent 2)
|
||||
(define-html 'h3 2 0 0 2 :indent 2)
|
||||
(define-html 'h4 1 0 0 2 :indent 2)
|
||||
(define-html 'h5 1 0 0 2 :indent 2)
|
||||
(define-html 'h6 1 0 0 2 :indent 2)
|
||||
(define-html 'head 1 1 1 2)
|
||||
(define-html 'hr 1 0 0 1 :self-closing t)
|
||||
(define-html 'html 0 1 1 1)
|
||||
(define-html 'i 0 0 0 0)
|
||||
(define-html 'li 1 0 0 1 :indent 2)
|
||||
(define-html 'link 1 0 0 1 :self-closing t)
|
||||
(define-html 'ol 1 1 1 2 :indent 2)
|
||||
(define-html 'p 1 0 0 2)
|
||||
(define-html 'script 0 0 0 0)
|
||||
(define-html 'span 0 0 0 0)
|
||||
(define-html 'strong 0 0 0 0)
|
||||
(define-html 'sub 0 0 0 0)
|
||||
(define-html 'sup 0 0 0 0)
|
||||
(define-html 'table 1 1 1 2)
|
||||
(define-html 'td 1 0 0 1 :indent 2)
|
||||
(define-html 'th 1 0 0 1 :indent 2)
|
||||
(define-html 'title 1 0 0 1)
|
||||
(define-html 'tr 1 0 0 1 :indent 2)
|
||||
(define-html 'u 0 0 0 0)
|
||||
(define-html 'ul 1 1 1 2 :indent 2)
|
||||
(define-html 'var 0 0 0 0)
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; ATTRIBUTES
|
||||
|
||||
;;; The following element attributes require their values to always be in quotes.
|
||||
(dolist (attribute '(alt href name))
|
||||
(setf (get attribute 'quoted-attribute) t))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; ENTITIES
|
||||
|
||||
(defvar *html-entities-list*
|
||||
'((#\& . "amp")
|
||||
(#\" . "quot")
|
||||
(#\< . "lt")
|
||||
(#\> . "gt")
|
||||
(nbsp . "nbsp")))
|
||||
|
||||
(defvar *html-entities-hash* (make-hash-table))
|
||||
|
||||
(dolist (entity-binding *html-entities-list*)
|
||||
(setf (gethash (first entity-binding) *html-entities-hash*) (rest entity-binding)))
|
||||
|
||||
|
||||
; Return a freshly consed list of <html-source> that represent the characters in the string except that
|
||||
; '&', '<', and '>' are replaced by their entities and spaces are replaced by the entity
|
||||
; given by the space parameter (which should be either 'space or 'nbsp).
|
||||
(defun escape-html-characters (string space)
|
||||
(let ((html-sources nil))
|
||||
(labels
|
||||
((escape-remainder (start)
|
||||
(let ((i (position-if #'(lambda (char) (member char '(#\& #\< #\> #\space))) string :start start)))
|
||||
(if i
|
||||
(let ((char (char string i)))
|
||||
(unless (= i start)
|
||||
(push (subseq string start i) html-sources))
|
||||
(push (if (eql char #\space) space char) html-sources)
|
||||
(escape-remainder (1+ i)))
|
||||
(push (if (zerop start) string (subseq string start)) html-sources)))))
|
||||
(unless (zerop (length string))
|
||||
(escape-remainder 0))
|
||||
(nreverse html-sources))))
|
||||
|
||||
|
||||
; Escape all content strings in the html-source, while interpreting :nowrap, :wrap, and :none pseudo-tags.
|
||||
; Return a freshly consed list of html-sources.
|
||||
(defun escape-html-source (html-source space)
|
||||
(cond
|
||||
((stringp html-source)
|
||||
(escape-html-characters html-source space))
|
||||
((or (characterp html-source) (symbolp html-source) (integerp html-source))
|
||||
(list html-source))
|
||||
((consp html-source)
|
||||
(let ((tag (first html-source))
|
||||
(contents (rest html-source)))
|
||||
(case tag
|
||||
(:none (mapcan #'(lambda (html-source) (escape-html-source html-source space)) contents))
|
||||
(:nowrap (mapcan #'(lambda (html-source) (escape-html-source html-source 'nbsp)) contents))
|
||||
(:wrap (mapcan #'(lambda (html-source) (escape-html-source html-source 'space)) contents))
|
||||
(t (list (cons tag
|
||||
(mapcan #'(lambda (html-source) (escape-html-source html-source space)) contents)))))))
|
||||
(t (error "Bad html-source: ~S" html-source))))
|
||||
|
||||
|
||||
; Escape all content strings in the html-source, while interpreting :nowrap, :wrap, and :none pseudo-tags.
|
||||
(defun escape-html (html-source)
|
||||
(let ((results (escape-html-source html-source 'space)))
|
||||
(assert-true (= (length results) 1))
|
||||
(first results)))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; HTML WRITER
|
||||
|
||||
;; <html-source> has one of the following formats:
|
||||
;; <string> ;String to be printed literally
|
||||
;; <symbol> ;Named entity
|
||||
;; <integer> ;Numbered entity
|
||||
;; space ;Space or newline
|
||||
;; (<tag> <html-source> ... <html-source>) ;Tag and its contents
|
||||
;; ((:nest <tag> ... <tag>) <html-source> ... <html-source>) ;Equivalent to (<tag> (... (<tag> <html-source> ... <html-source>)))
|
||||
;;
|
||||
;; <tag> has one of the following formats:
|
||||
;; <symbol> ;Tag with no attributes
|
||||
;; (<symbol> <attribute> ... <attribute>) ;Tag with attributes
|
||||
;; :nowrap ;Pseudo-tag indicating that spaces in contents should be non-breaking
|
||||
;; :wrap ;Pseudo-tag indicating that spaces in contents should be breaking
|
||||
;; :none ;Pseudo-tag indicating no tag -- the contents should be inlined
|
||||
;;
|
||||
;; <attribute> has one of the following formats:
|
||||
;; (<symbol> <string>) ;Attribute name and value
|
||||
;; (<symbol>) ;Attribute name with omitted value
|
||||
|
||||
|
||||
(defparameter *html-right-margin* 120)
|
||||
(defparameter *allow-line-breaks-in-tags* nil) ;Allow line breaks in tags between attributes?
|
||||
|
||||
(defvar *current-html-pos*) ;Number of characters written to the current line of the stream; nil if *current-html-newlines* is nonzero
|
||||
(defvar *current-html-pending*) ;String following a space or newline pending to be printed on the current line or nil if none
|
||||
(defvar *current-html-indent*) ;Indent to use for emit-html-newlines-and-indent calls
|
||||
(defvar *current-html-newlines*) ;Number of consecutive newlines just written to the stream; zero if last character wasn't a newline
|
||||
|
||||
|
||||
; Flush *current-html-pending* onto the stream.
|
||||
(defun flush-current-html-pending (stream)
|
||||
(when *current-html-pending*
|
||||
(unless (zerop (length *current-html-pending*))
|
||||
(write-char #\space stream)
|
||||
(write-string *current-html-pending* stream)
|
||||
(incf *current-html-pos* (1+ (length *current-html-pending*))))
|
||||
(setq *current-html-pending* nil)))
|
||||
|
||||
|
||||
; Emit n-newlines onto the stream and indent the next line by *current-html-indent* spaces.
|
||||
(defun emit-html-newlines-and-indent (stream n-newlines)
|
||||
(decf n-newlines *current-html-newlines*)
|
||||
(when (plusp n-newlines)
|
||||
(flush-current-html-pending stream)
|
||||
(dotimes (i n-newlines)
|
||||
(write-char #\newline stream))
|
||||
(incf *current-html-newlines* n-newlines)
|
||||
(setq *current-html-pos* nil)))
|
||||
|
||||
|
||||
; Write the string to the stream, observing *current-html-pending* and *current-html-pos*.
|
||||
(defun write-html-string (stream html-string)
|
||||
(unless (zerop (length html-string))
|
||||
(unless *current-html-pos*
|
||||
(setq *current-html-newlines* 0)
|
||||
(write-string (make-string *current-html-indent* :initial-element #\space) stream)
|
||||
(setq *current-html-pos* *current-html-indent*))
|
||||
(if *current-html-pending*
|
||||
(progn
|
||||
(setq *current-html-pending* (if (zerop (length *current-html-pending*))
|
||||
html-string
|
||||
(concatenate 'string *current-html-pending* html-string)))
|
||||
(when (>= (+ *current-html-pos* (length *current-html-pending*)) *html-right-margin*)
|
||||
(write-char #\newline stream)
|
||||
(write-string *current-html-pending* stream)
|
||||
(setq *current-html-pos* (length *current-html-pending*))
|
||||
(setq *current-html-pending* nil)))
|
||||
(progn
|
||||
(write-string html-string stream)
|
||||
(incf *current-html-pos* (length html-string))))))
|
||||
|
||||
|
||||
; Return true if the value string contains a character that would require an attribute to be quoted.
|
||||
; For convenience, this returns true if value contains a period, even though strictly speaking periods do
|
||||
; not force quoting.
|
||||
(defun attribute-value-needs-quotes (value)
|
||||
(dotimes (i (length value) nil)
|
||||
(let ((ch (char value i)))
|
||||
(unless (or (char<= #\0 ch #\9) (char<= #\A ch #\Z) (char<= #\a ch #\z) (char= ch #\-))
|
||||
(return t)))))
|
||||
|
||||
|
||||
; Emit the html tag with the given tag-symbol (name), attributes, and contents.
|
||||
(defun write-html-tag (stream tag-symbol attributes contents)
|
||||
(let ((element (assert-non-null (get tag-symbol 'html-element))))
|
||||
(emit-html-newlines-and-indent stream (html-element-newlines-before element))
|
||||
(write-html-string stream (format nil "<~A" (html-element-name element)))
|
||||
(let ((*current-html-indent* (+ *current-html-indent* (html-element-indent element))))
|
||||
(dolist (attribute attributes)
|
||||
(let ((name (first attribute))
|
||||
(value (second attribute)))
|
||||
(write-html-source stream (if *allow-line-breaks-in-tags* 'space #\space))
|
||||
(write-html-string stream (string-downcase (symbol-name name)))
|
||||
(when value
|
||||
(write-html-string
|
||||
stream
|
||||
(format nil
|
||||
(if (or (attribute-value-needs-quotes value)
|
||||
(get name 'quoted-attribute))
|
||||
"=\"~A\""
|
||||
"=~A")
|
||||
value)))))
|
||||
(write-html-string stream ">")
|
||||
(emit-html-newlines-and-indent stream (html-element-newlines-begin element))
|
||||
(dolist (html-source contents)
|
||||
(write-html-source stream html-source)))
|
||||
(unless (html-element-self-closing element)
|
||||
(emit-html-newlines-and-indent stream (html-element-newlines-end element))
|
||||
(write-html-string stream (format nil "</~A>" (html-element-name element))))
|
||||
(emit-html-newlines-and-indent stream (html-element-newlines-after element))))
|
||||
|
||||
|
||||
; Write html-source to the character stream.
|
||||
(defun write-html-source (stream html-source)
|
||||
(cond
|
||||
((stringp html-source)
|
||||
(write-html-string stream html-source))
|
||||
((eq html-source 'space)
|
||||
(when (zerop *current-html-newlines*)
|
||||
(flush-current-html-pending stream)
|
||||
(setq *current-html-pending* "")))
|
||||
((or (characterp html-source) (symbolp html-source))
|
||||
(let ((entity-name (gethash html-source *html-entities-hash*)))
|
||||
(cond
|
||||
(entity-name
|
||||
(write-html-string stream (format nil "&~A;" entity-name)))
|
||||
((characterp html-source)
|
||||
(write-html-string stream (string html-source)))
|
||||
(t (error "Bad html-source ~S" html-source)))))
|
||||
((integerp html-source)
|
||||
(assert-true (and (>= html-source 0) (< html-source 65536)))
|
||||
(write-html-string stream (format nil "&#~D;" html-source)))
|
||||
((consp html-source)
|
||||
(let ((tag (first html-source))
|
||||
(contents (rest html-source)))
|
||||
(if (consp tag)
|
||||
(write-html-tag stream (first tag) (rest tag) contents)
|
||||
(write-html-tag stream tag nil contents))))
|
||||
(t (error "Bad html-source: ~S" html-source))))
|
||||
|
||||
|
||||
; Write the top-level html-source to the character stream.
|
||||
(defun write-html (html-source &optional (stream t))
|
||||
(with-standard-io-syntax
|
||||
(let ((*print-readably* nil)
|
||||
(*print-escape* nil)
|
||||
(*print-case* :upcase)
|
||||
(*current-html-pos* nil)
|
||||
(*current-html-pending* nil)
|
||||
(*current-html-indent* 0)
|
||||
(*current-html-newlines* 9999))
|
||||
(write-string "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" \"http://www.w3.org/TR/REC-html40/loose.dtd\">" stream)
|
||||
(write-char #\newline stream)
|
||||
(write-html-source stream (escape-html html-source)))))
|
||||
|
||||
|
||||
; Write html to the text file with the given name (relative to the
|
||||
; local directory).
|
||||
(defun write-html-to-local-file (filename html)
|
||||
(with-open-file (stream (filename-to-semantic-engine-pathname filename)
|
||||
:direction :output
|
||||
:if-exists :supersede
|
||||
#+mcl :mac-file-creator #+mcl "MOSS")
|
||||
(write-html html stream)))
|
||||
|
||||
|
||||
; Expand the :nest constructs inside html-source.
|
||||
(defun unnest-html-source (html-source)
|
||||
(labels
|
||||
((unnest-tags (tags contents)
|
||||
(assert-true tags)
|
||||
(cons (first tags)
|
||||
(if (endp (rest tags))
|
||||
contents
|
||||
(list (unnest-tags (rest tags) contents))))))
|
||||
(if (consp html-source)
|
||||
(let ((tag (first html-source))
|
||||
(contents (rest html-source)))
|
||||
(if (and (consp tag) (eq (first tag) ':nest))
|
||||
(unnest-html-source (unnest-tags (rest tag) contents))
|
||||
(cons tag (mapcar #'unnest-html-source contents))))
|
||||
html-source)))
|
||||
|
||||
|
||||
; Coalesce an A element immediately containing or contained in a SPAN element into one if their attributes
|
||||
; are disjoint. Also coalesce SUB and SUP elements immediately containing SPAN elements into one.
|
||||
(defun coalesce-elements (html-source)
|
||||
(if (consp html-source)
|
||||
(let ((tag (first html-source))
|
||||
(contents (mapcar #'coalesce-elements (rest html-source))))
|
||||
(cond
|
||||
((and (consp tag)
|
||||
(member (first tag) '(a span))
|
||||
contents
|
||||
(null (cdr contents))
|
||||
(consp (car contents))
|
||||
(let ((tag2 (caar contents)))
|
||||
(and (consp tag2)
|
||||
(member (first tag2) '(a span))
|
||||
(not (eq tag tag2))
|
||||
(null (intersection (rest tag) (rest tag2) :key #'car)))))
|
||||
(cons
|
||||
(cons 'a
|
||||
(if (eq (first tag) 'a)
|
||||
(append (rest tag) (rest (caar contents)))
|
||||
(append (rest (caar contents)) (rest tag))))
|
||||
(cdar contents)))
|
||||
((and (member tag '(sub sup))
|
||||
contents
|
||||
(null (cdr contents))
|
||||
(consp (car contents))
|
||||
(consp (caar contents))
|
||||
(eq (caaar contents) 'span))
|
||||
(cons
|
||||
(cons tag (rest (caar contents)))
|
||||
(cdar contents)))
|
||||
(t (cons tag contents))))
|
||||
html-source))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; HTML MAPPINGS
|
||||
|
||||
(defparameter *html-definitions*
|
||||
'(((:new-line t) (br))
|
||||
|
||||
;Misc.
|
||||
(:spc nbsp)
|
||||
(:tab2 nbsp nbsp)
|
||||
(:tab3 nbsp nbsp nbsp)
|
||||
(:nbhy "-") ;Non-breaking hyphen
|
||||
|
||||
;Symbols (-10 suffix means 10-point, etc.)
|
||||
((:bullet 1) (:script "document.write(U_bull)")) ;#x2022
|
||||
((:minus 1) "-")
|
||||
((:not-equal 1) (:script "document.write(U_ne)")) ;#x2260
|
||||
((:less-or-equal 1) (:script "document.write(U_le)")) ;#x2264
|
||||
((:greater-or-equal 1) (:script "document.write(U_ge)")) ;#x2265
|
||||
((:infinity 1) (:script "document.write(U_infin)")) ;#x221E
|
||||
((:left-single-quote 1) #x2018)
|
||||
((:right-single-quote 1) #x2019)
|
||||
((:left-double-quote 1) #x201C)
|
||||
((:right-double-quote 1) #x201D)
|
||||
((:left-angle-quote 1) #x00AB)
|
||||
((:right-angle-quote 1) #x00BB)
|
||||
((:bottom-10 1) (:script "document.write(U_perp)")) ;#x22A5
|
||||
((:vector-assign-10 1) (:script "document.write(U_larr)")) ;#x2190
|
||||
((:up-arrow-10 1) (:script "document.write(U_uarr)")) ;#x2191
|
||||
((:function-arrow-10 2) (:script "document.write(U_rarr)")) ;#x2192
|
||||
((:cartesian-product-10 2) (:script "document.write(U_times)")) ;#x00D7
|
||||
((:identical-10 2) (:script "document.write(U_equiv)")) ;#x2261
|
||||
((:circle-plus-10 2) (:script "document.write(U_oplus)")) ;#x2295
|
||||
((:empty-10 2) (:script "document.write(U_empty)")) ;#x2205
|
||||
((:intersection-10 1) (:script "document.write(U_cap)")) ;#x2229
|
||||
((:union-10 1) (:script "document.write(U_cup)")) ;#x222A
|
||||
((:member-10 2) (:script "document.write(U_isin)")) ;#x2208
|
||||
((:not-member-10 2) (:script "document.write(U_notin)")) ;#x2209
|
||||
((:derives-10 2) (:script "document.write(U_rArr)")) ;#x21D2
|
||||
((:left-triangle-bracket-10 1) (:script "document.write(U_lang)")) ;#x2329
|
||||
((:right-triangle-bracket-10 1) (:script "document.write(U_rang)")) ;#x232A
|
||||
|
||||
((:alpha 1) (:script "document.write(U_alpha)"))
|
||||
((:beta 1) (:script "document.write(U_beta)"))
|
||||
((:chi 1) (:script "document.write(U_chi)"))
|
||||
((:delta 1) (:script "document.write(U_delta)"))
|
||||
((:epsilon 1) (:script "document.write(U_epsilon)"))
|
||||
((:phi 1) (:script "document.write(U_phi)"))
|
||||
((:gamma 1) (:script "document.write(U_gamma)"))
|
||||
((:eta 1) (:script "document.write(U_eta)"))
|
||||
((:iota 1) (:script "document.write(U_iota)"))
|
||||
((:kappa 1) (:script "document.write(U_kappa)"))
|
||||
((:lambda 1) (:script "document.write(U_lambda)"))
|
||||
((:mu 1) (:script "document.write(U_mu)"))
|
||||
((:nu 1) (:script "document.write(U_nu)"))
|
||||
((:omicron 1) (:script "document.write(U_omicron)"))
|
||||
((:pi 1) (:script "document.write(U_pi)"))
|
||||
((:theta 1) (:script "document.write(U_theta)"))
|
||||
((:rho 1) (:script "document.write(U_rho)"))
|
||||
((:sigma 1) (:script "document.write(U_sigma)"))
|
||||
((:tau 1) (:script "document.write(U_tau)"))
|
||||
((:upsilon 1) (:script "document.write(U_upsilon)"))
|
||||
((:omega 1) (:script "document.write(U_omega)"))
|
||||
((:xi 1) (:script "document.write(U_xi)"))
|
||||
((:psi 1) (:script "document.write(U_psi)"))
|
||||
((:zeta 1) (:script "document.write(U_zeta)"))
|
||||
|
||||
;Block Styles
|
||||
(:js2 (div (class "js2")))
|
||||
(:es4 (div (class "es4")))
|
||||
(:body-text p)
|
||||
(:section-heading h2)
|
||||
(:subsection-heading h3)
|
||||
(:grammar-header h4)
|
||||
(:grammar-rule (:nest :nowrap (div (class "grammar-rule"))))
|
||||
(:grammar-lhs (:nest :nowrap (div (class "grammar-lhs"))))
|
||||
(:grammar-lhs-last :grammar-lhs)
|
||||
(:grammar-rhs (:nest :nowrap (div (class "grammar-rhs"))))
|
||||
(:grammar-rhs-last :grammar-rhs)
|
||||
(:grammar-argument (:nest :nowrap (div (class "grammar-argument"))))
|
||||
(:semantics (:nest :nowrap (div (class "semantics"))))
|
||||
(:semantics-next (:nest :nowrap (div (class "semantics-next"))))
|
||||
(:semantic-comment (div (class "semantic-comment")))
|
||||
|
||||
;Inline Styles
|
||||
(:script (script (type "text/javascript")))
|
||||
(:symbol (span (class "symbol")))
|
||||
(:character-literal code)
|
||||
(:character-literal-control (span (class "control")))
|
||||
(:terminal (span (class "terminal")))
|
||||
(:terminal-keyword (code (class "terminal-keyword")))
|
||||
(:nonterminal (span (class "nonterminal")))
|
||||
(:nonterminal-attribute (span (class "nonterminal-attribute")))
|
||||
(:nonterminal-argument (span (class "nonterminal-argument")))
|
||||
(:semantic-keyword (span (class "semantic-keyword")))
|
||||
(:type-expression (span (class "type-expression")))
|
||||
(:type-name (span (class "type-name")))
|
||||
(:field-name (span (class "field-name")))
|
||||
(:global-variable (span (class "global-variable")))
|
||||
(:local-variable (span (class "local-variable")))
|
||||
(:action-name (span (class "action-name")))
|
||||
(:text :wrap)
|
||||
|
||||
;Specials
|
||||
(:invisible del)
|
||||
((:but-not 6) (b "except"))
|
||||
((:begin-negative-lookahead 13) "[lookahead" :not-member-10 "{")
|
||||
((:end-negative-lookahead 2) "}]")
|
||||
((:line-break 12) "[line" nbsp "break]")
|
||||
((:no-line-break 15) "[no" nbsp "line" nbsp "break]")
|
||||
(:subscript sub)
|
||||
(:superscript sup)
|
||||
(:plain-subscript :subscript)
|
||||
((:action-begin 1) "[")
|
||||
((:action-end 1) "]")
|
||||
((:vector-begin 1) (b "["))
|
||||
((:vector-end 1) (b "]"))
|
||||
((:empty-vector 2) (b "[]"))
|
||||
((:vector-construct 1) (b "|"))
|
||||
((:vector-append 2) :circle-plus-10)
|
||||
((:tuple-begin 1) (b :left-triangle-bracket-10))
|
||||
((:tuple-end 1) (b :right-triangle-bracket-10))
|
||||
((:true 4) (:global-variable "true"))
|
||||
((:false 5) (:global-variable "false"))
|
||||
((:unique 6) (:semantic-keyword "unique"))
|
||||
))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; HTML STREAMS
|
||||
|
||||
(defstruct (html-stream (:include markup-stream)
|
||||
(:constructor allocate-html-stream (env head tail level logical-position enclosing-styles anchors))
|
||||
(:copier nil)
|
||||
(:predicate html-stream?))
|
||||
(enclosing-styles nil :type list :read-only t) ;A list of enclosing styles
|
||||
(anchors nil :type list :read-only t)) ;A mutable cons cell for accumulating anchors at the beginning of a paragraph
|
||||
; ;or nil if not inside a paragraph.
|
||||
|
||||
|
||||
(defmethod print-object ((html-stream html-stream) stream)
|
||||
(print-unreadable-object (html-stream stream :identity t)
|
||||
(write-string "html-stream" stream)))
|
||||
|
||||
|
||||
; Make a new, empty, open html-stream with the given definitions for its markup-env.
|
||||
(defun make-html-stream (markup-env level logical-position enclosing-styles anchors)
|
||||
(let ((head (list nil)))
|
||||
(allocate-html-stream markup-env head head level logical-position enclosing-styles anchors)))
|
||||
|
||||
|
||||
; Make a new, empty, open, top-level html-stream with the given definitions
|
||||
; for its markup-env. If links is true, allow links.
|
||||
(defun make-top-level-html-stream (html-definitions links)
|
||||
(let ((head (list nil))
|
||||
(markup-env (make-markup-env links)))
|
||||
(markup-env-define-alist markup-env html-definitions)
|
||||
(allocate-html-stream markup-env head head *markup-stream-top-level* nil nil nil)))
|
||||
|
||||
|
||||
; Return the approximate width of the html item; return t if it is a line break.
|
||||
; Also allow html tags as long as they do not contain line breaks.
|
||||
(defmethod markup-group-width ((html-stream html-stream) item)
|
||||
(if (consp item)
|
||||
(reduce #'+ (rest item) :key #'(lambda (subitem) (markup-group-width html-stream subitem)))
|
||||
(markup-width html-stream item)))
|
||||
|
||||
|
||||
; Create a top-level html-stream and call emitter to emit its contents.
|
||||
; emitter takes one argument -- an html-stream to which it should emit paragraphs.
|
||||
; Return the top-level html-stream. If links is true, allow links.
|
||||
(defun depict-html-top-level (title links emitter)
|
||||
(let ((html-stream (make-top-level-html-stream *html-definitions* links)))
|
||||
(markup-stream-append1 html-stream 'html)
|
||||
(depict-block-style (html-stream 'head)
|
||||
(depict-block-style (html-stream 'title)
|
||||
(markup-stream-append1 html-stream title))
|
||||
(markup-stream-append1 html-stream '((link (rel "stylesheet") (href "../styles.css"))))
|
||||
(markup-stream-append1 html-stream '((script (type "text/javascript") (language "JavaScript1.2") (src "../unicodeCompatibility.js")))))
|
||||
(depict-block-style (html-stream 'body)
|
||||
(funcall emitter html-stream))
|
||||
(let ((links (markup-env-links (html-stream-env html-stream))))
|
||||
(warn-missing-links links))
|
||||
html-stream))
|
||||
|
||||
|
||||
; Create a top-level html-stream and call emitter to emit its contents.
|
||||
; emitter takes one argument -- an html-stream to which it should emit paragraphs.
|
||||
; Write the resulting html to the text file with the given name (relative to the
|
||||
; local directory).
|
||||
; If links is true, allow links. If external-link-base is also provided, emit links for
|
||||
; predefined items and assume that they are located on the page specified by the
|
||||
; external-link-base string.
|
||||
(defun depict-html-to-local-file (filename title links emitter &key external-link-base)
|
||||
(let* ((*external-link-base* external-link-base)
|
||||
(top-html-stream (depict-html-top-level title links emitter)))
|
||||
(write-html-to-local-file filename (markup-stream-output top-html-stream)))
|
||||
filename)
|
||||
|
||||
|
||||
; Return the markup accumulated in the markup-stream after expanding all of its macros.
|
||||
; The markup-stream is closed after this function is called.
|
||||
(defmethod markup-stream-output ((html-stream html-stream))
|
||||
(coalesce-elements
|
||||
(unnest-html-source
|
||||
(markup-env-expand (markup-stream-env html-stream) (markup-stream-unexpanded-output html-stream) '(:none :nowrap :wrap :nest)))))
|
||||
|
||||
|
||||
|
||||
(defmethod depict-block-style-f ((html-stream html-stream) block-style flatten emitter)
|
||||
(assert-true (<= (markup-stream-level html-stream) *markup-stream-paragraph-level*))
|
||||
(assert-true (symbolp block-style))
|
||||
(if (or (null block-style)
|
||||
(and flatten (member block-style (html-stream-enclosing-styles html-stream))))
|
||||
(funcall emitter html-stream)
|
||||
(let ((inner-html-stream (make-html-stream (markup-stream-env html-stream)
|
||||
*markup-stream-paragraph-level*
|
||||
nil
|
||||
(cons block-style (html-stream-enclosing-styles html-stream))
|
||||
nil)))
|
||||
(markup-stream-append1 inner-html-stream block-style)
|
||||
(prog1
|
||||
(funcall emitter inner-html-stream)
|
||||
(let ((inner-output (markup-stream-unexpanded-output inner-html-stream)))
|
||||
(when (or (not flatten) (cdr inner-output))
|
||||
(markup-stream-append1 html-stream inner-output)))))))
|
||||
|
||||
|
||||
(defmethod depict-paragraph-f ((html-stream html-stream) paragraph-style emitter)
|
||||
(assert-true (= (markup-stream-level html-stream) *markup-stream-paragraph-level*))
|
||||
(assert-true (and paragraph-style (symbolp paragraph-style)))
|
||||
(let* ((anchors (list 'anchors))
|
||||
(inner-html-stream (make-html-stream (markup-stream-env html-stream)
|
||||
*markup-stream-content-level*
|
||||
(make-logical-position)
|
||||
(cons paragraph-style (html-stream-enclosing-styles html-stream))
|
||||
anchors)))
|
||||
(prog1
|
||||
(funcall emitter inner-html-stream)
|
||||
(markup-stream-append1 html-stream (cons paragraph-style
|
||||
(nreconc (cdr anchors)
|
||||
(markup-stream-unexpanded-output inner-html-stream)))))))
|
||||
|
||||
|
||||
(defmethod depict-char-style-f ((html-stream html-stream) char-style emitter)
|
||||
(assert-true (>= (markup-stream-level html-stream) *markup-stream-content-level*))
|
||||
(if char-style
|
||||
(progn
|
||||
(assert-true (symbolp char-style))
|
||||
(let ((inner-html-stream (make-html-stream (markup-stream-env html-stream)
|
||||
*markup-stream-content-level*
|
||||
(markup-stream-logical-position html-stream)
|
||||
(cons char-style (html-stream-enclosing-styles html-stream))
|
||||
(html-stream-anchors html-stream))))
|
||||
(markup-stream-append1 inner-html-stream char-style)
|
||||
(prog1
|
||||
(funcall emitter inner-html-stream)
|
||||
(markup-stream-append1 html-stream (markup-stream-unexpanded-output inner-html-stream)))))
|
||||
(funcall emitter html-stream)))
|
||||
|
||||
|
||||
(defmethod ensure-no-enclosing-style ((html-stream html-stream) style)
|
||||
(when (member style (html-stream-enclosing-styles html-stream))
|
||||
(cerror "Ignore" "Style ~S should not be in effect" style)))
|
||||
|
||||
|
||||
(defmethod save-block-style ((html-stream html-stream))
|
||||
(reverse (html-stream-enclosing-styles html-stream)))
|
||||
|
||||
|
||||
(defmethod with-saved-block-style-f ((html-stream html-stream) saved-block-style flatten emitter)
|
||||
(assert-true (<= (markup-stream-level html-stream) *markup-stream-paragraph-level*))
|
||||
(if (endp saved-block-style)
|
||||
(funcall emitter html-stream)
|
||||
(depict-block-style-f html-stream (first saved-block-style) flatten
|
||||
#'(lambda (html-stream)
|
||||
(with-saved-block-style-f html-stream (rest saved-block-style) flatten emitter)))))
|
||||
|
||||
|
||||
(defmethod depict-anchor ((html-stream html-stream) link-prefix link-name duplicate)
|
||||
(assert-true (= (markup-stream-level html-stream) *markup-stream-content-level*))
|
||||
(let* ((links (markup-env-links (html-stream-env html-stream)))
|
||||
(name (record-link-definition links link-prefix link-name duplicate)))
|
||||
(when name
|
||||
(push (list (list 'a (list 'name name))) (cdr (html-stream-anchors html-stream))))))
|
||||
|
||||
|
||||
(defmethod depict-link-reference-f ((html-stream html-stream) link-prefix link-name external emitter)
|
||||
(assert-true (= (markup-stream-level html-stream) *markup-stream-content-level*))
|
||||
(let* ((links (markup-env-links (html-stream-env html-stream)))
|
||||
(href (record-link-reference links link-prefix link-name external)))
|
||||
(if href
|
||||
(let ((inner-html-stream (make-html-stream (markup-stream-env html-stream)
|
||||
*markup-stream-content-level*
|
||||
(markup-stream-logical-position html-stream)
|
||||
(html-stream-enclosing-styles html-stream)
|
||||
(html-stream-anchors html-stream))))
|
||||
(markup-stream-append1 inner-html-stream (list 'a (list 'href href)))
|
||||
(prog1
|
||||
(funcall emitter inner-html-stream)
|
||||
(markup-stream-append1 html-stream (markup-stream-unexpanded-output inner-html-stream))))
|
||||
(funcall emitter html-stream))))
|
||||
|
||||
|
||||
#|
|
||||
(write-html
|
||||
'(html
|
||||
(head
|
||||
(:nowrap (title "This is my title!<>")))
|
||||
((body (atr1 "abc") (beta) (qq))
|
||||
"My page this is " (br) (p))))
|
||||
|#
|
||||
@@ -1,400 +0,0 @@
|
||||
;;;
|
||||
;;; Sample JavaScript 1.x grammar
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
(declaim (optimize (debug 3)))
|
||||
|
||||
(progn
|
||||
(defparameter *jw*
|
||||
(generate-world
|
||||
"J"
|
||||
'((grammar code-grammar :lr-1 :program)
|
||||
|
||||
(%section "Expressions")
|
||||
(grammar-argument :alpha normal initial)
|
||||
(grammar-argument :beta allow-in no-in)
|
||||
|
||||
(%subsection "Primary Expressions")
|
||||
(production (:primary-expression :alpha) (:simple-expression) primary-expression-simple-expression)
|
||||
(production (:primary-expression normal) (:function-expression) primary-expression-function-expression)
|
||||
(production (:primary-expression normal) (:object-literal) primary-expression-object-literal)
|
||||
|
||||
(production :simple-expression (this) simple-expression-this)
|
||||
(production :simple-expression (null) simple-expression-null)
|
||||
(production :simple-expression (true) simple-expression-true)
|
||||
(production :simple-expression (false) simple-expression-false)
|
||||
(production :simple-expression ($number) simple-expression-number)
|
||||
(production :simple-expression ($string) simple-expression-string)
|
||||
(production :simple-expression ($identifier) simple-expression-identifier)
|
||||
(production :simple-expression ($regular-expression) simple-expression-regular-expression)
|
||||
(production :simple-expression (:parenthesized-expression) simple-expression-parenthesized-expression)
|
||||
(production :simple-expression (:array-literal) simple-expression-array-literal)
|
||||
|
||||
(production :parenthesized-expression (\( (:expression normal allow-in) \)) parenthesized-expression-expression)
|
||||
|
||||
|
||||
(%subsection "Function Expressions")
|
||||
(production :function-expression (:anonymous-function) function-expression-anonymous-function)
|
||||
(production :function-expression (:named-function) function-expression-named-function)
|
||||
|
||||
|
||||
(%subsection "Object Literals")
|
||||
(production :object-literal (\{ \}) object-literal-empty)
|
||||
(production :object-literal (\{ :field-list \}) object-literal-list)
|
||||
|
||||
(production :field-list (:literal-field) field-list-one)
|
||||
(production :field-list (:field-list \, :literal-field) field-list-more)
|
||||
|
||||
(production :literal-field ($identifier \: (:assignment-expression normal allow-in)) literal-field-assignment-expression)
|
||||
|
||||
|
||||
(%subsection "Array Literals")
|
||||
(production :array-literal ([ ]) array-literal-empty)
|
||||
(production :array-literal ([ :element-list ]) array-literal-list)
|
||||
|
||||
(production :element-list (:literal-element) element-list-one)
|
||||
(production :element-list (:element-list \, :literal-element) element-list-more)
|
||||
|
||||
(production :literal-element ((:assignment-expression normal allow-in)) literal-element-assignment-expression)
|
||||
|
||||
|
||||
(%subsection "Left-Side Expressions")
|
||||
(production (:left-side-expression :alpha) ((:call-expression :alpha)) left-side-expression-call-expression)
|
||||
(production (:left-side-expression :alpha) (:short-new-expression) left-side-expression-short-new-expression)
|
||||
|
||||
(production (:call-expression :alpha) ((:primary-expression :alpha)) call-expression-primary-expression)
|
||||
(production (:call-expression :alpha) (:full-new-expression) call-expression-full-new-expression)
|
||||
(production (:call-expression :alpha) ((:call-expression :alpha) :member-operator) call-expression-member-operator)
|
||||
(production (:call-expression :alpha) ((:call-expression :alpha) :arguments) call-expression-call)
|
||||
|
||||
(production :full-new-expression (new :full-new-subexpression :arguments) full-new-expression-new)
|
||||
|
||||
(production :short-new-expression (new :short-new-subexpression) short-new-expression-new)
|
||||
|
||||
(production :full-new-subexpression ((:primary-expression normal)) full-new-subexpression-primary-expression)
|
||||
(production :full-new-subexpression (:full-new-expression) full-new-subexpression-full-new-expression)
|
||||
(production :full-new-subexpression (:full-new-subexpression :member-operator) full-new-subexpression-member-operator)
|
||||
|
||||
(production :short-new-subexpression (:full-new-subexpression) short-new-subexpression-new-full)
|
||||
(production :short-new-subexpression (:short-new-expression) short-new-subexpression-new-short)
|
||||
|
||||
(production :member-operator ([ (:expression normal allow-in) ]) member-operator-array)
|
||||
(production :member-operator (\. $identifier) member-operator-property)
|
||||
|
||||
(production :arguments (\( \)) arguments-empty)
|
||||
(production :arguments (\( :argument-list \)) arguments-list)
|
||||
|
||||
(production :argument-list ((:assignment-expression normal allow-in)) argument-list-one)
|
||||
(production :argument-list (:argument-list \, (:assignment-expression normal allow-in)) argument-list-more)
|
||||
|
||||
|
||||
(%subsection "Postfix Operators")
|
||||
(production (:postfix-expression :alpha) ((:left-side-expression :alpha)) postfix-expression-left-side-expression)
|
||||
(production (:postfix-expression :alpha) ((:left-side-expression :alpha) ++) postfix-expression-increment)
|
||||
(production (:postfix-expression :alpha) ((:left-side-expression :alpha) --) postfix-expression-decrement)
|
||||
|
||||
|
||||
(%subsection "Unary Operators")
|
||||
(production (:unary-expression :alpha) ((:postfix-expression :alpha)) unary-expression-postfix)
|
||||
(production (:unary-expression :alpha) (delete (:left-side-expression normal)) unary-expression-delete)
|
||||
(production (:unary-expression :alpha) (void (:unary-expression normal)) unary-expression-void)
|
||||
(production (:unary-expression :alpha) (typeof (:unary-expression normal)) unary-expression-typeof)
|
||||
(production (:unary-expression :alpha) (++ (:left-side-expression normal)) unary-expression-increment)
|
||||
(production (:unary-expression :alpha) (-- (:left-side-expression normal)) unary-expression-decrement)
|
||||
(production (:unary-expression :alpha) (+ (:unary-expression normal)) unary-expression-plus)
|
||||
(production (:unary-expression :alpha) (- (:unary-expression normal)) unary-expression-minus)
|
||||
(production (:unary-expression :alpha) (~ (:unary-expression normal)) unary-expression-bitwise-not)
|
||||
(production (:unary-expression :alpha) (! (:unary-expression normal)) unary-expression-logical-not)
|
||||
|
||||
|
||||
(%subsection "Multiplicative Operators")
|
||||
(production (:multiplicative-expression :alpha) ((:unary-expression :alpha)) multiplicative-expression-unary)
|
||||
(production (:multiplicative-expression :alpha) ((:multiplicative-expression :alpha) * (:unary-expression normal)) multiplicative-expression-multiply)
|
||||
(production (:multiplicative-expression :alpha) ((:multiplicative-expression :alpha) / (:unary-expression normal)) multiplicative-expression-divide)
|
||||
(production (:multiplicative-expression :alpha) ((:multiplicative-expression :alpha) % (:unary-expression normal)) multiplicative-expression-remainder)
|
||||
|
||||
|
||||
(%subsection "Additive Operators")
|
||||
(production (:additive-expression :alpha) ((:multiplicative-expression :alpha)) additive-expression-multiplicative)
|
||||
(production (:additive-expression :alpha) ((:additive-expression :alpha) + (:multiplicative-expression normal)) additive-expression-add)
|
||||
(production (:additive-expression :alpha) ((:additive-expression :alpha) - (:multiplicative-expression normal)) additive-expression-subtract)
|
||||
|
||||
|
||||
(%subsection "Bitwise Shift Operators")
|
||||
(production (:shift-expression :alpha) ((:additive-expression :alpha)) shift-expression-additive)
|
||||
(production (:shift-expression :alpha) ((:shift-expression :alpha) << (:additive-expression normal)) shift-expression-left)
|
||||
(production (:shift-expression :alpha) ((:shift-expression :alpha) >> (:additive-expression normal)) shift-expression-right-signed)
|
||||
(production (:shift-expression :alpha) ((:shift-expression :alpha) >>> (:additive-expression normal)) shift-expression-right-unsigned)
|
||||
|
||||
|
||||
(%subsection "Relational Operators")
|
||||
(exclude (:relational-expression initial no-in))
|
||||
(production (:relational-expression :alpha :beta) ((:shift-expression :alpha)) relational-expression-shift)
|
||||
(production (:relational-expression :alpha :beta) ((:relational-expression :alpha :beta) < (:shift-expression normal)) relational-expression-less)
|
||||
(production (:relational-expression :alpha :beta) ((:relational-expression :alpha :beta) > (:shift-expression normal)) relational-expression-greater)
|
||||
(production (:relational-expression :alpha :beta) ((:relational-expression :alpha :beta) <= (:shift-expression normal)) relational-expression-less-or-equal)
|
||||
(production (:relational-expression :alpha :beta) ((:relational-expression :alpha :beta) >= (:shift-expression normal)) relational-expression-greater-or-equal)
|
||||
(production (:relational-expression :alpha :beta) ((:relational-expression :alpha :beta) instanceof (:shift-expression normal)) relational-expression-instanceof)
|
||||
(production (:relational-expression :alpha allow-in) ((:relational-expression :alpha allow-in) in (:shift-expression normal)) relational-expression-in)
|
||||
|
||||
|
||||
(%subsection "Equality Operators")
|
||||
(exclude (:equality-expression initial no-in))
|
||||
(production (:equality-expression :alpha :beta) ((:relational-expression :alpha :beta)) equality-expression-relational)
|
||||
(production (:equality-expression :alpha :beta) ((:equality-expression :alpha :beta) == (:relational-expression normal :beta)) equality-expression-equal)
|
||||
(production (:equality-expression :alpha :beta) ((:equality-expression :alpha :beta) != (:relational-expression normal :beta)) equality-expression-not-equal)
|
||||
(production (:equality-expression :alpha :beta) ((:equality-expression :alpha :beta) === (:relational-expression normal :beta)) equality-expression-strict-equal)
|
||||
(production (:equality-expression :alpha :beta) ((:equality-expression :alpha :beta) !== (:relational-expression normal :beta)) equality-expression-strict-not-equal)
|
||||
|
||||
|
||||
(%subsection "Binary Bitwise Operators")
|
||||
(exclude (:bitwise-and-expression initial no-in))
|
||||
(production (:bitwise-and-expression :alpha :beta) ((:equality-expression :alpha :beta)) bitwise-and-expression-equality)
|
||||
(production (:bitwise-and-expression :alpha :beta) ((:bitwise-and-expression :alpha :beta) & (:equality-expression normal :beta)) bitwise-and-expression-and)
|
||||
|
||||
(exclude (:bitwise-xor-expression initial no-in))
|
||||
(production (:bitwise-xor-expression :alpha :beta) ((:bitwise-and-expression :alpha :beta)) bitwise-xor-expression-bitwise-and)
|
||||
(production (:bitwise-xor-expression :alpha :beta) ((:bitwise-xor-expression :alpha :beta) ^ (:bitwise-and-expression normal :beta)) bitwise-xor-expression-xor)
|
||||
|
||||
(exclude (:bitwise-or-expression initial no-in))
|
||||
(production (:bitwise-or-expression :alpha :beta) ((:bitwise-xor-expression :alpha :beta)) bitwise-or-expression-bitwise-xor)
|
||||
(production (:bitwise-or-expression :alpha :beta) ((:bitwise-or-expression :alpha :beta) \| (:bitwise-xor-expression normal :beta)) bitwise-or-expression-or)
|
||||
|
||||
|
||||
(%subsection "Binary Logical Operators")
|
||||
(exclude (:logical-and-expression initial no-in))
|
||||
(production (:logical-and-expression :alpha :beta) ((:bitwise-or-expression :alpha :beta)) logical-and-expression-bitwise-or)
|
||||
(production (:logical-and-expression :alpha :beta) ((:logical-and-expression :alpha :beta) && (:bitwise-or-expression normal :beta)) logical-and-expression-and)
|
||||
|
||||
(exclude (:logical-or-expression initial no-in))
|
||||
(production (:logical-or-expression :alpha :beta) ((:logical-and-expression :alpha :beta)) logical-or-expression-logical-and)
|
||||
(production (:logical-or-expression :alpha :beta) ((:logical-or-expression :alpha :beta) \|\| (:logical-and-expression normal :beta)) logical-or-expression-or)
|
||||
|
||||
|
||||
(%subsection "Conditional Operator")
|
||||
(exclude (:conditional-expression initial no-in))
|
||||
(production (:conditional-expression :alpha :beta) ((:logical-or-expression :alpha :beta)) conditional-expression-logical-or)
|
||||
(production (:conditional-expression :alpha :beta) ((:logical-or-expression :alpha :beta) ? (:assignment-expression normal :beta) \: (:assignment-expression normal :beta)) conditional-expression-conditional)
|
||||
|
||||
|
||||
(%subsection "Assignment Operators")
|
||||
(exclude (:assignment-expression initial no-in))
|
||||
(production (:assignment-expression :alpha :beta) ((:conditional-expression :alpha :beta)) assignment-expression-conditional)
|
||||
(production (:assignment-expression :alpha :beta) ((:left-side-expression :alpha) = (:assignment-expression normal :beta)) assignment-expression-assignment)
|
||||
(production (:assignment-expression :alpha :beta) ((:left-side-expression :alpha) :compound-assignment (:assignment-expression normal :beta)) assignment-expression-compound)
|
||||
|
||||
(production :compound-assignment (*=) compound-assignment-multiply)
|
||||
(production :compound-assignment (/=) compound-assignment-divide)
|
||||
(production :compound-assignment (%=) compound-assignment-remainder)
|
||||
(production :compound-assignment (+=) compound-assignment-add)
|
||||
(production :compound-assignment (-=) compound-assignment-subtract)
|
||||
(production :compound-assignment (<<=) compound-assignment-shift-left)
|
||||
(production :compound-assignment (>>=) compound-assignment-shift-right)
|
||||
(production :compound-assignment (>>>=) compound-assignment-shift-right-unsigned)
|
||||
(production :compound-assignment (&=) compound-assignment-and)
|
||||
(production :compound-assignment (^=) compound-assignment-or)
|
||||
(production :compound-assignment (\|=) compound-assignment-xor)
|
||||
|
||||
|
||||
(%subsection "Expressions")
|
||||
(exclude (:expression initial no-in))
|
||||
(production (:expression :alpha :beta) ((:assignment-expression :alpha :beta)) expression-assignment)
|
||||
(production (:expression :alpha :beta) ((:expression :alpha :beta) \, (:assignment-expression normal :beta)) expression-comma)
|
||||
|
||||
(production :optional-expression ((:expression normal allow-in)) optional-expression-expression)
|
||||
(production :optional-expression () optional-expression-empty)
|
||||
|
||||
|
||||
(%section "Statements")
|
||||
|
||||
(grammar-argument :omega
|
||||
no-short-if ;optional semicolon, but statement must not end with an if without an else
|
||||
full) ;semicolon required at the end
|
||||
|
||||
(production (:statement :omega) (:empty-statement) statement-empty-statement)
|
||||
(production (:statement :omega) (:expression-statement :optional-semicolon) statement-expression-statement)
|
||||
(production (:statement :omega) (:variable-definition :optional-semicolon) statement-variable-definition)
|
||||
(production (:statement :omega) (:block) statement-block)
|
||||
(production (:statement :omega) ((:labeled-statement :omega)) statement-labeled-statement)
|
||||
(production (:statement :omega) ((:if-statement :omega)) statement-if-statement)
|
||||
(production (:statement :omega) (:switch-statement) statement-switch-statement)
|
||||
(production (:statement :omega) (:do-statement :optional-semicolon) statement-do-statement)
|
||||
(production (:statement :omega) ((:while-statement :omega)) statement-while-statement)
|
||||
(production (:statement :omega) ((:for-statement :omega)) statement-for-statement)
|
||||
(production (:statement :omega) ((:with-statement :omega)) statement-with-statement)
|
||||
(production (:statement :omega) (:continue-statement :optional-semicolon) statement-continue-statement)
|
||||
(production (:statement :omega) (:break-statement :optional-semicolon) statement-break-statement)
|
||||
(production (:statement :omega) (:return-statement :optional-semicolon) statement-return-statement)
|
||||
(production (:statement :omega) (:throw-statement :optional-semicolon) statement-throw-statement)
|
||||
(production (:statement :omega) (:try-statement) statement-try-statement)
|
||||
|
||||
(production :optional-semicolon (\;) optional-semicolon-semicolon)
|
||||
|
||||
|
||||
(%subsection "Empty Statement")
|
||||
(production :empty-statement (\;) empty-statement-semicolon)
|
||||
|
||||
|
||||
(%subsection "Expression Statement")
|
||||
(production :expression-statement ((:expression initial allow-in)) expression-statement-expression)
|
||||
|
||||
|
||||
(%subsection "Variable Definition")
|
||||
(production :variable-definition (var (:variable-declaration-list allow-in)) variable-definition-declaration)
|
||||
|
||||
(production (:variable-declaration-list :beta) ((:variable-declaration :beta)) variable-declaration-list-one)
|
||||
(production (:variable-declaration-list :beta) ((:variable-declaration-list :beta) \, (:variable-declaration :beta)) variable-declaration-list-more)
|
||||
|
||||
(production (:variable-declaration :beta) ($identifier (:variable-initializer :beta)) variable-declaration-initializer)
|
||||
|
||||
(production (:variable-initializer :beta) () variable-initializer-empty)
|
||||
(production (:variable-initializer :beta) (= (:assignment-expression normal :beta)) variable-initializer-assignment-expression)
|
||||
|
||||
|
||||
(%subsection "Block")
|
||||
(production :block ({ :block-statements }) block-block-statements)
|
||||
|
||||
(production :block-statements () block-statements-one)
|
||||
(production :block-statements (:block-statements-prefix) block-statements-more)
|
||||
|
||||
(production :block-statements-prefix ((:statement full)) block-statements-prefix-one)
|
||||
(production :block-statements-prefix (:block-statements-prefix (:statement full)) block-statements-prefix-more)
|
||||
|
||||
|
||||
(%subsection "Labeled Statements")
|
||||
(production (:labeled-statement :omega) ($identifier \: (:statement :omega)) labeled-statement-label)
|
||||
|
||||
|
||||
(%subsection "If Statement")
|
||||
(production (:if-statement full) (if :parenthesized-expression (:statement full)) if-statement-if-then-full)
|
||||
(production (:if-statement :omega) (if :parenthesized-expression (:statement no-short-if)
|
||||
else (:statement :omega)) if-statement-if-then-else)
|
||||
|
||||
|
||||
(%subsection "Switch Statement")
|
||||
(production :switch-statement (switch :parenthesized-expression { }) switch-statement-empty)
|
||||
(production :switch-statement (switch :parenthesized-expression { :case-groups :last-case-group }) switch-statement-cases)
|
||||
|
||||
(production :case-groups () case-groups-empty)
|
||||
(production :case-groups (:case-groups :case-group) case-groups-more)
|
||||
|
||||
(production :case-group (:case-guards :block-statements-prefix) case-group-block-statements-prefix)
|
||||
|
||||
(production :last-case-group (:case-guards :block-statements) last-case-group-block-statements)
|
||||
|
||||
(production :case-guards (:case-guard) case-guards-one)
|
||||
(production :case-guards (:case-guards :case-guard) case-guards-more)
|
||||
|
||||
(production :case-guard (case (:expression normal allow-in) \:) case-guard-case)
|
||||
(production :case-guard (default \:) case-guard-default)
|
||||
|
||||
|
||||
(%subsection "Do-While Statement")
|
||||
(production :do-statement (do (:statement full) while :parenthesized-expression) do-statement-do-while)
|
||||
|
||||
|
||||
(%subsection "While Statement")
|
||||
(production (:while-statement :omega) (while :parenthesized-expression (:statement :omega)) while-statement-while)
|
||||
|
||||
|
||||
(%subsection "For Statements")
|
||||
(production (:for-statement :omega) (for \( :for-initializer \; :optional-expression \; :optional-expression \)
|
||||
(:statement :omega)) for-statement-c-style)
|
||||
(production (:for-statement :omega) (for \( :for-in-binding in (:expression normal allow-in) \) (:statement :omega)) for-statement-in)
|
||||
|
||||
(production :for-initializer () for-initializer-empty)
|
||||
(production :for-initializer ((:expression normal no-in)) for-initializer-expression)
|
||||
(production :for-initializer (var (:variable-declaration-list no-in)) for-initializer-variable-declaration)
|
||||
|
||||
(production :for-in-binding ((:left-side-expression normal)) for-in-binding-expression)
|
||||
(production :for-in-binding (var (:variable-declaration no-in)) for-in-binding-variable-declaration)
|
||||
|
||||
|
||||
(%subsection "With Statement")
|
||||
(production (:with-statement :omega) (with :parenthesized-expression (:statement :omega)) with-statement-with)
|
||||
|
||||
|
||||
(%subsection "Continue and Break Statements")
|
||||
(production :continue-statement (continue :optional-label) continue-statement-optional-label)
|
||||
|
||||
(production :break-statement (break :optional-label) break-statement-optional-label)
|
||||
|
||||
(production :optional-label () optional-label-default)
|
||||
(production :optional-label ($identifier) optional-label-identifier)
|
||||
|
||||
|
||||
(%subsection "Return Statement")
|
||||
(production :return-statement (return :optional-expression) return-statement-optional-expression)
|
||||
|
||||
|
||||
(%subsection "Throw Statement")
|
||||
(production :throw-statement (throw (:expression normal allow-in)) throw-statement-throw)
|
||||
|
||||
|
||||
(%subsection "Try Statement")
|
||||
(production :try-statement (try :block :catch-clauses) try-statement-catch-clauses)
|
||||
(production :try-statement (try :block :finally-clause) try-statement-finally-clause)
|
||||
(production :try-statement (try :block :catch-clauses :finally-clause) try-statement-catch-clauses-finally-clause)
|
||||
|
||||
(production :catch-clauses (:catch-clause) catch-clauses-one)
|
||||
(production :catch-clauses (:catch-clauses :catch-clause) catch-clauses-more)
|
||||
|
||||
(production :catch-clause (catch \( $identifier \) :block) catch-clause-block)
|
||||
|
||||
(production :finally-clause (finally :block) finally-clause-block)
|
||||
|
||||
|
||||
(%subsection "Function Definition")
|
||||
(production :function-definition (:named-function) function-definition-named-function)
|
||||
|
||||
(production :anonymous-function (function :formal-parameters-and-body) anonymous-function-formal-parameters-and-body)
|
||||
|
||||
(production :named-function (function $identifier :formal-parameters-and-body) named-function-formal-parameters-and-body)
|
||||
|
||||
(production :formal-parameters-and-body (\( :formal-parameters \) { :top-statements }) formal-parameters-and-body)
|
||||
|
||||
(production :formal-parameters () formal-parameters-none)
|
||||
(production :formal-parameters (:formal-parameters-prefix) formal-parameters-some)
|
||||
|
||||
(production :formal-parameters-prefix (:formal-parameter) formal-parameters-prefix-one)
|
||||
(production :formal-parameters-prefix (:formal-parameters-prefix \, :formal-parameter) formal-parameters-prefix-more)
|
||||
|
||||
(production :formal-parameter ($identifier) formal-parameter-identifier)
|
||||
|
||||
|
||||
(%section "Programs")
|
||||
|
||||
(production :program (:top-statements) program)
|
||||
|
||||
(production :top-statements () top-statements-one)
|
||||
(production :top-statements (:top-statements-prefix) top-statements-more)
|
||||
|
||||
(production :top-statements-prefix (:top-statement) top-statements-prefix-one)
|
||||
(production :top-statements-prefix (:top-statements-prefix :top-statement) top-statements-prefix-more)
|
||||
|
||||
(production :top-statement ((:statement full)) top-statement-statement)
|
||||
(production :top-statement (:function-definition) top-statement-function-definition)
|
||||
)))
|
||||
|
||||
(defparameter *jg* (world-grammar *jw* 'code-grammar))
|
||||
(length (grammar-states *jg*)))
|
||||
|
||||
|
||||
#|
|
||||
(depict-rtf-to-local-file
|
||||
"JS14/ParserGrammar.rtf"
|
||||
"JavaScript 1.4 Parser Grammar"
|
||||
#'(lambda (markup-stream)
|
||||
(depict-world-commands markup-stream *jw* :visible-semantics nil)))
|
||||
|
||||
(depict-html-to-local-file
|
||||
"JS14/ParserGrammar.html"
|
||||
"JavaScript 1.4 Parser Grammar"
|
||||
t
|
||||
#'(lambda (markup-stream)
|
||||
(depict-world-commands markup-stream *jw* :visible-semantics nil)))
|
||||
|
||||
(with-local-output (s "JS14/ParserGrammar.txt") (print-grammar *jg* s))
|
||||
|#
|
||||
@@ -1,179 +0,0 @@
|
||||
|
||||
(defun js-state-transition (action-results)
|
||||
(assert-type action-results (tuple t bool))
|
||||
(values action-results (if (second action-results) '($re) '($non-re))))
|
||||
|
||||
(defun js-metaparse (string &key trace)
|
||||
(lexer-metaparse *ll* string :initial-state '($re) :state-transition #'js-state-transition :trace trace))
|
||||
|
||||
(defun js-pmetaparse (string &key (stream t) trace)
|
||||
(lexer-pmetaparse *ll* string :initial-state '($re) :state-transition #'js-state-transition :stream stream :trace trace))
|
||||
|
||||
|
||||
; Convert the results of the lexer's actions into a token suitable for the parser.
|
||||
(defun js-lexer-results-to-token (token-value line-break)
|
||||
(multiple-value-bind (token token-arg)
|
||||
(ecase (car token-value)
|
||||
(identifier (values '$identifier (cdr token-value)))
|
||||
((keyword punctuator) (values (intern (string-upcase (cdr token-value))) nil))
|
||||
(number (values '$number (cdr token-value)))
|
||||
(string (values '$string (cdr token-value)))
|
||||
(regular-expression (values '$regular-expression (cdr token-value)))
|
||||
(end (setq line-break nil) *end-marker*))
|
||||
(when line-break
|
||||
(setq token (terminal-lf-terminal token)))
|
||||
(values token token-arg)))
|
||||
|
||||
|
||||
; Lex and parse the input-string of tokens to produce a list of action results.
|
||||
; If trace is:
|
||||
; nil, don't print trace information
|
||||
; :code, print trace information, including action code
|
||||
; :lexer, print lexer trace information
|
||||
; :lexer-code print lexer trace information, including action code
|
||||
; other print trace information
|
||||
; Return three values:
|
||||
; the list of action results;
|
||||
; the list of action results' types;
|
||||
; the list of processed tokens.
|
||||
(defun js-parse (input-string &key (lexer *ll*) (grammar *jg*) trace)
|
||||
(let ((lexer-classifier (lexer-classifier lexer))
|
||||
(lexer-metagrammar (lexer-metagrammar lexer))
|
||||
(lexer-trace (cdr (assoc trace '((:lexer t) (:lexer-code :code)))))
|
||||
(state-stack (list (grammar-start-state grammar)))
|
||||
(value-stack nil)
|
||||
(type-stack nil)
|
||||
(prev-number-token nil)
|
||||
(input (append (coerce input-string 'list) '($end)))
|
||||
(token nil)
|
||||
(token-arg nil)
|
||||
(token2 nil)
|
||||
(token2-arg nil)
|
||||
(token-history nil))
|
||||
(flet
|
||||
((get-next-token-value (lexer-state)
|
||||
(multiple-value-bind (results in-rest)
|
||||
(action-metaparse lexer-metagrammar lexer-classifier (cons lexer-state input) :trace lexer-trace)
|
||||
(assert-true (null (cdr results)))
|
||||
(setq input in-rest)
|
||||
(car results))))
|
||||
|
||||
(loop
|
||||
(let* ((state (car state-stack))
|
||||
(transition (state-only-transition state)))
|
||||
(unless transition
|
||||
(unless token
|
||||
(if token2
|
||||
(setq token token2
|
||||
token-arg token2-arg
|
||||
token2 nil
|
||||
token2-arg nil)
|
||||
(let* ((lexer-state (cond
|
||||
(prev-number-token '$unit)
|
||||
((or (state-transition state '/) (state-transition state '/=)) '$non-re)
|
||||
(t '$re)))
|
||||
(token-value (get-next-token-value lexer-state))
|
||||
(line-break nil))
|
||||
(when (eq (car token-value) 'line-break)
|
||||
(when (eq lexer-state '$unit)
|
||||
(setq lexer-state '$non-re))
|
||||
(setq token-value (get-next-token-value lexer-state))
|
||||
(setq line-break t))
|
||||
(setq prev-number-token (eq (car token-value) 'number))
|
||||
(multiple-value-setq (token token-arg) (js-lexer-results-to-token token-value line-break)))))
|
||||
(setq transition (state-transition state token))
|
||||
(unless transition
|
||||
(when (lf-terminal? token)
|
||||
(setq transition (state-transition state '$virtual-semicolon)))
|
||||
(if transition
|
||||
(progn
|
||||
(when trace
|
||||
(format *trace-output* "Inserted virtual semicolon~@:_"))
|
||||
(setq token2 token
|
||||
token2-arg token-arg
|
||||
token '$virtual-semicolon
|
||||
token-arg nil))
|
||||
(error "Parse error on ~S followed by ~S ..." token (coerce (butlast (ldiff input (nthcdr 31 input))) 'string)))))
|
||||
|
||||
(when trace
|
||||
(format *trace-output* "S~D: ~@_" (state-number state))
|
||||
(print-values (reverse value-stack) (reverse type-stack) *trace-output*)
|
||||
(pprint-newline :mandatory *trace-output*))
|
||||
|
||||
(ecase (transition-kind transition)
|
||||
(:shift
|
||||
(push (if token-arg (cons token token-arg) token) token-history)
|
||||
(when trace
|
||||
(format *trace-output* " shift ~W ~W~:@_" token token-arg)
|
||||
(dolist (action-signature (grammar-symbol-signature grammar token))
|
||||
(push (cdr action-signature) type-stack)))
|
||||
(dolist (action-function-binding (gethash token (grammar-terminal-actions grammar)))
|
||||
(push (funcall (cdr action-function-binding) token-arg) value-stack))
|
||||
(push (transition-state transition) state-stack)
|
||||
(setq token nil))
|
||||
|
||||
(:reduce
|
||||
(let ((production (transition-production transition)))
|
||||
(when trace
|
||||
(write-string " reduce " *trace-output*)
|
||||
(if (eq trace :code)
|
||||
(write production :stream *trace-output* :pretty t)
|
||||
(print-production production *trace-output*))
|
||||
(pprint-newline :mandatory *trace-output*))
|
||||
(setq state-stack (nthcdr (production-rhs-length production) state-stack)
|
||||
state (assert-non-null
|
||||
(cdr (assoc (production-lhs production) (state-gotos (car state-stack)) :test *grammar-symbol-=*)))
|
||||
value-stack (funcall (production-evaluator production) value-stack))
|
||||
(push state state-stack)
|
||||
(when trace
|
||||
(setq type-stack (nthcdr (production-n-action-args production) type-stack))
|
||||
(dolist (action-signature (grammar-symbol-signature grammar (production-lhs production)))
|
||||
(push (cdr action-signature) type-stack)))))
|
||||
|
||||
(:accept
|
||||
(when trace
|
||||
(format *trace-output* " accept~:@_"))
|
||||
(return (values
|
||||
(nreverse value-stack)
|
||||
(if trace
|
||||
(nreverse type-stack)
|
||||
(grammar-user-start-action-types grammar))
|
||||
(nreverse token-history)))))
|
||||
(when trace
|
||||
(format *trace-output* "!")))))))
|
||||
|
||||
|
||||
; Simple JS2 read-eval-print loop.
|
||||
(defun rep ()
|
||||
(loop
|
||||
(let ((s (read-line *terminal-io* t)))
|
||||
(format *terminal-io* "<~S>~%" s)
|
||||
(dolist (r (multiple-value-list (js-parse s)))
|
||||
(write r :stream *terminal-io* :pretty t)
|
||||
(terpri *terminal-io*)))))
|
||||
|
||||
|
||||
#|
|
||||
(js-parse "1+2*/4*/
|
||||
32")
|
||||
(js-parse "32+abc//23e-a4*7e-2 3 id4 4ef;")
|
||||
|
||||
(js-parse "0x20")
|
||||
(js-parse "2b")
|
||||
(js-parse " 3.75" :trace t)
|
||||
(js-parse "25" :trace :code)
|
||||
(js-parse "32+abc//23e-a4*7e-2 3 id4 4ef;")
|
||||
(js-parse "32+abc//23e-a4*7e-2 3 id4 4ef;
|
||||
")
|
||||
(js-parse "32+abc/ /23e-a4*7e-2 3 /*id4 4*-/ef;
|
||||
|
||||
fjds*/y//z")
|
||||
(js-parse "3a+in'a+b\\147\"de'\"'\"")
|
||||
(js-parse "3*/regexp*///x")
|
||||
(js-parse "/regexp*///x")
|
||||
(js-parse "if \\x69f \\u0069f")
|
||||
(js-parse "if \\x69f z\\x20z")
|
||||
(js-parse "3lbs,3in,3 in 3_in,3_lbs")
|
||||
(js-parse "3a+b in'a+b\\040\\077\\700\\150\\15A\\69\"de'\"'\"")
|
||||
|#
|
||||
|
||||
@@ -1,567 +0,0 @@
|
||||
;;;
|
||||
;;; JavaScript 2.0 lexer
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
|
||||
(progn
|
||||
(defparameter *lw*
|
||||
(generate-world
|
||||
"L"
|
||||
'((lexer code-lexer
|
||||
:lalr-1
|
||||
:$next-input-element
|
||||
((:unicode-character (% every (:text "Any Unicode character")) () t)
|
||||
(:unicode-initial-alphabetic
|
||||
(% initial-alpha (:text "Any Unicode initial alphabetic character (includes ASCII "
|
||||
(:character-literal #\A) :nbhy (:character-literal #\Z) " and "
|
||||
(:character-literal #\a) :nbhy (:character-literal #\z) ")"))
|
||||
() t)
|
||||
(:unicode-alphanumeric
|
||||
(% alphanumeric (:text "Any Unicode alphabetic or decimal digit character (includes ASCII "
|
||||
(:character-literal #\0) :nbhy (:character-literal #\9) ", "
|
||||
(:character-literal #\A) :nbhy (:character-literal #\Z) ", and "
|
||||
(:character-literal #\a) :nbhy (:character-literal #\z) ")"))
|
||||
() t)
|
||||
(:white-space-character (++ (#?0009 #?000B #?000C #\space #?00A0)
|
||||
(#?2000 #?2001 #?2002 #?2003 #?2004 #?2005 #?2006 #?2007)
|
||||
(#?2008 #?2009 #?200A #?200B)
|
||||
(#?3000)) ())
|
||||
(:line-terminator (#?000A #?000D #?2028 #?2029) ())
|
||||
(:non-terminator (- :unicode-character :line-terminator)
|
||||
(($default-action $default-action)))
|
||||
(:non-terminator-or-slash (- :non-terminator (#\/)) ())
|
||||
(:non-terminator-or-asterisk-or-slash (- :non-terminator (#\* #\/)) ())
|
||||
(:initial-identifier-character (+ :unicode-initial-alphabetic (#\$ #\_))
|
||||
(($default-action $default-action)))
|
||||
(:continuing-identifier-character (+ :unicode-alphanumeric (#\$ #\_))
|
||||
(($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)))
|
||||
(:non-zero-digit (#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
|
||||
((decimal-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)))
|
||||
(:letter-e (#\E #\e) (($default-action $default-action)))
|
||||
(:letter-x (#\X #\x) (($default-action $default-action)))
|
||||
((:literal-string-char single) (- :unicode-character (+ (#\' #\\) :line-terminator))
|
||||
(($default-action $default-action)))
|
||||
((:literal-string-char double) (- :unicode-character (+ (#\" #\\) :line-terminator))
|
||||
(($default-action $default-action)))
|
||||
(:identity-escape (- :non-terminator (+ (#\_) :unicode-alphanumeric))
|
||||
(($default-action $default-action)))
|
||||
(:ordinary-reg-exp-char (- :non-terminator (#\\ #\/))
|
||||
(($default-action $default-action))))
|
||||
(($default-action character nil identity)
|
||||
($digit-value integer digit-value digit-char-36)))
|
||||
|
||||
(rule :$next-input-element
|
||||
((input-element input-element))
|
||||
(production :$next-input-element ($unit (:next-input-element unit)) $next-input-element-unit
|
||||
(input-element (input-element :next-input-element)))
|
||||
(production :$next-input-element ($re (:next-input-element re)) $next-input-element-re
|
||||
(input-element (input-element :next-input-element)))
|
||||
(production :$next-input-element ($non-re (:next-input-element div)) $next-input-element-non-re
|
||||
(input-element (input-element :next-input-element))))
|
||||
|
||||
(%text nil "The start symbols are: "
|
||||
(:grammar-symbol (:next-input-element unit)) " if the previous input element was a number; "
|
||||
(:grammar-symbol (:next-input-element re)) " if the previous input-element was not a number and a "
|
||||
(:character-literal #\/) " should be interpreted as a regular expression; and "
|
||||
(:grammar-symbol (:next-input-element div)) " if the previous input-element was not a number and a "
|
||||
(:character-literal #\/) " should be interpreted as a division or division-assignment operator.")
|
||||
|
||||
(deftype semantic-exception (oneof syntax-error))
|
||||
|
||||
(%section "Unicode Character Classes")
|
||||
(%charclass :unicode-character)
|
||||
(%charclass :unicode-initial-alphabetic)
|
||||
(%charclass :unicode-alphanumeric)
|
||||
(%charclass :white-space-character)
|
||||
(%charclass :line-terminator)
|
||||
(%charclass :a-s-c-i-i-digit)
|
||||
(%print-actions)
|
||||
|
||||
(%section "Comments")
|
||||
(production :line-comment (#\/ #\/ :line-comment-characters) line-comment)
|
||||
|
||||
(production :line-comment-characters () line-comment-characters-empty)
|
||||
(production :line-comment-characters (:line-comment-characters :non-terminator) line-comment-characters-chars)
|
||||
|
||||
(%charclass :non-terminator)
|
||||
|
||||
(production :single-line-block-comment (#\/ #\* :block-comment-characters #\* #\/) single-line-block-comment)
|
||||
|
||||
(production :block-comment-characters () block-comment-characters-empty)
|
||||
(production :block-comment-characters (:block-comment-characters :non-terminator-or-slash) block-comment-characters-chars)
|
||||
(production :block-comment-characters (:pre-slash-characters #\/) block-comment-characters-slash)
|
||||
|
||||
(production :pre-slash-characters () pre-slash-characters-empty)
|
||||
(production :pre-slash-characters (:block-comment-characters :non-terminator-or-asterisk-or-slash) pre-slash-characters-chars)
|
||||
(production :pre-slash-characters (:pre-slash-characters #\/) pre-slash-characters-slash)
|
||||
|
||||
(%charclass :non-terminator-or-slash)
|
||||
(%charclass :non-terminator-or-asterisk-or-slash)
|
||||
|
||||
(production :multi-line-block-comment (#\/ #\* :multi-line-block-comment-characters :block-comment-characters #\* #\/) multi-line-block-comment)
|
||||
|
||||
(production :multi-line-block-comment-characters (:block-comment-characters :line-terminator) multi-line-block-comment-characters-first)
|
||||
(production :multi-line-block-comment-characters (:multi-line-block-comment-characters :block-comment-characters :line-terminator)
|
||||
multi-line-block-comment-characters-rest)
|
||||
(%print-actions)
|
||||
|
||||
(%section "White space")
|
||||
|
||||
(production :white-space () white-space-empty)
|
||||
(production :white-space (:white-space :white-space-character) white-space-character)
|
||||
(production :white-space (:white-space :single-line-block-comment) white-space-single-line-block-comment)
|
||||
|
||||
(%section "Line breaks")
|
||||
|
||||
(production :line-break (:line-terminator) line-break-line-terminator)
|
||||
(production :line-break (:line-comment :line-terminator) line-break-line-comment)
|
||||
(production :line-break (:multi-line-block-comment) line-break-multi-line-block-comment)
|
||||
|
||||
(production :line-breaks (:line-break) line-breaks-first)
|
||||
(production :line-breaks (:line-breaks :white-space :line-break) line-breaks-rest)
|
||||
|
||||
(%section "Input elements")
|
||||
|
||||
(grammar-argument :nu re div unit)
|
||||
(grammar-argument :nu_2 re div)
|
||||
|
||||
(rule (:next-input-element :nu)
|
||||
((input-element input-element))
|
||||
(production (:next-input-element re) (:white-space (:input-element re)) next-input-element-re
|
||||
(input-element (input-element :input-element)))
|
||||
(production (:next-input-element div) (:white-space (:input-element div)) next-input-element-div
|
||||
(input-element (input-element :input-element)))
|
||||
(production (:next-input-element unit) ((:- :continuing-identifier-character #\\) :white-space (:input-element div)) next-input-element-unit-normal
|
||||
(input-element (input-element :input-element)))
|
||||
(production (:next-input-element unit) ((:- #\_) :identifier-name) next-input-element-unit-name
|
||||
(input-element (oneof string (name :identifier-name))))
|
||||
(production (:next-input-element unit) (#\_ :identifier-name) next-input-element-unit-underscore-name
|
||||
(input-element (oneof string (name :identifier-name)))))
|
||||
|
||||
(%print-actions)
|
||||
|
||||
(rule (:input-element :nu_2)
|
||||
((input-element input-element))
|
||||
(production (:input-element :nu_2) (:line-breaks) input-element-line-breaks
|
||||
(input-element (oneof line-break)))
|
||||
(production (:input-element :nu_2) (:identifier-or-keyword) input-element-identifier-or-keyword
|
||||
(input-element (input-element :identifier-or-keyword)))
|
||||
(production (:input-element :nu_2) (:punctuator) input-element-punctuator
|
||||
(input-element (oneof punctuator (punctuator :punctuator))))
|
||||
(production (:input-element div) (:division-punctuator) input-element-division-punctuator
|
||||
(input-element (oneof punctuator (punctuator :division-punctuator))))
|
||||
(production (:input-element :nu_2) (:numeric-literal) input-element-numeric-literal
|
||||
(input-element (oneof number (float64-value :numeric-literal))))
|
||||
(production (:input-element :nu_2) (:string-literal) input-element-string-literal
|
||||
(input-element (oneof string (string-value :string-literal))))
|
||||
(production (:input-element re) (:reg-exp-literal) input-element-reg-exp-literal
|
||||
(input-element (oneof regular-expression (r-e-value :reg-exp-literal))))
|
||||
(production (:input-element :nu_2) (:end-of-input) input-element-end
|
||||
(input-element (oneof end))))
|
||||
|
||||
(production :end-of-input ($end) end-of-input-end)
|
||||
(production :end-of-input (:line-comment $end) end-of-input-line-comment)
|
||||
|
||||
(deftype reg-exp (tuple (re-body string)
|
||||
(re-flags string)))
|
||||
|
||||
(deftype quantity (tuple (amount float64)
|
||||
(unit string)))
|
||||
|
||||
(deftype input-element (oneof line-break
|
||||
(identifier string)
|
||||
(keyword string)
|
||||
(punctuator string)
|
||||
(number float64)
|
||||
(string string)
|
||||
(regular-expression reg-exp)
|
||||
end))
|
||||
(%print-actions)
|
||||
|
||||
(%section "Keywords and identifiers")
|
||||
|
||||
(rule :identifier-name
|
||||
((name string) (contains-escapes boolean))
|
||||
(production :identifier-name (:initial-identifier-character-or-escape) identifier-name-initial
|
||||
(name (vector (character-value :initial-identifier-character-or-escape)))
|
||||
(contains-escapes (contains-escapes :initial-identifier-character-or-escape)))
|
||||
(production :identifier-name (:null-escapes :initial-identifier-character-or-escape) identifier-name-initial-null-escapes
|
||||
(name (vector (character-value :initial-identifier-character-or-escape)))
|
||||
(contains-escapes true))
|
||||
(production :identifier-name (:identifier-name :continuing-identifier-character-or-escape) identifier-name-continuing
|
||||
(name (append (name :identifier-name) (vector (character-value :continuing-identifier-character-or-escape))))
|
||||
(contains-escapes (or (contains-escapes :identifier-name)
|
||||
(contains-escapes :continuing-identifier-character-or-escape))))
|
||||
(production :identifier-name (:identifier-name :null-escape) identifier-name-null-escape
|
||||
(name (name :identifier-name))
|
||||
(contains-escapes true)))
|
||||
|
||||
(production :null-escapes (:null-escape) null-escapes-one)
|
||||
(production :null-escapes (:null-escapes :null-escape) null-escapes-more)
|
||||
|
||||
(production :null-escape (#\\ #\_) null-escape-underscore)
|
||||
|
||||
(rule :initial-identifier-character-or-escape
|
||||
((character-value character) (contains-escapes boolean))
|
||||
(production :initial-identifier-character-or-escape (:initial-identifier-character) initial-identifier-character-or-escape-ordinary
|
||||
(character-value ($default-action :initial-identifier-character))
|
||||
(contains-escapes false))
|
||||
(production :initial-identifier-character-or-escape (#\\ :hex-escape) initial-identifier-character-or-escape-escape
|
||||
(character-value (if (is-initial-identifier-character (character-value :hex-escape))
|
||||
(character-value :hex-escape)
|
||||
(throw (oneof syntax-error))))
|
||||
(contains-escapes true)))
|
||||
|
||||
(%charclass :initial-identifier-character)
|
||||
|
||||
(rule :continuing-identifier-character-or-escape
|
||||
((character-value character) (contains-escapes boolean))
|
||||
(production :continuing-identifier-character-or-escape (:continuing-identifier-character) continuing-identifier-character-or-escape-ordinary
|
||||
(character-value ($default-action :continuing-identifier-character))
|
||||
(contains-escapes false))
|
||||
(production :continuing-identifier-character-or-escape (#\\ :hex-escape) continuing-identifier-character-or-escape-escape
|
||||
(character-value (if (is-continuing-identifier-character (character-value :hex-escape))
|
||||
(character-value :hex-escape)
|
||||
(throw (oneof syntax-error))))
|
||||
(contains-escapes true)))
|
||||
|
||||
(%charclass :continuing-identifier-character)
|
||||
(%print-actions)
|
||||
|
||||
(define reserved-words (vector string)
|
||||
(vector "abstract" "break" "case" "catch" "class" "const" "continue" "debugger" "default" "delete" "do" "else" "enum"
|
||||
"export" "extends" "false" "final" "finally" "for" "function" "goto" "if" "implements" "import" "in"
|
||||
"instanceof" "interface" "namespace" "native" "new" "null" "package" "private" "protected" "public" "return" "static" "super"
|
||||
"switch" "synchronized" "this" "throw" "throws" "transient" "true" "try" "typeof" "use" "var" "volatile" "while" "with"))
|
||||
(define non-reserved-words (vector string)
|
||||
(vector "exclude" "get" "include" "set"))
|
||||
(define keywords (vector string)
|
||||
(append reserved-words non-reserved-words))
|
||||
|
||||
(define (member (id string) (list (vector string))) boolean
|
||||
(if (empty list)
|
||||
false
|
||||
(if (string= id (nth list 0))
|
||||
true
|
||||
(member id (subseq list 1)))))
|
||||
|
||||
(rule :identifier-or-keyword
|
||||
((input-element input-element))
|
||||
(production :identifier-or-keyword (:identifier-name) identifier-or-keyword-identifier-name
|
||||
(input-element (let ((id string (name :identifier-name)))
|
||||
(if (and (member id keywords) (not (contains-escapes :identifier-name)))
|
||||
(oneof keyword id)
|
||||
(oneof identifier id))))))
|
||||
(%print-actions)
|
||||
|
||||
(%section "Punctuators")
|
||||
|
||||
(rule :punctuator ((punctuator string))
|
||||
(production :punctuator (#\!) punctuator-not (punctuator "!"))
|
||||
(production :punctuator (#\! #\=) punctuator-not-equal (punctuator "!="))
|
||||
(production :punctuator (#\! #\= #\=) punctuator-not-identical (punctuator "!=="))
|
||||
(production :punctuator (#\#) punctuator-hash (punctuator "#"))
|
||||
(production :punctuator (#\%) punctuator-modulo (punctuator "%"))
|
||||
(production :punctuator (#\% #\=) punctuator-modulo-equals (punctuator "%="))
|
||||
(production :punctuator (#\&) punctuator-and (punctuator "&"))
|
||||
(production :punctuator (#\& #\&) punctuator-logical-and (punctuator "&&"))
|
||||
(production :punctuator (#\& #\& #\=) punctuator-logical-and-equals (punctuator "&&="))
|
||||
(production :punctuator (#\& #\=) punctuator-and-equals (punctuator "&="))
|
||||
(production :punctuator (#\() punctuator-open-parenthesis (punctuator "("))
|
||||
(production :punctuator (#\)) punctuator-close-parenthesis (punctuator ")"))
|
||||
(production :punctuator (#\*) punctuator-times (punctuator "*"))
|
||||
(production :punctuator (#\* #\=) punctuator-times-equals (punctuator "*="))
|
||||
(production :punctuator (#\+) punctuator-plus (punctuator "+"))
|
||||
(production :punctuator (#\+ #\+) punctuator-increment (punctuator "++"))
|
||||
(production :punctuator (#\+ #\=) punctuator-plus-equals (punctuator "+="))
|
||||
(production :punctuator (#\,) punctuator-comma (punctuator ","))
|
||||
(production :punctuator (#\-) punctuator-minus (punctuator "-"))
|
||||
(production :punctuator (#\- #\-) punctuator-decrement (punctuator "--"))
|
||||
(production :punctuator (#\- #\=) punctuator-minus-equals (punctuator "-="))
|
||||
(production :punctuator (#\- #\>) punctuator-arrow (punctuator "->"))
|
||||
(production :punctuator (#\.) punctuator-dot (punctuator "."))
|
||||
(production :punctuator (#\. #\.) punctuator-double-dot (punctuator ".."))
|
||||
(production :punctuator (#\. #\. #\.) punctuator-triple-dot (punctuator "..."))
|
||||
(production :punctuator (#\:) punctuator-colon (punctuator ":"))
|
||||
(production :punctuator (#\: #\:) punctuator-namespace (punctuator "::"))
|
||||
(production :punctuator (#\;) punctuator-semicolon (punctuator ";"))
|
||||
(production :punctuator (#\<) punctuator-less-than (punctuator "<"))
|
||||
(production :punctuator (#\< #\<) punctuator-left-shift (punctuator "<<"))
|
||||
(production :punctuator (#\< #\< #\=) punctuator-left-shift-equals (punctuator "<<="))
|
||||
(production :punctuator (#\< #\=) punctuator-less-than-or-equal (punctuator "<="))
|
||||
(production :punctuator (#\=) punctuator-assignment (punctuator "="))
|
||||
(production :punctuator (#\= #\=) punctuator-equal (punctuator "=="))
|
||||
(production :punctuator (#\= #\= #\=) punctuator-identical (punctuator "==="))
|
||||
(production :punctuator (#\>) punctuator-greater-than (punctuator ">"))
|
||||
(production :punctuator (#\> #\=) punctuator-greater-than-or-equal (punctuator ">="))
|
||||
(production :punctuator (#\> #\>) punctuator-right-shift (punctuator ">>"))
|
||||
(production :punctuator (#\> #\> #\=) punctuator-right-shift-equals (punctuator ">>="))
|
||||
(production :punctuator (#\> #\> #\>) punctuator-logical-right-shift (punctuator ">>>"))
|
||||
(production :punctuator (#\> #\> #\> #\=) punctuator-logical-right-shift-equals (punctuator ">>>="))
|
||||
(production :punctuator (#\?) punctuator-question (punctuator "?"))
|
||||
(production :punctuator (#\@) punctuator-at (punctuator "@"))
|
||||
(production :punctuator (#\[) punctuator-open-bracket (punctuator "["))
|
||||
(production :punctuator (#\]) punctuator-close-bracket (punctuator "]"))
|
||||
(production :punctuator (#\^) punctuator-xor (punctuator "^"))
|
||||
(production :punctuator (#\^ #\=) punctuator-xor-equals (punctuator "^="))
|
||||
(production :punctuator (#\^ #\^) punctuator-logical-xor (punctuator "^^"))
|
||||
(production :punctuator (#\^ #\^ #\=) punctuator-logical-xor-equals (punctuator "^^="))
|
||||
(production :punctuator (#\{) punctuator-open-brace (punctuator "{"))
|
||||
(production :punctuator (#\|) punctuator-or (punctuator "|"))
|
||||
(production :punctuator (#\| #\=) punctuator-or-equals (punctuator "|="))
|
||||
(production :punctuator (#\| #\|) punctuator-logical-or (punctuator "||"))
|
||||
(production :punctuator (#\| #\| #\=) punctuator-logical-or-equals (punctuator "||="))
|
||||
(production :punctuator (#\}) punctuator-close-brace (punctuator "}"))
|
||||
(production :punctuator (#\~) punctuator-complement (punctuator "~")))
|
||||
|
||||
(rule :division-punctuator ((punctuator string))
|
||||
(production :division-punctuator (#\/ (:- #\/ #\*)) punctuator-divide (punctuator "/"))
|
||||
(production :division-punctuator (#\/ #\=) punctuator-divide-equals (punctuator "/=")))
|
||||
(%print-actions)
|
||||
|
||||
(%section "Numeric literals")
|
||||
|
||||
(rule :numeric-literal ((float64-value float64))
|
||||
(production :numeric-literal (:decimal-literal) numeric-literal-decimal
|
||||
(float64-value (rational-to-float64 (rational-value :decimal-literal))))
|
||||
(production :numeric-literal (:hex-integer-literal (:- :hex-digit)) numeric-literal-hex
|
||||
(float64-value (rational-to-float64 (integer-value :hex-integer-literal)))))
|
||||
(%print-actions)
|
||||
|
||||
(define (expt (base rational) (exponent integer)) rational
|
||||
(if (= exponent 0)
|
||||
1
|
||||
(if (< exponent 0)
|
||||
(rational/ 1 (expt base (neg exponent)))
|
||||
(rational* base (expt base (- exponent 1))))))
|
||||
|
||||
(rule :decimal-literal ((rational-value rational))
|
||||
(production :decimal-literal (:mantissa) decimal-literal
|
||||
(rational-value (rational-value :mantissa)))
|
||||
(production :decimal-literal (:mantissa :letter-e :signed-integer) decimal-literal-exponent
|
||||
(rational-value (rational* (rational-value :mantissa) (expt 10 (integer-value :signed-integer))))))
|
||||
|
||||
(%charclass :letter-e)
|
||||
|
||||
(rule :mantissa ((rational-value rational))
|
||||
(production :mantissa (:decimal-integer-literal) mantissa-integer
|
||||
(rational-value (integer-value :decimal-integer-literal)))
|
||||
(production :mantissa (:decimal-integer-literal #\.) mantissa-integer-dot
|
||||
(rational-value (integer-value :decimal-integer-literal)))
|
||||
(production :mantissa (:decimal-integer-literal #\. :fraction) mantissa-integer-dot-fraction
|
||||
(rational-value (rational+ (integer-value :decimal-integer-literal)
|
||||
(rational-value :fraction))))
|
||||
(production :mantissa (#\. :fraction) mantissa-dot-fraction
|
||||
(rational-value (rational-value :fraction))))
|
||||
|
||||
(rule :decimal-integer-literal ((integer-value integer))
|
||||
(production :decimal-integer-literal (#\0) decimal-integer-literal-0
|
||||
(integer-value 0))
|
||||
(production :decimal-integer-literal (:non-zero-decimal-digits) decimal-integer-literal-nonzero
|
||||
(integer-value (integer-value :non-zero-decimal-digits))))
|
||||
|
||||
(rule :non-zero-decimal-digits ((integer-value integer))
|
||||
(production :non-zero-decimal-digits (:non-zero-digit) non-zero-decimal-digits-first
|
||||
(integer-value (decimal-value :non-zero-digit)))
|
||||
(production :non-zero-decimal-digits (:non-zero-decimal-digits :a-s-c-i-i-digit) non-zero-decimal-digits-rest
|
||||
(integer-value (+ (* 10 (integer-value :non-zero-decimal-digits)) (decimal-value :a-s-c-i-i-digit)))))
|
||||
|
||||
(%charclass :non-zero-digit)
|
||||
|
||||
(rule :fraction ((rational-value rational))
|
||||
(production :fraction (:decimal-digits) fraction-decimal-digits
|
||||
(rational-value (rational/ (integer-value :decimal-digits)
|
||||
(expt 10 (n-digits :decimal-digits))))))
|
||||
(%print-actions)
|
||||
|
||||
(rule :signed-integer ((integer-value integer))
|
||||
(production :signed-integer (:decimal-digits) signed-integer-no-sign
|
||||
(integer-value (integer-value :decimal-digits)))
|
||||
(production :signed-integer (#\+ :decimal-digits) signed-integer-plus
|
||||
(integer-value (integer-value :decimal-digits)))
|
||||
(production :signed-integer (#\- :decimal-digits) signed-integer-minus
|
||||
(integer-value (neg (integer-value :decimal-digits)))))
|
||||
(%print-actions)
|
||||
|
||||
(rule :decimal-digits
|
||||
((integer-value integer) (n-digits integer))
|
||||
(production :decimal-digits (:a-s-c-i-i-digit) decimal-digits-first
|
||||
(integer-value (decimal-value :a-s-c-i-i-digit))
|
||||
(n-digits 1))
|
||||
(production :decimal-digits (:decimal-digits :a-s-c-i-i-digit) decimal-digits-rest
|
||||
(integer-value (+ (* 10 (integer-value :decimal-digits)) (decimal-value :a-s-c-i-i-digit)))
|
||||
(n-digits (+ (n-digits :decimal-digits) 1))))
|
||||
(%print-actions)
|
||||
|
||||
(rule :hex-integer-literal ((integer-value integer))
|
||||
(production :hex-integer-literal (#\0 :letter-x :hex-digit) hex-integer-literal-first
|
||||
(integer-value (hex-value :hex-digit)))
|
||||
(production :hex-integer-literal (:hex-integer-literal :hex-digit) hex-integer-literal-rest
|
||||
(integer-value (+ (* 16 (integer-value :hex-integer-literal)) (hex-value :hex-digit)))))
|
||||
(%charclass :letter-x)
|
||||
(%charclass :hex-digit)
|
||||
(%print-actions)
|
||||
|
||||
(%section "String literals")
|
||||
|
||||
(grammar-argument :theta single double)
|
||||
(rule :string-literal ((string-value string))
|
||||
(production :string-literal (#\' (:string-chars single) #\') string-literal-single
|
||||
(string-value (string-value :string-chars)))
|
||||
(production :string-literal (#\" (:string-chars double) #\") string-literal-double
|
||||
(string-value (string-value :string-chars))))
|
||||
(%print-actions)
|
||||
|
||||
(rule (:string-chars :theta) ((string-value string))
|
||||
(production (:string-chars :theta) () string-chars-none
|
||||
(string-value ""))
|
||||
(production (:string-chars :theta) ((:string-chars :theta) (:string-char :theta)) string-chars-some
|
||||
(string-value (append (string-value :string-chars)
|
||||
(vector (character-value :string-char)))))
|
||||
(production (:string-chars :theta) ((:string-chars :theta) :null-escape) string-chars-null-escape
|
||||
(string-value (string-value :string-chars))))
|
||||
|
||||
(rule (:string-char :theta) ((character-value character))
|
||||
(production (:string-char :theta) ((:literal-string-char :theta)) string-char-literal
|
||||
(character-value ($default-action :literal-string-char)))
|
||||
(production (:string-char :theta) (#\\ :string-escape) string-char-escape
|
||||
(character-value (character-value :string-escape))))
|
||||
|
||||
(%charclass (:literal-string-char single))
|
||||
(%charclass (:literal-string-char double))
|
||||
(%print-actions)
|
||||
|
||||
(rule :string-escape ((character-value character))
|
||||
(production :string-escape (:control-escape) string-escape-control
|
||||
(character-value (character-value :control-escape)))
|
||||
(production :string-escape (:zero-escape) string-escape-zero
|
||||
(character-value (character-value :zero-escape)))
|
||||
(production :string-escape (:hex-escape) string-escape-hex
|
||||
(character-value (character-value :hex-escape)))
|
||||
(production :string-escape (:identity-escape) string-escape-non-escape
|
||||
(character-value ($default-action :identity-escape))))
|
||||
(%charclass :identity-escape)
|
||||
(%print-actions)
|
||||
|
||||
(rule :control-escape ((character-value character))
|
||||
(production :control-escape (#\b) control-escape-backspace (character-value #?0008))
|
||||
(production :control-escape (#\f) control-escape-form-feed (character-value #?000C))
|
||||
(production :control-escape (#\n) control-escape-new-line (character-value #?000A))
|
||||
(production :control-escape (#\r) control-escape-return (character-value #?000D))
|
||||
(production :control-escape (#\t) control-escape-tab (character-value #?0009))
|
||||
(production :control-escape (#\v) control-escape-vertical-tab (character-value #?000B)))
|
||||
(%print-actions)
|
||||
|
||||
(rule :zero-escape ((character-value character))
|
||||
(production :zero-escape (#\0 (:- :a-s-c-i-i-digit)) zero-escape-zero
|
||||
(character-value #?0000)))
|
||||
(%print-actions)
|
||||
|
||||
(rule :hex-escape ((character-value character))
|
||||
(production :hex-escape (#\x :hex-digit :hex-digit) hex-escape-2
|
||||
(character-value (code-to-character (+ (* 16 (hex-value :hex-digit 1))
|
||||
(hex-value :hex-digit 2)))))
|
||||
(production :hex-escape (#\u :hex-digit :hex-digit :hex-digit :hex-digit) hex-escape-4
|
||||
(character-value (code-to-character (+ (+ (+ (* 4096 (hex-value :hex-digit 1))
|
||||
(* 256 (hex-value :hex-digit 2)))
|
||||
(* 16 (hex-value :hex-digit 3)))
|
||||
(hex-value :hex-digit 4))))))
|
||||
|
||||
(%print-actions)
|
||||
|
||||
(%section "Regular expression literals")
|
||||
|
||||
(rule :reg-exp-literal ((r-e-value reg-exp))
|
||||
(production :reg-exp-literal (:reg-exp-body :reg-exp-flags) reg-exp-literal
|
||||
(r-e-value (tuple reg-exp (r-e-body :reg-exp-body) (r-e-flags :reg-exp-flags)))))
|
||||
|
||||
(rule :reg-exp-flags ((r-e-flags string))
|
||||
(production :reg-exp-flags () reg-exp-flags-none
|
||||
(r-e-flags ""))
|
||||
(production :reg-exp-flags (:reg-exp-flags :continuing-identifier-character-or-escape) reg-exp-flags-more
|
||||
(r-e-flags (append (r-e-flags :reg-exp-flags) (vector (character-value :continuing-identifier-character-or-escape)))))
|
||||
(production :reg-exp-flags (:reg-exp-flags :null-escape) reg-exp-flags-null-escape
|
||||
(r-e-flags (r-e-flags :reg-exp-flags))))
|
||||
|
||||
(rule :reg-exp-body ((r-e-body string))
|
||||
(production :reg-exp-body (#\/ (:- #\*) :reg-exp-chars #\/) reg-exp-body
|
||||
(r-e-body (r-e-body :reg-exp-chars))))
|
||||
|
||||
(rule :reg-exp-chars ((r-e-body string))
|
||||
(production :reg-exp-chars (:reg-exp-char) reg-exp-chars-one
|
||||
(r-e-body (r-e-body :reg-exp-char)))
|
||||
(production :reg-exp-chars (:reg-exp-chars :reg-exp-char) reg-exp-chars-more
|
||||
(r-e-body (append (r-e-body :reg-exp-chars)
|
||||
(r-e-body :reg-exp-char)))))
|
||||
|
||||
(rule :reg-exp-char ((r-e-body string))
|
||||
(production :reg-exp-char (:ordinary-reg-exp-char) reg-exp-char-ordinary
|
||||
(r-e-body (vector ($default-action :ordinary-reg-exp-char))))
|
||||
(production :reg-exp-char (#\\ :non-terminator) reg-exp-char-escape
|
||||
(r-e-body (vector #\\ ($default-action :non-terminator)))))
|
||||
|
||||
(%charclass :ordinary-reg-exp-char)
|
||||
)))
|
||||
|
||||
(defparameter *ll* (world-lexer *lw* 'code-lexer))
|
||||
(defparameter *lg* (lexer-grammar *ll*))
|
||||
(set-up-lexer-metagrammar *ll*)
|
||||
(defparameter *lm* (lexer-metagrammar *ll*)))
|
||||
|
||||
|
||||
#|
|
||||
(depict-rtf-to-local-file
|
||||
"JS20/LexerCharClasses.rtf"
|
||||
"JavaScript 2 Lexical Character Classes"
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-paragraph (rtf-stream ':grammar-header)
|
||||
(depict rtf-stream "Character Classes"))
|
||||
(dolist (charclass (lexer-charclasses *ll*))
|
||||
(depict-charclass rtf-stream charclass))
|
||||
(depict-paragraph (rtf-stream ':grammar-header)
|
||||
(depict rtf-stream "Grammar"))
|
||||
(depict-grammar rtf-stream *lg*)))
|
||||
|
||||
(values
|
||||
(depict-rtf-to-local-file
|
||||
"JS20/LexerGrammar.rtf"
|
||||
"JavaScript 2 Lexical Grammar"
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *lw* :visible-semantics nil)))
|
||||
(depict-rtf-to-local-file
|
||||
"JS20/LexerSemantics.rtf"
|
||||
"JavaScript 2 Lexical Semantics"
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *lw*))))
|
||||
|
||||
(values
|
||||
(depict-html-to-local-file
|
||||
"JS20/LexerGrammar.html"
|
||||
"JavaScript 2 Lexical Grammar"
|
||||
t
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *lw* :visible-semantics nil))
|
||||
:external-link-base "notation.html")
|
||||
(depict-html-to-local-file
|
||||
"JS20/LexerSemantics.html"
|
||||
"JavaScript 2 Lexical Semantics"
|
||||
t
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *lw*))
|
||||
:external-link-base "notation.html"))
|
||||
|
||||
(with-local-output (s "JS20/LexerGrammar.txt") (print-lexer *ll* s) (print-grammar *lg* s))
|
||||
|
||||
(print-illegal-strings m)
|
||||
|#
|
||||
|
||||
|
||||
#+allegro (clean-grammar *lg*) ;Remove this line if you wish to print the grammar's state tables.
|
||||
(length (grammar-states *lg*))
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,655 +0,0 @@
|
||||
;;;
|
||||
;;; JavaScript 2.0 regular expression parser
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
|
||||
(progn
|
||||
(defparameter *rw*
|
||||
(generate-world
|
||||
"R"
|
||||
'((lexer regexp-lexer
|
||||
:lr-1
|
||||
:regular-expression-pattern
|
||||
((:unicode-character (% every (:text "Any Unicode character")) () t)
|
||||
(:unicode-alphanumeric
|
||||
(% alphanumeric (:text "Any Unicode alphabetic or decimal digit character (includes ASCII "
|
||||
(:character-literal #\0) :nbhy (:character-literal #\9) ", "
|
||||
(:character-literal #\A) :nbhy (:character-literal #\Z) ", and "
|
||||
(:character-literal #\a) :nbhy (:character-literal #\z) ")"))
|
||||
() t)
|
||||
(:line-terminator (#?000A #?000D #?2028 #?2029) () t)
|
||||
(:decimal-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
|
||||
(($default-action $default-action)
|
||||
(decimal-value $digit-value)))
|
||||
(:non-zero-digit (#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
|
||||
((decimal-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)))
|
||||
(:control-letter (++ (#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)
|
||||
(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z))
|
||||
(($default-action $default-action)))
|
||||
(:pattern-character (- :unicode-character (#\^ #\$ #\\ #\. #\* #\+ #\? #\( #\) #\[ #\] #\{ #\} #\|))
|
||||
(($default-action $default-action)))
|
||||
((:class-character dash) (- :unicode-character (#\\ #\]))
|
||||
(($default-action $default-action)))
|
||||
((:class-character no-dash) (- (:class-character dash) (#\-))
|
||||
(($default-action $default-action)))
|
||||
(:identity-escape (- :unicode-character (+ (#\_) :unicode-alphanumeric))
|
||||
(($default-action $default-action))))
|
||||
(($default-action character nil identity)
|
||||
($digit-value integer digit-value digit-char-36)))
|
||||
|
||||
(deftype semantic-exception (oneof syntax-error))
|
||||
|
||||
(%section "Unicode Character Classes")
|
||||
(%charclass :unicode-character)
|
||||
(%charclass :unicode-alphanumeric)
|
||||
(%charclass :line-terminator)
|
||||
|
||||
(define line-terminators (set character) (set-of character #?000A #?000D #?2028 #?2029))
|
||||
(define re-whitespaces (set character) (set-of character #?000C #?000A #?000D #?0009 #?000B #\space))
|
||||
(define re-digits (set character) (set-of-ranges character #\0 #\9))
|
||||
(define re-word-characters (set character) (set-of-ranges character #\0 #\9 #\A #\Z #\a #\z #\_ nil))
|
||||
(%print-actions)
|
||||
|
||||
|
||||
(%section "Regular Expression Definitions")
|
||||
(deftype r-e-input (tuple (str string) (ignore-case boolean) (multiline boolean) (span boolean)))
|
||||
(%text :semantics
|
||||
"Field " (:field str r-e-input) " is the input string. "
|
||||
(:field ignore-case r-e-input) ", "
|
||||
(:field multiline r-e-input) ", and "
|
||||
(:field span r-e-input) " are the corresponding regular expression flags.")
|
||||
|
||||
(deftype r-e-result (oneof (success r-e-match) failure))
|
||||
(deftype r-e-match (tuple (end-index integer)
|
||||
(captures (vector capture))))
|
||||
(%text :semantics
|
||||
"A " (:type r-e-match) " holds an intermediate state during the pattern-matching process. "
|
||||
(:field end-index r-e-match)
|
||||
" is the index of the next input character to be matched by the next component in a regular expression pattern. "
|
||||
"If we are at the end of the pattern, " (:field end-index r-e-match)
|
||||
" is one plus the index of the last matched input character. "
|
||||
(:field captures r-e-match)
|
||||
" is a zero-based array of the strings captured so far by capturing parentheses.")
|
||||
|
||||
(deftype capture (oneof (present string)
|
||||
absent))
|
||||
(deftype continuation (-> (r-e-match) r-e-result))
|
||||
(%text :semantics
|
||||
"A " (:type continuation)
|
||||
" is a function that attempts to match the remaining portion of the pattern against the input string, "
|
||||
"starting at the intermediate state given by its " (:type r-e-match) " argument. "
|
||||
"If a match is possible, it returns a " (:field success r-e-result) " result that contains the final "
|
||||
(:type r-e-match) " state; if no match is possible, it returns a " (:field failure r-e-result) " result.")
|
||||
|
||||
(deftype matcher (-> (r-e-input r-e-match continuation) r-e-result))
|
||||
(%text :semantics
|
||||
"A " (:type matcher)
|
||||
" is a function that attempts to match a middle portion of the pattern against the input string, "
|
||||
"starting at the intermediate state given by its " (:type r-e-match) " argument. "
|
||||
"Since the remainder of the pattern heavily influences whether (and how) a middle portion will match, we "
|
||||
"must pass in a " (:type continuation) " function that checks whether the rest of the pattern matched. "
|
||||
"If the continuation returns " (:field failure r-e-result) ", the matcher function may call it repeatedly, "
|
||||
"trying various alternatives at pattern choice points.")
|
||||
(%text :semantics
|
||||
"The " (:type r-e-input) " parameter contains the input string and is merely passed down to subroutines.")
|
||||
|
||||
(deftype matcher-generator (-> (integer) matcher))
|
||||
(%text :semantics
|
||||
"A " (:type matcher-generator)
|
||||
" is a function executed at the time the regular expression is compiled that returns a " (:type matcher) " for a part "
|
||||
"of the pattern. The " (:type integer) " parameter contains the number of capturing left parentheses seen so far in the "
|
||||
"pattern and is used to assign static, consecutive numbers to capturing parentheses.")
|
||||
|
||||
(define (character-set-matcher (acceptance-set (set character)) (invert boolean)) matcher ;*********ignore case?
|
||||
(function ((t r-e-input) (x r-e-match) (c continuation))
|
||||
(let ((i integer (& end-index x))
|
||||
(s string (& str t)))
|
||||
(if (= i (length s))
|
||||
(oneof failure)
|
||||
(if (xor (character-set-member (nth s i) acceptance-set) invert)
|
||||
(c (tuple r-e-match (+ i 1) (& captures x)))
|
||||
(oneof failure))))))
|
||||
(%text :semantics
|
||||
(:global character-set-matcher) " returns a " (:type matcher)
|
||||
" that matches a single input string character. If "
|
||||
(:local invert) " is false, the match succeeds if the character is a member of the "
|
||||
(:local acceptance-set) " set of characters (possibly ignoring case). If "
|
||||
(:local invert) " is true, the match succeeds if the character is not a member of the "
|
||||
(:local acceptance-set) " set of characters (possibly ignoring case).")
|
||||
|
||||
(define (character-matcher (ch character)) matcher
|
||||
(character-set-matcher (set-of character ch) false))
|
||||
(%text :semantics
|
||||
(:global character-matcher) " returns a " (:type matcher)
|
||||
" that matches a single input string character. The match succeeds if the character is the same as "
|
||||
(:local ch) " (possibly ignoring case).")
|
||||
|
||||
(%print-actions)
|
||||
|
||||
|
||||
(%section "Regular Expression Patterns")
|
||||
|
||||
(rule :regular-expression-pattern ((exec (-> (r-e-input integer) r-e-result)))
|
||||
(production :regular-expression-pattern (:disjunction) regular-expression-pattern-disjunction
|
||||
(exec
|
||||
(let ((match matcher ((gen-matcher :disjunction) 0)))
|
||||
(function ((t r-e-input) (index integer))
|
||||
(match
|
||||
t
|
||||
(tuple r-e-match index (fill-capture (count-parens :disjunction)))
|
||||
success-continuation))))))
|
||||
|
||||
(%print-actions)
|
||||
(define (success-continuation (x r-e-match)) r-e-result
|
||||
(oneof success x))
|
||||
(define (fill-capture (i integer)) (vector capture)
|
||||
(if (= i 0)
|
||||
(vector-of capture)
|
||||
(append (fill-capture (- i 1)) (vector (oneof absent)))))
|
||||
|
||||
|
||||
(%subsection "Disjunctions")
|
||||
|
||||
(rule :disjunction ((gen-matcher matcher-generator) (count-parens integer))
|
||||
(production :disjunction (:alternative) disjunction-one
|
||||
(gen-matcher (gen-matcher :alternative))
|
||||
(count-parens (count-parens :alternative)))
|
||||
(production :disjunction (:alternative #\| :disjunction) disjunction-more
|
||||
((gen-matcher (paren-index integer))
|
||||
(let ((match1 matcher ((gen-matcher :alternative) paren-index))
|
||||
(match2 matcher ((gen-matcher :disjunction) (+ paren-index (count-parens :alternative)))))
|
||||
(function ((t r-e-input) (x r-e-match) (c continuation))
|
||||
(case (match1 t x c)
|
||||
((success y r-e-match) (oneof success y))
|
||||
(failure (match2 t x c))))))
|
||||
(count-parens (+ (count-parens :alternative) (count-parens :disjunction)))))
|
||||
|
||||
(%print-actions)
|
||||
|
||||
|
||||
(%subsection "Alternatives")
|
||||
|
||||
(rule :alternative ((gen-matcher matcher-generator) (count-parens integer))
|
||||
(production :alternative () alternative-none
|
||||
((gen-matcher (paren-index integer :unused))
|
||||
(function ((t r-e-input :unused) (x r-e-match) (c continuation))
|
||||
(c x)))
|
||||
(count-parens 0))
|
||||
(production :alternative (:alternative :term) alternative-some
|
||||
((gen-matcher (paren-index integer))
|
||||
(let ((match1 matcher ((gen-matcher :alternative) paren-index))
|
||||
(match2 matcher ((gen-matcher :term) (+ paren-index (count-parens :alternative)))))
|
||||
(function ((t r-e-input) (x r-e-match) (c continuation))
|
||||
(let ((d continuation (function ((y r-e-match))
|
||||
(match2 t y c))))
|
||||
(match1 t x d)))))
|
||||
(count-parens (+ (count-parens :alternative) (count-parens :term)))))
|
||||
|
||||
(%print-actions)
|
||||
|
||||
|
||||
(%subsection "Terms")
|
||||
|
||||
(rule :term ((gen-matcher matcher-generator) (count-parens integer))
|
||||
(production :term (:assertion) term-assertion
|
||||
((gen-matcher (paren-index integer :unused))
|
||||
(function ((t r-e-input) (x r-e-match) (c continuation))
|
||||
(if ((test-assertion :assertion) t x)
|
||||
(c x)
|
||||
(oneof failure))))
|
||||
(count-parens 0))
|
||||
(production :term (:atom) term-atom
|
||||
(gen-matcher (gen-matcher :atom))
|
||||
(count-parens (count-parens :atom)))
|
||||
(production :term (:atom :quantifier) term-quantified-atom
|
||||
((gen-matcher (paren-index integer))
|
||||
(let ((match matcher ((gen-matcher :atom) paren-index))
|
||||
(min integer (minimum :quantifier))
|
||||
(max limit (maximum :quantifier))
|
||||
(greedy boolean (greedy :quantifier)))
|
||||
(if (case max
|
||||
((finite m integer) (< m min))
|
||||
(infinite false))
|
||||
(throw (oneof syntax-error))
|
||||
(repeat-matcher match min max greedy paren-index (count-parens :atom)))))
|
||||
(count-parens (count-parens :atom))))
|
||||
|
||||
(%print-actions)
|
||||
|
||||
|
||||
(rule :quantifier ((minimum integer) (maximum limit) (greedy boolean))
|
||||
(production :quantifier (:quantifier-prefix) quantifier-eager
|
||||
(minimum (minimum :quantifier-prefix))
|
||||
(maximum (maximum :quantifier-prefix))
|
||||
(greedy true))
|
||||
(production :quantifier (:quantifier-prefix #\?) quantifier-greedy
|
||||
(minimum (minimum :quantifier-prefix))
|
||||
(maximum (maximum :quantifier-prefix))
|
||||
(greedy false)))
|
||||
|
||||
(rule :quantifier-prefix ((minimum integer) (maximum limit))
|
||||
(production :quantifier-prefix (#\*) quantifier-prefix-zero-or-more
|
||||
(minimum 0)
|
||||
(maximum (oneof infinite)))
|
||||
(production :quantifier-prefix (#\+) quantifier-prefix-one-or-more
|
||||
(minimum 1)
|
||||
(maximum (oneof infinite)))
|
||||
(production :quantifier-prefix (#\?) quantifier-prefix-zero-or-one
|
||||
(minimum 0)
|
||||
(maximum (oneof finite 1)))
|
||||
(production :quantifier-prefix (#\{ :decimal-digits #\}) quantifier-prefix-repeat
|
||||
(minimum (integer-value :decimal-digits))
|
||||
(maximum (oneof finite (integer-value :decimal-digits))))
|
||||
(production :quantifier-prefix (#\{ :decimal-digits #\, #\}) quantifier-prefix-repeat-or-more
|
||||
(minimum (integer-value :decimal-digits))
|
||||
(maximum (oneof infinite)))
|
||||
(production :quantifier-prefix (#\{ :decimal-digits #\, :decimal-digits #\}) quantifier-prefix-repeat-range
|
||||
(minimum (integer-value :decimal-digits 1))
|
||||
(maximum (oneof finite (integer-value :decimal-digits 2)))))
|
||||
|
||||
(rule :decimal-digits ((integer-value integer))
|
||||
(production :decimal-digits (:decimal-digit) decimal-digits-first
|
||||
(integer-value (decimal-value :decimal-digit)))
|
||||
(production :decimal-digits (:decimal-digits :decimal-digit) decimal-digits-rest
|
||||
(integer-value (+ (* 10 (integer-value :decimal-digits)) (decimal-value :decimal-digit)))))
|
||||
(%charclass :decimal-digit)
|
||||
|
||||
|
||||
(deftype limit (oneof (finite integer) infinite))
|
||||
|
||||
(define (reset-parens (x r-e-match) (p integer) (n-parens integer)) r-e-match
|
||||
(if (= n-parens 0)
|
||||
x
|
||||
(let ((y r-e-match (tuple r-e-match (& end-index x)
|
||||
(set-nth (& captures x) p (oneof absent)))))
|
||||
(reset-parens y (+ p 1) (- n-parens 1)))))
|
||||
|
||||
(define (repeat-matcher (body matcher) (min integer) (max limit) (greedy boolean) (paren-index integer) (n-body-parens integer)) matcher
|
||||
(function ((t r-e-input) (x r-e-match) (c continuation))
|
||||
(if (case max
|
||||
((finite m integer) (= m 0))
|
||||
(infinite false))
|
||||
(c x)
|
||||
(let ((d continuation (function ((y r-e-match))
|
||||
(if (and (= min 0)
|
||||
(= (& end-index y) (& end-index x)))
|
||||
(oneof failure)
|
||||
(let ((new-min integer (if (= min 0) 0 (- min 1)))
|
||||
(new-max limit (case max
|
||||
((finite m integer) (oneof finite (- m 1)))
|
||||
(infinite (oneof infinite)))))
|
||||
((repeat-matcher body new-min new-max greedy paren-index n-body-parens) t y c)))))
|
||||
(xr r-e-match (reset-parens x paren-index n-body-parens)))
|
||||
(if (/= min 0)
|
||||
(body t xr d)
|
||||
(if greedy
|
||||
(case (body t xr d)
|
||||
((success z r-e-match) (oneof success z))
|
||||
(failure (c x)))
|
||||
(case (c x)
|
||||
((success z r-e-match) (oneof success z))
|
||||
(failure (body t xr d)))))))))
|
||||
|
||||
(%print-actions)
|
||||
|
||||
|
||||
(%subsection "Assertions")
|
||||
|
||||
(rule :assertion ((test-assertion (-> (r-e-input r-e-match) boolean)))
|
||||
(production :assertion (#\^) assertion-beginning
|
||||
((test-assertion (t r-e-input) (x r-e-match))
|
||||
(if (= (& end-index x) 0)
|
||||
true
|
||||
(and (& multiline t)
|
||||
(character-set-member (nth (& str t) (- (& end-index x) 1)) line-terminators)))))
|
||||
(production :assertion (#\$) assertion-end
|
||||
((test-assertion (t r-e-input) (x r-e-match))
|
||||
(if (= (& end-index x) (length (& str t)))
|
||||
true
|
||||
(and (& multiline t)
|
||||
(character-set-member (nth (& str t) (& end-index x)) line-terminators)))))
|
||||
(production :assertion (#\\ #\b) assertion-word-boundary
|
||||
((test-assertion (t r-e-input) (x r-e-match))
|
||||
(at-word-boundary (& end-index x) (& str t))))
|
||||
(production :assertion (#\\ #\B) assertion-non-word-boundary
|
||||
((test-assertion (t r-e-input) (x r-e-match))
|
||||
(not (at-word-boundary (& end-index x) (& str t))))))
|
||||
|
||||
(%print-actions)
|
||||
|
||||
(define (at-word-boundary (i integer) (s string)) boolean
|
||||
(xor (in-word (- i 1) s) (in-word i s)))
|
||||
|
||||
(define (in-word (i integer) (s string)) boolean
|
||||
(if (or (= i -1) (= i (length s)))
|
||||
false
|
||||
(character-set-member (nth s i) re-word-characters)))
|
||||
|
||||
|
||||
(%section "Atoms")
|
||||
|
||||
(rule :atom ((gen-matcher matcher-generator) (count-parens integer))
|
||||
(production :atom (:pattern-character) atom-pattern-character
|
||||
((gen-matcher (paren-index integer :unused))
|
||||
(character-matcher ($default-action :pattern-character)))
|
||||
(count-parens 0))
|
||||
(production :atom (#\.) atom-dot
|
||||
((gen-matcher (paren-index integer :unused))
|
||||
(function ((t r-e-input) (x r-e-match) (c continuation))
|
||||
((character-set-matcher (if (& span t) (set-of character) line-terminators) true) t x c)))
|
||||
(count-parens 0))
|
||||
(production :atom (:null-escape) atom-null-escape
|
||||
((gen-matcher (paren-index integer :unused))
|
||||
(function ((t r-e-input :unused) (x r-e-match) (c continuation))
|
||||
(c x)))
|
||||
(count-parens 0))
|
||||
(production :atom (#\\ :atom-escape) atom-atom-escape
|
||||
(gen-matcher (gen-matcher :atom-escape))
|
||||
(count-parens 0))
|
||||
(production :atom (:character-class) atom-character-class
|
||||
((gen-matcher (paren-index integer :unused))
|
||||
(let ((a (set character) (acceptance-set :character-class)))
|
||||
(character-set-matcher a (invert :character-class))))
|
||||
(count-parens 0))
|
||||
(production :atom (#\( :disjunction #\)) atom-parentheses
|
||||
((gen-matcher (paren-index integer))
|
||||
(let ((match matcher ((gen-matcher :disjunction) (+ paren-index 1))))
|
||||
(function ((t r-e-input) (x r-e-match) (c continuation))
|
||||
(let ((d continuation
|
||||
(function ((y r-e-match))
|
||||
(let ((updated-captures (vector capture)
|
||||
(set-nth (& captures y) paren-index
|
||||
(oneof present (subseq (& str t) (& end-index x) (- (& end-index y) 1))))))
|
||||
(c (tuple r-e-match (& end-index y) updated-captures))))))
|
||||
(match t x d)))))
|
||||
(count-parens (+ (count-parens :disjunction) 1)))
|
||||
(production :atom (#\( #\? #\: :disjunction #\)) atom-non-capturing-parentheses
|
||||
(gen-matcher (gen-matcher :disjunction))
|
||||
(count-parens (count-parens :disjunction)))
|
||||
(production :atom (#\( #\? #\= :disjunction #\)) atom-positive-lookahead
|
||||
((gen-matcher (paren-index integer))
|
||||
(let ((match matcher ((gen-matcher :disjunction) paren-index)))
|
||||
(function ((t r-e-input) (x r-e-match) (c continuation))
|
||||
;(let ((d continuation
|
||||
; (function ((y r-e-match))
|
||||
; (c (tuple r-e-match (& end-index x) (& captures y))))))
|
||||
; (match t x d)))))
|
||||
(case (match t x success-continuation)
|
||||
((success y r-e-match)
|
||||
(c (tuple r-e-match (& end-index x) (& captures y))))
|
||||
(failure (oneof failure))))))
|
||||
(count-parens (count-parens :disjunction)))
|
||||
(production :atom (#\( #\? #\! :disjunction #\)) atom-negative-lookahead
|
||||
((gen-matcher (paren-index integer))
|
||||
(let ((match matcher ((gen-matcher :disjunction) paren-index)))
|
||||
(function ((t r-e-input) (x r-e-match) (c continuation))
|
||||
(case (match t x success-continuation)
|
||||
((success y r-e-match :unused) (oneof failure))
|
||||
(failure (c x))))))
|
||||
(count-parens (count-parens :disjunction))))
|
||||
|
||||
(%charclass :pattern-character)
|
||||
(%print-actions)
|
||||
|
||||
|
||||
(%section "Escapes")
|
||||
|
||||
(production :null-escape (#\\ #\_) null-escape-underscore)
|
||||
|
||||
(rule :atom-escape ((gen-matcher matcher-generator))
|
||||
(production :atom-escape (:decimal-escape) atom-escape-decimal
|
||||
((gen-matcher (paren-index integer))
|
||||
(let ((n integer (escape-value :decimal-escape)))
|
||||
(if (= n 0)
|
||||
(character-matcher #?0000)
|
||||
(if (> n paren-index)
|
||||
(throw (oneof syntax-error))
|
||||
(backreference-matcher n))))))
|
||||
(production :atom-escape (:character-escape) atom-escape-character
|
||||
((gen-matcher (paren-index integer :unused))
|
||||
(character-matcher (character-value :character-escape))))
|
||||
(production :atom-escape (:character-class-escape) atom-escape-character-class
|
||||
((gen-matcher (paren-index integer :unused))
|
||||
(character-set-matcher (acceptance-set :character-class-escape) false))))
|
||||
(%print-actions)
|
||||
|
||||
(define (backreference-matcher (n integer)) matcher
|
||||
(function ((t r-e-input) (x r-e-match) (c continuation))
|
||||
(case (nth-backreference x n)
|
||||
((present ref string)
|
||||
(let ((i integer (& end-index x))
|
||||
(s string (& str t)))
|
||||
(let ((j integer (+ i (length ref))))
|
||||
(if (> j (length s))
|
||||
(oneof failure)
|
||||
(if (string= (subseq s i (- j 1)) ref) ;*********ignore case?
|
||||
(c (tuple r-e-match j (& captures x)))
|
||||
(oneof failure))))))
|
||||
(absent (c x)))))
|
||||
|
||||
(define (nth-backreference (x r-e-match) (n integer)) capture
|
||||
(nth (& captures x) (- n 1)))
|
||||
|
||||
|
||||
(rule :character-escape ((character-value character))
|
||||
(production :character-escape (:control-escape) character-escape-control
|
||||
(character-value (character-value :control-escape)))
|
||||
(production :character-escape (#\c :control-letter) character-escape-control-letter
|
||||
(character-value (code-to-character (bitwise-and (character-to-code ($default-action :control-letter)) 31))))
|
||||
(production :character-escape (:hex-escape) character-escape-hex
|
||||
(character-value (character-value :hex-escape)))
|
||||
(production :character-escape (:identity-escape) character-escape-identity
|
||||
(character-value ($default-action :identity-escape))))
|
||||
|
||||
(%charclass :control-letter)
|
||||
(%charclass :identity-escape)
|
||||
|
||||
(rule :control-escape ((character-value character))
|
||||
(production :control-escape (#\f) control-escape-form-feed (character-value #?000C))
|
||||
(production :control-escape (#\n) control-escape-new-line (character-value #?000A))
|
||||
(production :control-escape (#\r) control-escape-return (character-value #?000D))
|
||||
(production :control-escape (#\t) control-escape-tab (character-value #?0009))
|
||||
(production :control-escape (#\v) control-escape-vertical-tab (character-value #?000B)))
|
||||
(%print-actions)
|
||||
|
||||
|
||||
(%subsection "Decimal Escapes")
|
||||
|
||||
(rule :decimal-escape ((escape-value integer))
|
||||
(production :decimal-escape (:decimal-integer-literal (:- :decimal-digit)) decimal-escape-integer
|
||||
(escape-value (integer-value :decimal-integer-literal))))
|
||||
|
||||
(rule :decimal-integer-literal ((integer-value integer))
|
||||
(production :decimal-integer-literal (#\0) decimal-integer-literal-0
|
||||
(integer-value 0))
|
||||
(production :decimal-integer-literal (:non-zero-decimal-digits) decimal-integer-literal-nonzero
|
||||
(integer-value (integer-value :non-zero-decimal-digits))))
|
||||
|
||||
(rule :non-zero-decimal-digits ((integer-value integer))
|
||||
(production :non-zero-decimal-digits (:non-zero-digit) non-zero-decimal-digits-first
|
||||
(integer-value (decimal-value :non-zero-digit)))
|
||||
(production :non-zero-decimal-digits (:non-zero-decimal-digits :decimal-digit) non-zero-decimal-digits-rest
|
||||
(integer-value (+ (* 10 (integer-value :non-zero-decimal-digits)) (decimal-value :decimal-digit)))))
|
||||
|
||||
(%charclass :non-zero-digit)
|
||||
(%print-actions)
|
||||
|
||||
|
||||
(%subsection "Hexadecimal Escapes")
|
||||
|
||||
(rule :hex-escape ((character-value character))
|
||||
(production :hex-escape (#\x :hex-digit :hex-digit) hex-escape-2
|
||||
(character-value (code-to-character (+ (* 16 (hex-value :hex-digit 1))
|
||||
(hex-value :hex-digit 2)))))
|
||||
(production :hex-escape (#\u :hex-digit :hex-digit :hex-digit :hex-digit) hex-escape-4
|
||||
(character-value (code-to-character (+ (+ (+ (* 4096 (hex-value :hex-digit 1))
|
||||
(* 256 (hex-value :hex-digit 2)))
|
||||
(* 16 (hex-value :hex-digit 3)))
|
||||
(hex-value :hex-digit 4))))))
|
||||
(%charclass :hex-digit)
|
||||
(%print-actions)
|
||||
|
||||
|
||||
(%subsection "Character Class Escapes")
|
||||
|
||||
(rule :character-class-escape ((acceptance-set (set character)))
|
||||
(production :character-class-escape (#\s) character-class-escape-whitespace
|
||||
(acceptance-set re-whitespaces))
|
||||
(production :character-class-escape (#\S) character-class-escape-non-whitespace
|
||||
(acceptance-set (character-set-difference (set-of-ranges character #?0000 #?FFFF) re-whitespaces)))
|
||||
(production :character-class-escape (#\d) character-class-escape-digit
|
||||
(acceptance-set re-digits))
|
||||
(production :character-class-escape (#\D) character-class-escape-non-digit
|
||||
(acceptance-set (character-set-difference (set-of-ranges character #?0000 #?FFFF) re-digits)))
|
||||
(production :character-class-escape (#\w) character-class-escape-word
|
||||
(acceptance-set re-word-characters))
|
||||
(production :character-class-escape (#\W) character-class-escape-non-word
|
||||
(acceptance-set (character-set-difference (set-of-ranges character #?0000 #?FFFF) re-word-characters))))
|
||||
(%print-actions)
|
||||
|
||||
|
||||
(%section "User-Specified Character Classes")
|
||||
|
||||
(rule :character-class ((acceptance-set (set character)) (invert boolean))
|
||||
(production :character-class (#\[ (:- #\^) :class-ranges #\]) character-class-positive
|
||||
(acceptance-set (acceptance-set :class-ranges))
|
||||
(invert false))
|
||||
(production :character-class (#\[ #\^ :class-ranges #\]) character-class-negative
|
||||
(acceptance-set (acceptance-set :class-ranges))
|
||||
(invert true)))
|
||||
|
||||
(rule :class-ranges ((acceptance-set (set character)))
|
||||
(production :class-ranges () class-ranges-none
|
||||
(acceptance-set (set-of character)))
|
||||
(production :class-ranges ((:nonempty-class-ranges dash)) class-ranges-some
|
||||
(acceptance-set (acceptance-set :nonempty-class-ranges))))
|
||||
|
||||
(grammar-argument :delta dash no-dash)
|
||||
|
||||
(rule (:nonempty-class-ranges :delta) ((acceptance-set (set character)))
|
||||
(production (:nonempty-class-ranges :delta) ((:class-atom dash)) nonempty-class-ranges-final
|
||||
(acceptance-set (acceptance-set :class-atom)))
|
||||
(production (:nonempty-class-ranges :delta) ((:class-atom :delta) (:nonempty-class-ranges no-dash)) nonempty-class-ranges-non-final
|
||||
(acceptance-set
|
||||
(character-set-union (acceptance-set :class-atom)
|
||||
(acceptance-set :nonempty-class-ranges))))
|
||||
(production (:nonempty-class-ranges :delta) ((:class-atom :delta) #\- (:class-atom dash) :class-ranges) nonempty-class-ranges-range
|
||||
(acceptance-set
|
||||
(let ((range (set character) (character-range (acceptance-set :class-atom 1)
|
||||
(acceptance-set :class-atom 2))))
|
||||
(character-set-union range (acceptance-set :class-ranges)))))
|
||||
(production (:nonempty-class-ranges :delta) (:null-escape :class-ranges) nonempty-class-ranges-null-escape
|
||||
(acceptance-set (acceptance-set :class-ranges))))
|
||||
(%print-actions)
|
||||
|
||||
(define (character-range (low (set character)) (high (set character))) (set character)
|
||||
(if (or (/= (character-set-length low) 1) (/= (character-set-length high) 1))
|
||||
(throw (oneof syntax-error))
|
||||
(let ((l character (character-set-min low))
|
||||
(h character (character-set-min high)))
|
||||
(if (char<= l h)
|
||||
(set-of-ranges character l h)
|
||||
(throw (oneof syntax-error))))))
|
||||
|
||||
|
||||
(%subsection "Character Class Range Atoms")
|
||||
|
||||
(rule (:class-atom :delta) ((acceptance-set (set character)))
|
||||
(production (:class-atom :delta) ((:class-character :delta)) class-atom-character
|
||||
(acceptance-set (set-of character ($default-action :class-character))))
|
||||
(production (:class-atom :delta) (#\\ :class-escape) class-atom-escape
|
||||
(acceptance-set (acceptance-set :class-escape))))
|
||||
|
||||
(%charclass (:class-character dash))
|
||||
(%charclass (:class-character no-dash))
|
||||
|
||||
(rule :class-escape ((acceptance-set (set character)))
|
||||
(production :class-escape (:decimal-escape) class-escape-decimal
|
||||
(acceptance-set
|
||||
(if (= (escape-value :decimal-escape) 0)
|
||||
(set-of character #?0000)
|
||||
(throw (oneof syntax-error)))))
|
||||
(production :class-escape (#\b) class-escape-backspace
|
||||
(acceptance-set (set-of character #?0008)))
|
||||
(production :class-escape (:character-escape) class-escape-character-escape
|
||||
(acceptance-set (set-of character (character-value :character-escape))))
|
||||
(production :class-escape (:character-class-escape) class-escape-character-class-escape
|
||||
(acceptance-set (acceptance-set :character-class-escape))))
|
||||
(%print-actions)
|
||||
)))
|
||||
|
||||
(defparameter *rl* (world-lexer *rw* 'regexp-lexer))
|
||||
(defparameter *rg* (lexer-grammar *rl*)))
|
||||
|
||||
|
||||
(defun run-regexp (regexp input &key ignore-case multiline span)
|
||||
(let ((exec (first (lexer-parse *rl* regexp))))
|
||||
(dotimes (i (length input) '(failure))
|
||||
(let ((result (funcall exec (list input ignore-case multiline span) i)))
|
||||
(ecase (first result)
|
||||
(success
|
||||
(return (list* i (subseq input i (second result)) (cddr result))))
|
||||
(failure))))))
|
||||
|
||||
#|
|
||||
(values
|
||||
(depict-rtf-to-local-file
|
||||
"JS20/RegExpGrammar.rtf"
|
||||
"Regular Expression Grammar"
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *rw* :visible-semantics nil)))
|
||||
(depict-rtf-to-local-file
|
||||
"JS20/RegExpSemantics.rtf"
|
||||
"Regular Expression Semantics"
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *rw*))))
|
||||
|
||||
(values
|
||||
(depict-html-to-local-file
|
||||
"JS20/RegExpGrammar.html"
|
||||
"Regular Expression Grammar"
|
||||
t
|
||||
#'(lambda (html-stream)
|
||||
(depict-world-commands html-stream *rw* :visible-semantics nil))
|
||||
:external-link-base "notation.html")
|
||||
(depict-html-to-local-file
|
||||
"JS20/RegExpSemantics.html"
|
||||
"Regular Expression Semantics"
|
||||
t
|
||||
#'(lambda (html-stream)
|
||||
(depict-world-commands html-stream *rw*))
|
||||
:external-link-base "notation.html"))
|
||||
|
||||
(with-local-output (s "JS20/RegExpGrammar.txt") (print-lexer *rl* s) (print-grammar *rg* s))
|
||||
|
||||
(lexer-pparse *rl* "a+" :trace t)
|
||||
(lexer-pparse *rl* "[]+" :trace t)
|
||||
(run-regexp "(0x|0)2" "0x20")
|
||||
(run-regexp "(a*)b\\1+c" "aabaaaac")
|
||||
(run-regexp "(a*)b\\1+" "baaaac")
|
||||
(run-regexp "b(a+)(a+)?(a+)c" "baaaac")
|
||||
(run-regexp "(((a+)?(b+)?c)*)" "aacbbbcac")
|
||||
(run-regexp "(\\s\\S\\s)" "aac xa d fds fds sac")
|
||||
(run-regexp "(\\s)" "aac xa deac")
|
||||
(run-regexp "[01234]+aa+" "93-43aabbc")
|
||||
(run-regexp "[\\101A-ae-]+" "93ABC-@ezy43abc")
|
||||
(run-regexp "[\\181A-ae-]+" "93ABC-@ezy43abc")
|
||||
(run-regexp "b[ace]+" "baaaacecfe")
|
||||
(run-regexp "b[^a]+" "baaaabc")
|
||||
(run-regexp "(?=(a+))a*b\\1" "baaabac")
|
||||
(run-regexp "(?=(a+))" "baaabac")
|
||||
(run-regexp "(.*?)a(?!(a+)b\\2c)\\2(.*)" "baaabaac")
|
||||
(run-regexp "(aa|aabaac|ba|b|c)*" "aabaac")
|
||||
(run-regexp "[\\_^01234]+\\_aa+" "93-43aabbc")
|
||||
(run-regexp "a." "AAab")
|
||||
(run-regexp "a." "AAab" :ignore-case t)
|
||||
(run-regexp "a.." (concatenate 'string "a" (string #\newline) "bacd"))
|
||||
(run-regexp "a.." (concatenate 'string "a" (string #\newline) "bacd") :span t)
|
||||
|#
|
||||
|
||||
#+allegro (clean-grammar *rg*) ;Remove this line if you wish to print the grammar's state tables.
|
||||
(length (grammar-states *rg*))
|
||||
@@ -1,192 +0,0 @@
|
||||
;;;
|
||||
;;; JavaScript 2.0 lexer
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
|
||||
(progn
|
||||
(defparameter *uw*
|
||||
(generate-world
|
||||
"U"
|
||||
'((lexer unit-lexer
|
||||
:lalr-1
|
||||
:unit-pattern
|
||||
((:unicode-initial-alphabetic
|
||||
(% initial-alpha (:text "Any Unicode initial alphabetic character (includes ASCII "
|
||||
(:character-literal #\A) :nbhy (:character-literal #\Z) " and "
|
||||
(:character-literal #\a) :nbhy (:character-literal #\z) ")"))
|
||||
() t)
|
||||
(:unicode-alphanumeric
|
||||
(% alphanumeric (:text "Any Unicode alphabetic or decimal digit character (includes ASCII "
|
||||
(:character-literal #\0) :nbhy (:character-literal #\9) ", "
|
||||
(:character-literal #\A) :nbhy (:character-literal #\Z) ", and "
|
||||
(:character-literal #\a) :nbhy (:character-literal #\z) ")"))
|
||||
() t)
|
||||
(:white-space-character (++ (#?0009 #?000B #?000C #\space #?00A0)
|
||||
(#?2000 #?2001 #?2002 #?2003 #?2004 #?2005 #?2006 #?2007)
|
||||
(#?2008 #?2009 #?200A #?200B)
|
||||
(#?3000)) ())
|
||||
(:line-terminator (#?000A #?000D #?2028 #?2029) ())
|
||||
(:initial-identifier-character (+ :unicode-initial-alphabetic (#\$ #\_))
|
||||
(($default-action $default-action)))
|
||||
(:continuing-identifier-character (+ :unicode-alphanumeric (#\$ #\_))
|
||||
(($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))))
|
||||
(($default-action character nil identity)
|
||||
($digit-value integer digit-value digit-char-36)))
|
||||
|
||||
|
||||
(%text nil "The start nonterminal is " (:grammar-symbol :unit-pattern) ".")
|
||||
|
||||
(deftype semantic-exception (oneof syntax-error))
|
||||
(%print-actions)
|
||||
|
||||
|
||||
(%section "White Space")
|
||||
|
||||
(grammar-argument :sigma wsopt wsreq)
|
||||
|
||||
(%charclass :white-space-character)
|
||||
(%charclass :line-terminator)
|
||||
|
||||
(production :required-white-space (:white-space-character) required-white-space-character)
|
||||
(production :required-white-space (:line-terminator) required-white-space-line-terminator)
|
||||
(production :required-white-space (:required-white-space :white-space-character) required-white-space-more-character)
|
||||
(production :required-white-space (:required-white-space :line-terminator) required-white-space-more-line-terminator)
|
||||
|
||||
(production (:white-space :sigma) (:required-white-space) white-space-required-white-space)
|
||||
(production (:white-space wsopt) () white-space-empty)
|
||||
|
||||
(%section "Unit Patterns")
|
||||
|
||||
(rule :unit-pattern ((value unit-list))
|
||||
(production :unit-pattern ((:white-space wsopt) :unit-quotient) unit-pattern-quotient
|
||||
(value (value :unit-quotient))))
|
||||
|
||||
(rule :unit-quotient ((value unit-list))
|
||||
(production :unit-quotient ((:unit-product wsopt)) unit-quotient-product
|
||||
(value (value :unit-product)))
|
||||
(production :unit-quotient ((:unit-product wsopt) #\/ (:white-space wsopt) (:unit-product wsopt)) unit-quotient-quotient
|
||||
(value (append (value :unit-product 1) (unit-reciprocal (value :unit-product 2))))))
|
||||
|
||||
(rule (:unit-product :sigma) ((value unit-list))
|
||||
(production (:unit-product :sigma) ((:unit-factor :sigma)) unit-product-factor
|
||||
(value (value :unit-factor)))
|
||||
(production (:unit-product :sigma) ((:unit-product wsopt) #\* (:white-space wsopt) (:unit-factor :sigma)) unit-product-product
|
||||
(value (append (value :unit-product) (value :unit-factor))))
|
||||
(production (:unit-product :sigma) ((:unit-product wsreq) (:unit-factor :sigma)) unit-product-implied-product
|
||||
(value (append (value :unit-product) (value :unit-factor)))))
|
||||
|
||||
(rule (:unit-factor :sigma) ((value unit-list))
|
||||
(production (:unit-factor :sigma) (#\1 (:white-space :sigma)) unit-factor-one
|
||||
(value (vector-of unit-factor)))
|
||||
(production (:unit-factor :sigma) (#\1 (:white-space wsopt) #\^ (:white-space wsopt) :signed-integer (:white-space :sigma)) unit-factor-one-exponent
|
||||
(value (vector-of unit-factor)))
|
||||
(production (:unit-factor :sigma) (:identifier (:white-space :sigma)) unit-factor-identifier
|
||||
(value (vector (tuple unit-factor (name :identifier) 1))))
|
||||
(production (:unit-factor :sigma) (:identifier (:white-space wsopt) #\^ (:white-space wsopt) :signed-integer (:white-space :sigma)) unit-factor-identifier-exponent
|
||||
(value (vector (tuple unit-factor (name :identifier) (integer-value :signed-integer))))))
|
||||
|
||||
(deftype unit-list (vector unit-factor))
|
||||
(deftype unit-factor (tuple (identifier string) (exponent integer)))
|
||||
|
||||
(define (unit-reciprocal (u unit-list)) unit-list
|
||||
(if (empty u)
|
||||
(vector-of unit-factor)
|
||||
(let ((f unit-factor (nth u 0)))
|
||||
(append (vector (tuple unit-factor (& identifier f) (neg (& exponent f)))) (subseq u 1)))))
|
||||
|
||||
(%print-actions)
|
||||
|
||||
|
||||
(%section "Signed Integers")
|
||||
(rule :signed-integer ((integer-value integer))
|
||||
(production :signed-integer (:decimal-digits) signed-integer-no-sign
|
||||
(integer-value (integer-value :decimal-digits)))
|
||||
(production :signed-integer (#\+ :decimal-digits) signed-integer-plus
|
||||
(integer-value (integer-value :decimal-digits)))
|
||||
(production :signed-integer (#\- :decimal-digits) signed-integer-minus
|
||||
(integer-value (neg (integer-value :decimal-digits)))))
|
||||
|
||||
(rule :decimal-digits ((integer-value integer))
|
||||
(production :decimal-digits (:a-s-c-i-i-digit) decimal-digits-first
|
||||
(integer-value (decimal-value :a-s-c-i-i-digit)))
|
||||
(production :decimal-digits (:decimal-digits :a-s-c-i-i-digit) decimal-digits-rest
|
||||
(integer-value (+ (* 10 (integer-value :decimal-digits)) (decimal-value :a-s-c-i-i-digit)))))
|
||||
|
||||
(%charclass :a-s-c-i-i-digit)
|
||||
(%print-actions)
|
||||
|
||||
|
||||
(%section "Identifiers")
|
||||
(rule :identifier ((name string))
|
||||
(production :identifier (:initial-identifier-character) identifier-initial
|
||||
(name (vector ($default-action :initial-identifier-character))))
|
||||
(production :identifier (:identifier :continuing-identifier-character) identifier-continuing
|
||||
(name (append (name :identifier) (vector ($default-action :continuing-identifier-character))))))
|
||||
|
||||
(%charclass :initial-identifier-character)
|
||||
(%charclass :continuing-identifier-character)
|
||||
(%charclass :unicode-initial-alphabetic)
|
||||
(%charclass :unicode-alphanumeric)
|
||||
(%print-actions)
|
||||
)))
|
||||
|
||||
(defparameter *ul* (world-lexer *uw* 'unit-lexer))
|
||||
(defparameter *ug* (lexer-grammar *ul*))
|
||||
(set-up-lexer-metagrammar *ul*)
|
||||
(defparameter *um* (lexer-metagrammar *ul*)))
|
||||
|
||||
|
||||
#|
|
||||
(depict-rtf-to-local-file
|
||||
"JS20/UnitCharClasses.rtf"
|
||||
"JavaScript 2 Unit Character Classes"
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-paragraph (rtf-stream ':grammar-header)
|
||||
(depict rtf-stream "Character Classes"))
|
||||
(dolist (charclass (lexer-charclasses *ul*))
|
||||
(depict-charclass rtf-stream charclass))
|
||||
(depict-paragraph (rtf-stream ':grammar-header)
|
||||
(depict rtf-stream "Grammar"))
|
||||
(depict-grammar rtf-stream *ug*)))
|
||||
|
||||
(values
|
||||
(depict-rtf-to-local-file
|
||||
"JS20/UnitGrammar.rtf"
|
||||
"JavaScript 2 Unit Grammar"
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *uw* :visible-semantics nil)))
|
||||
(depict-rtf-to-local-file
|
||||
"JS20/UnitSemantics.rtf"
|
||||
"JavaScript 2 Unit Semantics"
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *uw*))))
|
||||
|
||||
(values
|
||||
(depict-html-to-local-file
|
||||
"JS20/UnitGrammar.html"
|
||||
"JavaScript 2 Unit Grammar"
|
||||
t
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *uw* :visible-semantics nil))
|
||||
:external-link-base "notation.html")
|
||||
(depict-html-to-local-file
|
||||
"JS20/UnitSemantics.html"
|
||||
"JavaScript 2 Unit Semantics"
|
||||
t
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *uw*))
|
||||
:external-link-base "notation.html"))
|
||||
|
||||
(with-local-output (s "JS20/UnitGrammar.txt") (print-lexer *ul* s) (print-grammar *ug* s))
|
||||
|
||||
(print-illegal-strings m)
|
||||
|#
|
||||
|
||||
|
||||
#+allegro (clean-grammar *ug*) ;Remove this line if you wish to print the grammar's state tables.
|
||||
(length (grammar-states *ug*))
|
||||
@@ -1,492 +0,0 @@
|
||||
;;; The contents of this file are subject to the Mozilla Public
|
||||
;;; License Version 1.1 (the "License"); you may not use this file
|
||||
;;; except in compliance with the License. You may obtain a copy of
|
||||
;;; the License at http://www.mozilla.org/MPL/
|
||||
;;;
|
||||
;;; Software distributed under the License is distributed on an "AS
|
||||
;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
;;; implied. See the License for the specific language governing
|
||||
;;; rights and limitations under the License.
|
||||
;;;
|
||||
;;; The Original Code is the Language Design and Prototyping Environment.
|
||||
;;;
|
||||
;;; The Initial Developer of the Original Code is Netscape Communications
|
||||
;;; Corporation. Portions created by Netscape Communications Corporation are
|
||||
;;; Copyright (C) 1999 Netscape Communications Corporation. All
|
||||
;;; Rights Reserved.
|
||||
;;;
|
||||
;;; Contributor(s): Waldemar Horwat <waldemar@acm.org>
|
||||
|
||||
;;;
|
||||
;;; ECMAScript sample lexer
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
(progn
|
||||
(defparameter *lw*
|
||||
(generate-world
|
||||
"L"
|
||||
'((lexer code-lexer
|
||||
:lalr-1
|
||||
:next-token
|
||||
((:unicode-character (% every (:text "Any Unicode character")) () t)
|
||||
(:white-space-character (#?0009 #?000B #?000C #\space) ())
|
||||
(:line-terminator (#?000A #?000D) ())
|
||||
(:non-terminator (- :unicode-character :line-terminator) ())
|
||||
(:non-terminator-or-slash (- :non-terminator (#\/)) ())
|
||||
(:non-terminator-or-asterisk-or-slash (- :non-terminator (#\* #\/)) ())
|
||||
(:identifier-letter (++ (#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)
|
||||
(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)
|
||||
(#\$ #\_))
|
||||
((character-value character-value)))
|
||||
(:decimal-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
|
||||
((character-value character-value)
|
||||
(decimal-value $digit-value)))
|
||||
(:non-zero-digit (#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
|
||||
((decimal-value $digit-value)))
|
||||
(:octal-digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7)
|
||||
((character-value character-value)
|
||||
(octal-value $digit-value)))
|
||||
(:zero-to-three (#\0 #\1 #\2 #\3)
|
||||
((octal-value $digit-value)))
|
||||
(:four-to-seven (#\4 #\5 #\6 #\7)
|
||||
((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)))
|
||||
(: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 nil identity)
|
||||
($digit-value integer digit-value digit-char-36)))
|
||||
|
||||
(%section "Comments")
|
||||
(production :line-comment (#\/ #\/ :line-comment-characters) line-comment)
|
||||
|
||||
(production :line-comment-characters () line-comment-characters-empty)
|
||||
(production :line-comment-characters (:line-comment-characters :non-terminator) line-comment-characters-chars)
|
||||
(%charclass :unicode-character)
|
||||
(%charclass :non-terminator)
|
||||
|
||||
(production :single-line-block-comment (#\/ #\* :block-comment-characters #\* #\/) single-line-block-comment)
|
||||
|
||||
(production :block-comment-characters () block-comment-characters-empty)
|
||||
(production :block-comment-characters (:block-comment-characters :non-terminator-or-slash) block-comment-characters-chars)
|
||||
(production :block-comment-characters (:pre-slash-characters #\/) block-comment-characters-slash)
|
||||
|
||||
(production :pre-slash-characters () pre-slash-characters-empty)
|
||||
(production :pre-slash-characters (:block-comment-characters :non-terminator-or-asterisk-or-slash) pre-slash-characters-chars)
|
||||
(production :pre-slash-characters (:pre-slash-characters #\/) pre-slash-characters-slash)
|
||||
|
||||
(%charclass :non-terminator-or-slash)
|
||||
(%charclass :non-terminator-or-asterisk-or-slash)
|
||||
|
||||
(production :multi-line-block-comment (#\/ #\* :multi-line-block-comment-characters :block-comment-characters #\* #\/) multi-line-block-comment)
|
||||
|
||||
(production :multi-line-block-comment-characters (:block-comment-characters :line-terminator) multi-line-block-comment-characters-first)
|
||||
(production :multi-line-block-comment-characters (:multi-line-block-comment-characters :block-comment-characters :line-terminator)
|
||||
multi-line-block-comment-characters-rest)
|
||||
|
||||
(%section "White space")
|
||||
|
||||
(production :white-space () white-space-empty)
|
||||
(production :white-space (:white-space :white-space-character) white-space-character)
|
||||
(production :white-space (:white-space :single-line-block-comment) white-space-single-line-block-comment)
|
||||
(%charclass :white-space-character)
|
||||
|
||||
(%section "Line breaks")
|
||||
|
||||
(production :line-break (:line-terminator) line-break-line-terminator)
|
||||
(production :line-break (:line-comment :line-terminator) line-break-line-comment)
|
||||
(production :line-break (:multi-line-block-comment) line-break-multi-line-block-comment)
|
||||
(%charclass :line-terminator)
|
||||
|
||||
(production :line-breaks (:line-break) line-breaks-first)
|
||||
(production :line-breaks (:line-breaks :white-space :line-break) line-breaks-rest)
|
||||
|
||||
(%section "Tokens")
|
||||
|
||||
(declare-action token :next-token token)
|
||||
(production :next-token (:white-space :token) next-token
|
||||
(token (token :token)))
|
||||
|
||||
(declare-action token :token token)
|
||||
(production :token (:line-breaks) token-line-breaks
|
||||
(token (oneof line-breaks)))
|
||||
(production :token (:identifier-or-reserved-word) token-identifier-or-reserved-word
|
||||
(token (token :identifier-or-reserved-word)))
|
||||
(production :token (:punctuator) token-punctuator
|
||||
(token (oneof punctuator (punctuator :punctuator))))
|
||||
(production :token (:numeric-literal) token-numeric-literal
|
||||
(token (oneof number (float64-value :numeric-literal))))
|
||||
(production :token (:string-literal) token-string-literal
|
||||
(token (oneof string (string-value :string-literal))))
|
||||
(production :token (:end-of-input) token-end
|
||||
(token (oneof end)))
|
||||
|
||||
(production :end-of-input ($end) end-of-input-end)
|
||||
(production :end-of-input (:line-comment $end) end-of-input-line-comment)
|
||||
|
||||
(deftype token (oneof (identifier string) (reserved-word string) (punctuator string) (number float64) (string string) line-breaks end))
|
||||
(%print-actions)
|
||||
|
||||
(%section "Keywords")
|
||||
|
||||
(declare-action name :identifier-name string)
|
||||
(production :identifier-name (:identifier-letter) identifier-name-letter
|
||||
(name (vector (character-value :identifier-letter))))
|
||||
(production :identifier-name (:identifier-name :identifier-letter) identifier-name-next-letter
|
||||
(name (append (name :identifier-name) (vector (character-value :identifier-letter)))))
|
||||
(production :identifier-name (:identifier-name :decimal-digit) identifier-name-next-digit
|
||||
(name (append (name :identifier-name) (vector (character-value :decimal-digit)))))
|
||||
(%charclass :identifier-letter)
|
||||
(%charclass :decimal-digit)
|
||||
(%print-actions)
|
||||
|
||||
(define keywords (vector string)
|
||||
(vector "break" "case" "catch" "continue" "default" "delete" "do" "else" "finally" "for" "function" "if" "in"
|
||||
"new" "return" "switch" "this" "throw" "try" "typeof" "var" "void" "while" "with"))
|
||||
(define future-reserved-words (vector string)
|
||||
(vector "class" "const" "debugger" "enum" "export" "extends" "import" "super"))
|
||||
(define literals (vector string)
|
||||
(vector "null" "true" "false"))
|
||||
(define reserved-words (vector string)
|
||||
(append keywords (append future-reserved-words literals)))
|
||||
|
||||
(define (member (id string) (list (vector string))) boolean
|
||||
(if (empty list)
|
||||
false
|
||||
(let ((s string (nth list 0)))
|
||||
(if (string= id s)
|
||||
true
|
||||
(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
|
||||
(token (let ((id string (name :identifier-name)))
|
||||
(if (member id reserved-words)
|
||||
(oneof reserved-word id)
|
||||
(oneof identifier id)))))
|
||||
(%print-actions)
|
||||
|
||||
(%section "Punctuators")
|
||||
|
||||
(declare-action punctuator :punctuator string)
|
||||
(production :punctuator (#\=) punctuator-assignment (punctuator "="))
|
||||
(production :punctuator (#\>) punctuator-greater-than (punctuator ">"))
|
||||
(production :punctuator (#\<) punctuator-less-than (punctuator "<"))
|
||||
(production :punctuator (#\= #\=) punctuator-equal (punctuator "=="))
|
||||
(production :punctuator (#\= #\= #\=) punctuator-identical (punctuator "==="))
|
||||
(production :punctuator (#\< #\=) punctuator-less-than-or-equal (punctuator "<="))
|
||||
(production :punctuator (#\> #\=) punctuator-greater-than-or-equal (punctuator ">="))
|
||||
(production :punctuator (#\! #\=) punctuator-not-equal (punctuator "!="))
|
||||
(production :punctuator (#\! #\= #\=) punctuator-not-identical (punctuator "!=="))
|
||||
(production :punctuator (#\,) punctuator-comma (punctuator ","))
|
||||
(production :punctuator (#\!) punctuator-not (punctuator "!"))
|
||||
(production :punctuator (#\~) punctuator-complement (punctuator "~"))
|
||||
(production :punctuator (#\?) punctuator-question (punctuator "?"))
|
||||
(production :punctuator (#\:) punctuator-colon (punctuator ":"))
|
||||
(production :punctuator (#\.) punctuator-period (punctuator "."))
|
||||
(production :punctuator (#\& #\&) punctuator-logical-and (punctuator "&&"))
|
||||
(production :punctuator (#\| #\|) punctuator-logical-or (punctuator "||"))
|
||||
(production :punctuator (#\+ #\+) punctuator-increment (punctuator "++"))
|
||||
(production :punctuator (#\- #\-) punctuator-decrement (punctuator "--"))
|
||||
(production :punctuator (#\+) punctuator-plus (punctuator "+"))
|
||||
(production :punctuator (#\-) punctuator-minus (punctuator "-"))
|
||||
(production :punctuator (#\*) punctuator-times (punctuator "*"))
|
||||
(production :punctuator (#\/) punctuator-divide (punctuator "/"))
|
||||
(production :punctuator (#\&) punctuator-and (punctuator "&"))
|
||||
(production :punctuator (#\|) punctuator-or (punctuator "|"))
|
||||
(production :punctuator (#\^) punctuator-xor (punctuator "^"))
|
||||
(production :punctuator (#\%) punctuator-modulo (punctuator "%"))
|
||||
(production :punctuator (#\< #\<) punctuator-left-shift (punctuator "<<"))
|
||||
(production :punctuator (#\> #\>) punctuator-right-shift (punctuator ">>"))
|
||||
(production :punctuator (#\> #\> #\>) punctuator-logical-right-shift (punctuator ">>>"))
|
||||
(production :punctuator (#\+ #\=) punctuator-plus-equals (punctuator "+="))
|
||||
(production :punctuator (#\- #\=) punctuator-minus-equals (punctuator "-="))
|
||||
(production :punctuator (#\* #\=) punctuator-times-equals (punctuator "*="))
|
||||
(production :punctuator (#\/ #\=) punctuator-divide-equals (punctuator "/="))
|
||||
(production :punctuator (#\& #\=) punctuator-and-equals (punctuator "&="))
|
||||
(production :punctuator (#\| #\=) punctuator-or-equals (punctuator "|="))
|
||||
(production :punctuator (#\^ #\=) punctuator-xor-equals (punctuator "^="))
|
||||
(production :punctuator (#\% #\=) punctuator-modulo-equals (punctuator "%="))
|
||||
(production :punctuator (#\< #\< #\=) punctuator-left-shift-equals (punctuator "<<="))
|
||||
(production :punctuator (#\> #\> #\=) punctuator-right-shift-equals (punctuator ">>="))
|
||||
(production :punctuator (#\> #\> #\> #\=) punctuator-logical-right-shift-equals (punctuator ">>>="))
|
||||
(production :punctuator (#\() punctuator-open-parenthesis (punctuator "("))
|
||||
(production :punctuator (#\)) punctuator-close-parenthesis (punctuator ")"))
|
||||
(production :punctuator (#\{) punctuator-open-brace (punctuator "{"))
|
||||
(production :punctuator (#\}) punctuator-close-brace (punctuator "}"))
|
||||
(production :punctuator (#\[) punctuator-open-bracket (punctuator "["))
|
||||
(production :punctuator (#\]) punctuator-close-bracket (punctuator "]"))
|
||||
(production :punctuator (#\;) punctuator-semicolon (punctuator ";"))
|
||||
(%print-actions)
|
||||
|
||||
(%section "Numeric literals")
|
||||
|
||||
(declare-action float64-value :numeric-literal float64)
|
||||
(production :numeric-literal (:decimal-literal) numeric-literal-decimal
|
||||
(float64-value (rational-to-float64 (rational-value :decimal-literal))))
|
||||
(production :numeric-literal (:hex-integer-literal) numeric-literal-hex
|
||||
(float64-value (rational-to-float64 (integer-value :hex-integer-literal))))
|
||||
(production :numeric-literal (:octal-integer-literal) numeric-literal-octal
|
||||
(float64-value (rational-to-float64 (integer-value :octal-integer-literal))))
|
||||
(%print-actions)
|
||||
|
||||
(define (expt (base rational) (exponent integer)) rational
|
||||
(if (= exponent 0)
|
||||
1
|
||||
(if (< exponent 0)
|
||||
(rational/ 1 (expt base (neg exponent)))
|
||||
(rational* base (expt base (- exponent 1))))))
|
||||
|
||||
(declare-action rational-value :decimal-literal rational)
|
||||
(production :decimal-literal (:mantissa :exponent) decimal-literal
|
||||
(rational-value (rational* (rational-value :mantissa) (expt 10 (integer-value :exponent)))))
|
||||
|
||||
(declare-action rational-value :mantissa rational)
|
||||
(production :mantissa (:decimal-integer-literal) mantissa-integer
|
||||
(rational-value (integer-value :decimal-integer-literal)))
|
||||
(production :mantissa (:decimal-integer-literal #\.) mantissa-integer-dot
|
||||
(rational-value (integer-value :decimal-integer-literal)))
|
||||
(production :mantissa (:decimal-integer-literal #\. :fraction) mantissa-integer-dot-fraction
|
||||
(rational-value (rational+ (integer-value :decimal-integer-literal)
|
||||
(rational-value :fraction))))
|
||||
(production :mantissa (#\. :fraction) mantissa-dot-fraction
|
||||
(rational-value (rational-value :fraction)))
|
||||
|
||||
(declare-action integer-value :decimal-integer-literal integer)
|
||||
(production :decimal-integer-literal (#\0) decimal-integer-literal-0
|
||||
(integer-value 0))
|
||||
(production :decimal-integer-literal (:non-zero-decimal-digits) decimal-integer-literal-nonzero
|
||||
(integer-value (integer-value :non-zero-decimal-digits)))
|
||||
|
||||
(declare-action integer-value :non-zero-decimal-digits integer)
|
||||
(production :non-zero-decimal-digits (:non-zero-digit) non-zero-decimal-digits-first
|
||||
(integer-value (decimal-value :non-zero-digit)))
|
||||
(production :non-zero-decimal-digits (:non-zero-decimal-digits :decimal-digit) non-zero-decimal-digits-rest
|
||||
(integer-value (+ (* 10 (integer-value :non-zero-decimal-digits)) (decimal-value :decimal-digit))))
|
||||
|
||||
(%charclass :non-zero-digit)
|
||||
|
||||
(declare-action rational-value :fraction rational)
|
||||
(production :fraction (:decimal-digits) fraction-decimal-digits
|
||||
(rational-value (rational/ (integer-value :decimal-digits)
|
||||
(expt 10 (n-digits :decimal-digits)))))
|
||||
(%print-actions)
|
||||
|
||||
(declare-action integer-value :exponent integer)
|
||||
(production :exponent () exponent-none
|
||||
(integer-value 0))
|
||||
(production :exponent (:exponent-indicator :signed-integer) exponent-integer
|
||||
(integer-value (integer-value :signed-integer)))
|
||||
(%charclass :exponent-indicator)
|
||||
|
||||
(declare-action integer-value :signed-integer integer)
|
||||
(production :signed-integer (:decimal-digits) signed-integer-no-sign
|
||||
(integer-value (integer-value :decimal-digits)))
|
||||
(production :signed-integer (#\+ :decimal-digits) signed-integer-plus
|
||||
(integer-value (integer-value :decimal-digits)))
|
||||
(production :signed-integer (#\- :decimal-digits) signed-integer-minus
|
||||
(integer-value (neg (integer-value :decimal-digits))))
|
||||
(%print-actions)
|
||||
|
||||
(declare-action integer-value :decimal-digits integer)
|
||||
(declare-action n-digits :decimal-digits integer)
|
||||
(production :decimal-digits (:decimal-digit) decimal-digits-first
|
||||
(integer-value (decimal-value :decimal-digit))
|
||||
(n-digits 1))
|
||||
(production :decimal-digits (:decimal-digits :decimal-digit) decimal-digits-rest
|
||||
(integer-value (+ (* 10 (integer-value :decimal-digits)) (decimal-value :decimal-digit)))
|
||||
(n-digits (+ (n-digits :decimal-digits) 1)))
|
||||
(%print-actions)
|
||||
|
||||
(declare-action integer-value :hex-integer-literal integer)
|
||||
(production :hex-integer-literal (#\0 :hex-indicator :hex-digit) hex-integer-literal-first
|
||||
(integer-value (hex-value :hex-digit)))
|
||||
(production :hex-integer-literal (:hex-integer-literal :hex-digit) hex-integer-literal-rest
|
||||
(integer-value (+ (* 16 (integer-value :hex-integer-literal)) (hex-value :hex-digit))))
|
||||
(%charclass :hex-indicator)
|
||||
(%charclass :hex-digit)
|
||||
|
||||
(declare-action integer-value :octal-integer-literal integer)
|
||||
(production :octal-integer-literal (#\0 :octal-digit) octal-integer-literal-first
|
||||
(integer-value (octal-value :octal-digit)))
|
||||
(production :octal-integer-literal (:octal-integer-literal :octal-digit) octal-integer-literal-rest
|
||||
(integer-value (+ (* 8 (integer-value :octal-integer-literal)) (octal-value :octal-digit))))
|
||||
(%charclass :octal-digit)
|
||||
(%print-actions)
|
||||
|
||||
(%section "String literals")
|
||||
|
||||
(grammar-argument :quote single double)
|
||||
(declare-action string-value :string-literal string)
|
||||
(production :string-literal (#\' (:string-chars single) #\') string-literal-single
|
||||
(string-value (string-value :string-chars)))
|
||||
(production :string-literal (#\" (:string-chars double) #\") string-literal-double
|
||||
(string-value (string-value :string-chars)))
|
||||
(%print-actions)
|
||||
|
||||
(declare-action string-value (:string-chars :quote) string)
|
||||
(production (:string-chars :quote) ((:ordinary-string-chars :quote)) string-chars-ordinary
|
||||
(string-value (string-value :ordinary-string-chars)))
|
||||
(production (:string-chars :quote) ((:string-chars :quote) #\\ :short-octal-escape) string-chars-short-escape
|
||||
(string-value (append (string-value :string-chars)
|
||||
(vector (character-value :short-octal-escape)))))
|
||||
|
||||
(declare-action string-value (:ordinary-string-chars :quote) string)
|
||||
(production (:ordinary-string-chars :quote) () ordinary-string-chars-empty
|
||||
(string-value ""))
|
||||
(production (:ordinary-string-chars :quote) ((:string-chars :quote) :plain-string-char) ordinary-string-chars-char
|
||||
(string-value (append (string-value :string-chars)
|
||||
(vector (character-value :plain-string-char)))))
|
||||
(production (:ordinary-string-chars :quote) ((:string-chars :quote) (:plain-string-quote :quote)) ordinary-string-chars-quote
|
||||
(string-value (append (string-value :string-chars)
|
||||
(vector (character-value :plain-string-quote)))))
|
||||
(production (:ordinary-string-chars :quote) ((:ordinary-string-chars :quote) :octal-digit) ordinary-string-chars-octal
|
||||
(string-value (append (string-value :ordinary-string-chars)
|
||||
(vector (character-value :octal-digit)))))
|
||||
(production (:ordinary-string-chars :quote) ((:string-chars :quote) #\\ :ordinary-escape) ordinary-string-chars-escape
|
||||
(string-value (append (string-value :string-chars)
|
||||
(vector (character-value :ordinary-escape)))))
|
||||
|
||||
(%charclass :plain-string-char)
|
||||
|
||||
(declare-action character-value (:plain-string-quote :quote) character)
|
||||
(production (:plain-string-quote single) (#\") plain-string-quote-single
|
||||
(character-value #\"))
|
||||
(production (:plain-string-quote double) (#\') plain-string-quote-double
|
||||
(character-value #\'))
|
||||
(%print-actions)
|
||||
|
||||
(declare-action character-value :ordinary-escape character)
|
||||
(production :ordinary-escape (:string-char-escape) ordinary-escape-character
|
||||
(character-value (character-value :string-char-escape)))
|
||||
(production :ordinary-escape (:full-octal-escape) ordinary-escape-full-octal
|
||||
(character-value (character-value :full-octal-escape)))
|
||||
(production :ordinary-escape (:hex-escape) ordinary-escape-hex
|
||||
(character-value (character-value :hex-escape)))
|
||||
(production :ordinary-escape (:unicode-escape) ordinary-escape-unicode
|
||||
(character-value (character-value :unicode-escape)))
|
||||
(production :ordinary-escape (:string-non-escape) ordinary-escape-non-escape
|
||||
(character-value (character-value :string-non-escape)))
|
||||
(%charclass :string-non-escape)
|
||||
(%print-actions)
|
||||
|
||||
(declare-action character-value :string-char-escape character)
|
||||
(production :string-char-escape (#\') string-char-escape-single-quote (character-value #\'))
|
||||
(production :string-char-escape (#\") string-char-escape-double-quote (character-value #\"))
|
||||
(production :string-char-escape (#\\) string-char-escape-backslash (character-value #\\))
|
||||
(production :string-char-escape (#\b) string-char-escape-backspace (character-value #?0008))
|
||||
(production :string-char-escape (#\f) string-char-escape-form-feed (character-value #?000C))
|
||||
(production :string-char-escape (#\n) string-char-escape-new-line (character-value #?000A))
|
||||
(production :string-char-escape (#\r) string-char-escape-return (character-value #?000D))
|
||||
(production :string-char-escape (#\t) string-char-escape-tab (character-value #?0009))
|
||||
(production :string-char-escape (#\v) string-char-escape-vertical-tab (character-value #?000B))
|
||||
(%print-actions)
|
||||
|
||||
(declare-action character-value :short-octal-escape character)
|
||||
(production :short-octal-escape (:octal-digit) short-octal-escape-1
|
||||
(character-value (code-to-character (octal-value :octal-digit))))
|
||||
(production :short-octal-escape (:zero-to-three :octal-digit) short-octal-escape-2
|
||||
(character-value (code-to-character (+ (* 8 (octal-value :zero-to-three))
|
||||
(octal-value :octal-digit)))))
|
||||
|
||||
(declare-action character-value :full-octal-escape character)
|
||||
(production :full-octal-escape (:four-to-seven :octal-digit) full-octal-escape-2
|
||||
(character-value (code-to-character (+ (* 8 (octal-value :four-to-seven))
|
||||
(octal-value :octal-digit)))))
|
||||
(production :full-octal-escape (:zero-to-three :octal-digit :octal-digit) full-octal-escape-3
|
||||
(character-value (code-to-character (+ (+ (* 64 (octal-value :zero-to-three))
|
||||
(* 8 (octal-value :octal-digit 1)))
|
||||
(octal-value :octal-digit 2)))))
|
||||
(%charclass :zero-to-three)
|
||||
(%charclass :four-to-seven)
|
||||
|
||||
(declare-action character-value :hex-escape character)
|
||||
(production :hex-escape (#\x :hex-digit :hex-digit) hex-escape-2
|
||||
(character-value (code-to-character (+ (* 16 (hex-value :hex-digit 1))
|
||||
(hex-value :hex-digit 2)))))
|
||||
|
||||
(declare-action character-value :unicode-escape character)
|
||||
(production :unicode-escape (#\u :hex-digit :hex-digit :hex-digit :hex-digit) unicode-escape-4
|
||||
(character-value (code-to-character (+ (+ (+ (* 4096 (hex-value :hex-digit 1))
|
||||
(* 256 (hex-value :hex-digit 2)))
|
||||
(* 16 (hex-value :hex-digit 3)))
|
||||
(hex-value :hex-digit 4)))))
|
||||
(%print-actions)
|
||||
|
||||
)))
|
||||
|
||||
(defparameter *ll* (world-lexer *lw* 'code-lexer))
|
||||
(defparameter *lg* (lexer-grammar *ll*))
|
||||
(set-up-lexer-metagrammar *ll*)
|
||||
(defparameter *lm* (lexer-metagrammar *ll*)))
|
||||
|
||||
#|
|
||||
(depict-rtf-to-local-file
|
||||
"JSECMA/LexerCharClasses.rtf"
|
||||
"ECMAScript 1 Lexer Character Classes"
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-paragraph (rtf-stream ':grammar-header)
|
||||
(depict rtf-stream "Character Classes"))
|
||||
(dolist (charclass (lexer-charclasses *ll*))
|
||||
(depict-charclass rtf-stream charclass))
|
||||
(depict-paragraph (rtf-stream ':grammar-header)
|
||||
(depict rtf-stream "Grammar"))
|
||||
(depict-grammar rtf-stream *lg*)))
|
||||
|
||||
(depict-rtf-to-local-file
|
||||
"JSECMA/LexerSemantics.rtf"
|
||||
"ECMAScript 1 Lexer Semantics"
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *lw*)))
|
||||
|
||||
(depict-html-to-local-file
|
||||
"JSECMA/LexerSemantics.html"
|
||||
"ECMAScript 1 Lexer Semantics"
|
||||
t
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *lw*)))
|
||||
|
||||
(with-local-output (s "JSECMA/LexerGrammar.txt") (print-lexer *ll* s) (print-grammar *lg* s))
|
||||
|
||||
(print-illegal-strings m)
|
||||
|
||||
(lexer-pparse *ll* "0x20")
|
||||
(lexer-pparse *ll* "2b")
|
||||
(lexer-pparse *ll* " 3.75" :trace t)
|
||||
(lexer-pparse *ll* "25" :trace :code)
|
||||
(lexer-pmetaparse *ll* "32+abc//23e-a4*7e-2 3 id4 4ef;")
|
||||
(lexer-pmetaparse *ll* "32+abc//23e-a4*7e-2 3 id4 4ef;
|
||||
")
|
||||
(lexer-pmetaparse *ll* "32+abc/ /23e-a4*7e-2 3 /*id4 4*-/ef;
|
||||
|
||||
fjds*/y//z")
|
||||
(lexer-pmetaparse *ll* "3a+in'a+b\\147\"de'\"'\"")
|
||||
|#
|
||||
|
||||
|
||||
; Return the ECMAScript input string as a list of tokens like:
|
||||
; (($number . 3.0) + - ++ else ($string . "a+bgde") ($end))
|
||||
; Line breaks are removed.
|
||||
(defun tokenize (string)
|
||||
(delete
|
||||
'($line-breaks)
|
||||
(mapcar
|
||||
#'(lambda (token-value)
|
||||
(let ((token-value (car token-value)))
|
||||
(ecase (car token-value)
|
||||
(identifier (cons '$identifier (cdr token-value)))
|
||||
((reserved-word punctuator) (intern (string-upcase (cdr token-value))))
|
||||
(number (cons '$number (cdr token-value)))
|
||||
(string (cons '$string (cdr token-value)))
|
||||
(line-breaks '($line-breaks))
|
||||
(end '($end)))))
|
||||
(lexer-metaparse *ll* string))
|
||||
:test #'equal))
|
||||
|
||||
|
||||
@@ -1,863 +0,0 @@
|
||||
;;; The contents of this file are subject to the Mozilla Public
|
||||
;;; License Version 1.1 (the "License"); you may not use this file
|
||||
;;; except in compliance with the License. You may obtain a copy of
|
||||
;;; the License at http://www.mozilla.org/MPL/
|
||||
;;;
|
||||
;;; Software distributed under the License is distributed on an "AS
|
||||
;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
;;; implied. See the License for the specific language governing
|
||||
;;; rights and limitations under the License.
|
||||
;;;
|
||||
;;; The Original Code is the Language Design and Prototyping Environment.
|
||||
;;;
|
||||
;;; The Initial Developer of the Original Code is Netscape Communications
|
||||
;;; Corporation. Portions created by Netscape Communications Corporation are
|
||||
;;; Copyright (C) 1999 Netscape Communications Corporation. All
|
||||
;;; Rights Reserved.
|
||||
;;;
|
||||
;;; Contributor(s): Waldemar Horwat <waldemar@acm.org>
|
||||
|
||||
;;;
|
||||
;;; ECMAScript sample grammar portions
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
(declaim (optimize (debug 3)))
|
||||
|
||||
(progn
|
||||
(defparameter *gw*
|
||||
(generate-world
|
||||
"G"
|
||||
'((grammar code-grammar :lr-1 :program)
|
||||
|
||||
(%section "Types")
|
||||
|
||||
(deftype value (oneof undefined-value
|
||||
null-value
|
||||
(boolean-value boolean)
|
||||
(number-value float64)
|
||||
(string-value string)
|
||||
(object-value object)))
|
||||
(deftype object-or-null (oneof null-object-or-null (object-object-or-null object)))
|
||||
(deftype object (tuple (properties (address (vector property)))
|
||||
(typeof-name string)
|
||||
(prototype object-or-null)
|
||||
(get (-> (prop-name) value-or-exception))
|
||||
(put (-> (prop-name value) void-or-exception))
|
||||
(delete (-> (prop-name) boolean-or-exception))
|
||||
(call (-> (object-or-null (vector value)) reference-or-exception))
|
||||
(construct (-> ((vector value)) object-or-exception))
|
||||
(default-value (-> (default-value-hint) value-or-exception))))
|
||||
(deftype default-value-hint (oneof no-hint number-hint string-hint))
|
||||
(deftype property (tuple (name string) (read-only boolean) (enumerable boolean) (permanent boolean) (value (address value))))
|
||||
|
||||
(deftype prop-name string)
|
||||
(deftype place (tuple (base object) (property prop-name)))
|
||||
(deftype reference (oneof (value-reference value) (place-reference place) (virtual-reference prop-name)))
|
||||
|
||||
|
||||
(deftype integer-or-exception (oneof (normal integer) (abrupt exception)))
|
||||
(deftype void-or-exception (oneof normal (abrupt exception)))
|
||||
(deftype boolean-or-exception (oneof (normal boolean) (abrupt exception)))
|
||||
(deftype float64-or-exception (oneof (normal float64) (abrupt exception)))
|
||||
(deftype string-or-exception (oneof (normal string) (abrupt exception)))
|
||||
(deftype object-or-exception (oneof (normal object) (abrupt exception)))
|
||||
(deftype value-or-exception (oneof (normal value) (abrupt exception)))
|
||||
(deftype reference-or-exception (oneof (normal reference) (abrupt exception)))
|
||||
(deftype value-list-or-exception (oneof (normal (vector value)) (abrupt exception)))
|
||||
|
||||
(%section "Helper Functions")
|
||||
|
||||
(define (object-or-null-to-value (o object-or-null)) value
|
||||
(case o
|
||||
(null-object-or-null (oneof null-value))
|
||||
((object-object-or-null obj object) (oneof object-value obj))))
|
||||
|
||||
(define undefined-result value-or-exception
|
||||
(oneof normal (oneof undefined-value)))
|
||||
(define null-result value-or-exception
|
||||
(oneof normal (oneof null-value)))
|
||||
(define (boolean-result (b boolean)) value-or-exception
|
||||
(oneof normal (oneof boolean-value b)))
|
||||
(define (float64-result (d float64)) value-or-exception
|
||||
(oneof normal (oneof number-value d)))
|
||||
(define (integer-result (i integer)) value-or-exception
|
||||
(float64-result (rational-to-float64 i)))
|
||||
(define (string-result (s string)) value-or-exception
|
||||
(oneof normal (oneof string-value s)))
|
||||
(define (object-result (o object)) value-or-exception
|
||||
(oneof normal (oneof object-value o)))
|
||||
|
||||
(%section "Exceptions")
|
||||
|
||||
(deftype exception (oneof (exception value) (error error)))
|
||||
(deftype error (oneof coerce-to-primitive-error
|
||||
coerce-to-object-error
|
||||
get-value-error
|
||||
put-value-error
|
||||
delete-error))
|
||||
|
||||
(define (make-error (err error)) exception
|
||||
(oneof error err))
|
||||
|
||||
(%section "Objects")
|
||||
|
||||
|
||||
(%section "Conversions")
|
||||
|
||||
(define (reference-get-value (rv reference)) value-or-exception
|
||||
(case rv
|
||||
((value-reference v value) (oneof normal v))
|
||||
((place-reference r place) ((& get (& base r)) (& property r)))
|
||||
(virtual-reference (typed-oneof value-or-exception abrupt (make-error (oneof get-value-error))))))
|
||||
|
||||
(define (reference-put-value (rv reference) (v value)) void-or-exception
|
||||
(case rv
|
||||
(value-reference (typed-oneof void-or-exception abrupt (make-error (oneof put-value-error))))
|
||||
((place-reference r place) ((& put (& base r)) (& property r) v))
|
||||
(virtual-reference (bottom))))
|
||||
|
||||
(%section "Coercions")
|
||||
|
||||
(define (coerce-to-boolean (v value)) boolean
|
||||
(case v
|
||||
(((undefined-value null-value)) false)
|
||||
((boolean-value b boolean) b)
|
||||
((number-value d float64) (not (or (float64-is-zero d) (float64-is-na-n d))))
|
||||
((string-value s string) (/= (length s) 0))
|
||||
(object-value true)))
|
||||
|
||||
(define (coerce-boolean-to-float64 (b boolean)) float64
|
||||
(if b 1.0 0.0))
|
||||
|
||||
(define (coerce-to-float64 (v value)) float64-or-exception
|
||||
(case v
|
||||
(undefined-value (oneof normal nan))
|
||||
(null-value (oneof normal 0.0))
|
||||
((boolean-value b boolean) (oneof normal (coerce-boolean-to-float64 b)))
|
||||
((number-value d float64) (oneof normal d))
|
||||
(string-value (bottom))
|
||||
(object-value (bottom))))
|
||||
|
||||
(define (float64-to-uint32 (x float64)) integer
|
||||
(if (or (float64-is-na-n x) (float64-is-infinite x))
|
||||
0
|
||||
(mod (truncate-float64 x) #x100000000)))
|
||||
|
||||
(define (coerce-to-uint32 (v value)) integer-or-exception
|
||||
(letexc (d float64 (coerce-to-float64 v))
|
||||
(oneof normal (float64-to-uint32 d))))
|
||||
|
||||
(define (coerce-to-int32 (v value)) integer-or-exception
|
||||
(letexc (d float64 (coerce-to-float64 v))
|
||||
(oneof normal (uint32-to-int32 (float64-to-uint32 d)))))
|
||||
|
||||
(define (uint32-to-int32 (ui integer)) integer
|
||||
(if (< ui #x80000000)
|
||||
ui
|
||||
(- ui #x100000000)))
|
||||
|
||||
(define (coerce-to-string (v value)) string-or-exception
|
||||
(case v
|
||||
(undefined-value (oneof normal "undefined"))
|
||||
(null-value (oneof normal "null"))
|
||||
((boolean-value b boolean) (if b (oneof normal "true") (oneof normal "false")))
|
||||
(number-value (bottom))
|
||||
((string-value s string) (oneof normal s))
|
||||
(object-value (bottom))))
|
||||
|
||||
(define (coerce-to-primitive (v value) (hint default-value-hint)) value-or-exception
|
||||
(case v
|
||||
(((undefined-value null-value boolean-value number-value string-value)) (oneof normal v))
|
||||
((object-value o object)
|
||||
(letexc (pv value ((& default-value o) hint))
|
||||
(case pv
|
||||
(((undefined-value null-value boolean-value number-value string-value)) (oneof normal pv))
|
||||
(object-value (typed-oneof value-or-exception abrupt (make-error (oneof coerce-to-primitive-error)))))))))
|
||||
|
||||
(define (coerce-to-object (v value)) object-or-exception
|
||||
(case v
|
||||
(((undefined-value null-value)) (typed-oneof object-or-exception abrupt (make-error (oneof coerce-to-object-error))))
|
||||
(boolean-value (bottom))
|
||||
(number-value (bottom))
|
||||
(string-value (bottom))
|
||||
((object-value o object) (oneof normal o))))
|
||||
|
||||
(%section "Environments")
|
||||
|
||||
(deftype env (tuple (this object-or-null)))
|
||||
(define (lookup-identifier (e env :unused) (id string :unused)) reference-or-exception
|
||||
(bottom))
|
||||
|
||||
(%section "Terminal Actions")
|
||||
|
||||
(declare-action eval-identifier $identifier string)
|
||||
(declare-action eval-number $number float64)
|
||||
(declare-action eval-string $string string)
|
||||
|
||||
(terminal-action eval-identifier $identifier cdr)
|
||||
(terminal-action eval-number $number cdr)
|
||||
(terminal-action eval-string $string cdr)
|
||||
(%print-actions)
|
||||
|
||||
(%section "Primary Expressions")
|
||||
|
||||
(declare-action eval :primary-rvalue (-> (env) value-or-exception))
|
||||
(production :primary-rvalue (this) primary-rvalue-this
|
||||
((eval (e env))
|
||||
(oneof normal (object-or-null-to-value (& this e)))))
|
||||
(production :primary-rvalue (null) primary-rvalue-null
|
||||
((eval (e env :unused))
|
||||
null-result))
|
||||
(production :primary-rvalue (true) primary-rvalue-true
|
||||
((eval (e env :unused))
|
||||
(boolean-result true)))
|
||||
(production :primary-rvalue (false) primary-rvalue-false
|
||||
((eval (e env :unused))
|
||||
(boolean-result false)))
|
||||
(production :primary-rvalue ($number) primary-rvalue-number
|
||||
((eval (e env :unused))
|
||||
(float64-result (eval-number $number))))
|
||||
(production :primary-rvalue ($string) primary-rvalue-string
|
||||
((eval (e env :unused))
|
||||
(string-result (eval-string $string))))
|
||||
(production :primary-rvalue (\( (:comma-expression no-l-value) \)) primary-rvalue-parentheses
|
||||
(eval (eval :comma-expression)))
|
||||
|
||||
(declare-action eval :primary-lvalue (-> (env) reference-or-exception))
|
||||
(production :primary-lvalue ($identifier) primary-lvalue-identifier
|
||||
((eval (e env))
|
||||
(lookup-identifier e (eval-identifier $identifier))))
|
||||
(production :primary-lvalue (\( :lvalue \)) primary-lvalue-parentheses
|
||||
(eval (eval :lvalue)))
|
||||
(%print-actions)
|
||||
|
||||
(%section "Left-Side Expressions")
|
||||
|
||||
(grammar-argument :expr-kind any-value no-l-value)
|
||||
(grammar-argument :member-expr-kind call no-call)
|
||||
|
||||
(declare-action eval (:member-lvalue :member-expr-kind) (-> (env) reference-or-exception))
|
||||
(production (:member-lvalue no-call) (:primary-lvalue) member-lvalue-primary-lvalue
|
||||
(eval (eval :primary-lvalue)))
|
||||
(production (:member-lvalue call) (:lvalue :arguments) member-lvalue-call-member-lvalue
|
||||
((eval (e env))
|
||||
(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 f-reference
|
||||
(((value-reference virtual-reference)) (oneof null-object-or-null))
|
||||
((place-reference p place) (oneof object-object-or-null (& base p))))))
|
||||
(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 (f value ((eval :member-expression) e))
|
||||
(letexc (arguments (vector value) ((eval :arguments) e))
|
||||
(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))
|
||||
(letexc (property value ((eval :expression) e))
|
||||
(read-property container property)))))
|
||||
(production (:member-lvalue :member-expr-kind) ((:member-expression :member-expr-kind any-value) \. $identifier) member-lvalue-property
|
||||
((eval (e env))
|
||||
(letexc (container value ((eval :member-expression) e))
|
||||
(read-property container (oneof string-value (eval-identifier $identifier))))))
|
||||
|
||||
(declare-action eval (:member-expression :member-expr-kind :expr-kind) (-> (env) value-or-exception))
|
||||
(%rule (:member-expression no-call no-l-value))
|
||||
(%rule (:member-expression no-call any-value))
|
||||
(%rule (:member-expression call any-value))
|
||||
(production (:member-expression no-call :expr-kind) (:primary-rvalue) member-expression-primary-rvalue
|
||||
(eval (eval :primary-rvalue)))
|
||||
(production (:member-expression :member-expr-kind any-value) ((:member-lvalue :member-expr-kind)) member-expression-member-lvalue
|
||||
((eval (e env))
|
||||
(letexc (ref reference ((eval :member-lvalue) e))
|
||||
(reference-get-value ref))))
|
||||
(production (:member-expression no-call :expr-kind) (new (:member-expression no-call any-value) :arguments) member-expression-new
|
||||
((eval (e env))
|
||||
(letexc (constructor value ((eval :member-expression) e))
|
||||
(letexc (arguments (vector value) ((eval :arguments) e))
|
||||
(construct-object constructor arguments)))))
|
||||
|
||||
(declare-action eval (:new-expression :expr-kind) (-> (env) value-or-exception))
|
||||
(production (:new-expression :expr-kind) ((:member-expression no-call :expr-kind)) new-expression-member-expression
|
||||
(eval (eval :member-expression)))
|
||||
(production (:new-expression :expr-kind) (new (:new-expression any-value)) new-expression-new
|
||||
((eval (e env))
|
||||
(letexc (constructor value ((eval :new-expression) e))
|
||||
(construct-object constructor (vector-of value)))))
|
||||
|
||||
(declare-action eval :arguments (-> (env) value-list-or-exception))
|
||||
(production :arguments (\( \)) arguments-empty
|
||||
((eval (e env :unused))
|
||||
(oneof normal (vector-of value))))
|
||||
(production :arguments (\( :argument-list \)) arguments-list
|
||||
(eval (eval :argument-list)))
|
||||
|
||||
(declare-action eval :argument-list (-> (env) value-list-or-exception))
|
||||
(production :argument-list ((:assignment-expression any-value)) argument-list-one
|
||||
((eval (e env))
|
||||
(letexc (arg value ((eval :assignment-expression) e))
|
||||
(oneof normal (vector arg)))))
|
||||
(production :argument-list (:argument-list \, (:assignment-expression any-value)) argument-list-more
|
||||
((eval (e env))
|
||||
(letexc (args (vector value) ((eval :argument-list) e))
|
||||
(letexc (arg value ((eval :assignment-expression) e))
|
||||
(oneof normal (append args (vector arg)))))))
|
||||
|
||||
(declare-action eval :lvalue (-> (env) reference-or-exception))
|
||||
(production :lvalue ((:member-lvalue call)) lvalue-member-lvalue-call
|
||||
(eval (eval :member-lvalue)))
|
||||
(production :lvalue ((:member-lvalue no-call)) lvalue-member-lvalue-no-call
|
||||
(eval (eval :member-lvalue)))
|
||||
(%print-actions)
|
||||
|
||||
(define (read-property (container value) (property value)) reference-or-exception
|
||||
(letexc (obj object (coerce-to-object container))
|
||||
(letexc (name prop-name (coerce-to-string property))
|
||||
(oneof normal (oneof place-reference (tuple place obj name))))))
|
||||
|
||||
(define (call-object (f value) (this object-or-null) (arguments (vector value))) reference-or-exception
|
||||
(case f
|
||||
(((undefined-value null-value boolean-value number-value string-value))
|
||||
(typed-oneof reference-or-exception abrupt (make-error (oneof coerce-to-object-error))))
|
||||
((object-value o object)
|
||||
((& call o) this arguments))))
|
||||
|
||||
(define (construct-object (constructor value) (arguments (vector value))) value-or-exception
|
||||
(case constructor
|
||||
(((undefined-value null-value boolean-value number-value string-value))
|
||||
(typed-oneof value-or-exception abrupt (make-error (oneof coerce-to-object-error))))
|
||||
((object-value o object)
|
||||
(letexc (res object ((& construct o) arguments))
|
||||
(object-result res)))))
|
||||
|
||||
(%section "Postfix Expressions")
|
||||
|
||||
(declare-action eval (:postfix-expression :expr-kind) (-> (env) value-or-exception))
|
||||
(production (:postfix-expression :expr-kind) ((:new-expression :expr-kind)) postfix-expression-new
|
||||
(eval (eval :new-expression)))
|
||||
(production (:postfix-expression any-value) ((:member-expression call any-value)) postfix-expression-member-expression-call
|
||||
(eval (eval :member-expression)))
|
||||
(production (:postfix-expression :expr-kind) (:lvalue ++) postfix-expression-increment
|
||||
((eval (e env))
|
||||
(letexc (operand-reference reference ((eval :lvalue) e))
|
||||
(letexc (operand-value value (reference-get-value operand-reference))
|
||||
(letexc (operand float64 (coerce-to-float64 operand-value))
|
||||
(letexc (u void (reference-put-value operand-reference (oneof number-value (float64-add operand 1.0)))
|
||||
:unused)
|
||||
(float64-result operand)))))))
|
||||
(production (:postfix-expression :expr-kind) (:lvalue --) postfix-expression-decrement
|
||||
((eval (e env))
|
||||
(letexc (operand-reference reference ((eval :lvalue) e))
|
||||
(letexc (operand-value value (reference-get-value operand-reference))
|
||||
(letexc (operand float64 (coerce-to-float64 operand-value))
|
||||
(letexc (u void (reference-put-value operand-reference (oneof number-value (float64-subtract operand 1.0)))
|
||||
:unused)
|
||||
(float64-result operand)))))))
|
||||
(%print-actions)
|
||||
|
||||
(%section "Unary Operators")
|
||||
|
||||
(declare-action eval (:unary-expression :expr-kind) (-> (env) value-or-exception))
|
||||
(production (:unary-expression :expr-kind) ((:postfix-expression :expr-kind)) unary-expression-postfix
|
||||
(eval (eval :postfix-expression)))
|
||||
(production (:unary-expression :expr-kind) (delete :lvalue) unary-expression-delete
|
||||
((eval (e env))
|
||||
(letexc (rv reference ((eval :lvalue) e))
|
||||
(case rv
|
||||
(value-reference (typed-oneof value-or-exception abrupt (make-error (oneof delete-error))))
|
||||
((place-reference r place)
|
||||
(letexc (b boolean ((& delete (& base r)) (& property r)))
|
||||
(boolean-result b)))
|
||||
(virtual-reference (boolean-result true))))))
|
||||
(production (:unary-expression :expr-kind) (void (:unary-expression any-value)) unary-expression-void
|
||||
((eval (e env))
|
||||
(letexc (operand value ((eval :unary-expression) e) :unused)
|
||||
undefined-result)))
|
||||
(production (:unary-expression :expr-kind) (typeof :lvalue) unary-expression-typeof-lvalue
|
||||
((eval (e env))
|
||||
(letexc (rv reference ((eval :lvalue) e))
|
||||
(case rv
|
||||
((value-reference v value) (string-result (value-typeof v)))
|
||||
((place-reference r place)
|
||||
(letexc (v value ((& get (& base r)) (& property r)))
|
||||
(string-result (value-typeof v))))
|
||||
(virtual-reference (string-result "undefined"))))))
|
||||
(production (:unary-expression :expr-kind) (typeof (:unary-expression no-l-value)) unary-expression-typeof-expression
|
||||
((eval (e env))
|
||||
(letexc (v value ((eval :unary-expression) e))
|
||||
(string-result (value-typeof v)))))
|
||||
(production (:unary-expression :expr-kind) (++ :lvalue) unary-expression-increment
|
||||
((eval (e env))
|
||||
(letexc (operand-reference reference ((eval :lvalue) e))
|
||||
(letexc (operand-value value (reference-get-value operand-reference))
|
||||
(letexc (operand float64 (coerce-to-float64 operand-value))
|
||||
(let ((res float64 (float64-add operand 1.0)))
|
||||
(letexc (u void (reference-put-value operand-reference (oneof number-value res)) :unused)
|
||||
(float64-result res))))))))
|
||||
(production (:unary-expression :expr-kind) (-- :lvalue) unary-expression-decrement
|
||||
((eval (e env))
|
||||
(letexc (operand-reference reference ((eval :lvalue) e))
|
||||
(letexc (operand-value value (reference-get-value operand-reference))
|
||||
(letexc (operand float64 (coerce-to-float64 operand-value))
|
||||
(let ((res float64 (float64-subtract operand 1.0)))
|
||||
(letexc (u void (reference-put-value operand-reference (oneof number-value res)) :unused)
|
||||
(float64-result res))))))))
|
||||
(production (:unary-expression :expr-kind) (+ (:unary-expression any-value)) unary-expression-plus
|
||||
((eval (e env))
|
||||
(letexc (operand-value value ((eval :unary-expression) e))
|
||||
(letexc (operand float64 (coerce-to-float64 operand-value))
|
||||
(float64-result operand)))))
|
||||
(production (:unary-expression :expr-kind) (- (:unary-expression any-value)) unary-expression-minus
|
||||
((eval (e env))
|
||||
(letexc (operand-value value ((eval :unary-expression) e))
|
||||
(letexc (operand float64 (coerce-to-float64 operand-value))
|
||||
(float64-result (float64-negate operand))))))
|
||||
(production (:unary-expression :expr-kind) (~ (:unary-expression any-value)) unary-expression-bitwise-not
|
||||
((eval (e env))
|
||||
(letexc (operand-value value ((eval :unary-expression) e))
|
||||
(letexc (operand integer (coerce-to-int32 operand-value))
|
||||
(integer-result (bitwise-xor operand -1))))))
|
||||
(production (:unary-expression :expr-kind) (! (:unary-expression any-value)) unary-expression-logical-not
|
||||
((eval (e env))
|
||||
(letexc (operand-value value ((eval :unary-expression) e))
|
||||
(boolean-result (not (coerce-to-boolean operand-value))))))
|
||||
(%print-actions)
|
||||
|
||||
(define (value-typeof (v value)) string
|
||||
(case v
|
||||
(undefined-value "undefined")
|
||||
(null-value "object")
|
||||
(boolean-value "boolean")
|
||||
(number-value "number")
|
||||
(string-value "string")
|
||||
((object-value o object) (& typeof-name o))))
|
||||
|
||||
(%section "Multiplicative Operators")
|
||||
|
||||
(declare-action eval (:multiplicative-expression :expr-kind) (-> (env) value-or-exception))
|
||||
(production (:multiplicative-expression :expr-kind) ((:unary-expression :expr-kind)) multiplicative-expression-unary
|
||||
(eval (eval :unary-expression)))
|
||||
(production (:multiplicative-expression :expr-kind) ((:multiplicative-expression any-value) * (:unary-expression any-value)) multiplicative-expression-multiply
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :multiplicative-expression) e))
|
||||
(letexc (right-value value ((eval :unary-expression) e))
|
||||
(apply-binary-float64-operator float64-multiply left-value right-value)))))
|
||||
(production (:multiplicative-expression :expr-kind) ((:multiplicative-expression any-value) / (:unary-expression any-value)) multiplicative-expression-divide
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :multiplicative-expression) e))
|
||||
(letexc (right-value value ((eval :unary-expression) e))
|
||||
(apply-binary-float64-operator float64-divide left-value right-value)))))
|
||||
(production (:multiplicative-expression :expr-kind) ((:multiplicative-expression any-value) % (:unary-expression any-value)) multiplicative-expression-remainder
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :multiplicative-expression) e))
|
||||
(letexc (right-value value ((eval :unary-expression) e))
|
||||
(apply-binary-float64-operator float64-remainder left-value right-value)))))
|
||||
(%print-actions)
|
||||
|
||||
(define (apply-binary-float64-operator (operator (-> (float64 float64) float64)) (left-value value) (right-value value)) value-or-exception
|
||||
(letexc (left-number float64 (coerce-to-float64 left-value))
|
||||
(letexc (right-number float64 (coerce-to-float64 right-value))
|
||||
(float64-result (operator left-number right-number)))))
|
||||
|
||||
(%section "Additive Operators")
|
||||
|
||||
(declare-action eval (:additive-expression :expr-kind) (-> (env) value-or-exception))
|
||||
(production (:additive-expression :expr-kind) ((:multiplicative-expression :expr-kind)) additive-expression-multiplicative
|
||||
(eval (eval :multiplicative-expression)))
|
||||
(production (:additive-expression :expr-kind) ((:additive-expression any-value) + (:multiplicative-expression any-value)) additive-expression-add
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :additive-expression) e))
|
||||
(letexc (right-value value ((eval :multiplicative-expression) e))
|
||||
(letexc (left-primitive value (coerce-to-primitive left-value (oneof no-hint)))
|
||||
(letexc (right-primitive value (coerce-to-primitive right-value (oneof no-hint)))
|
||||
(if (or (is string-value left-primitive) (is string-value right-primitive))
|
||||
(letexc (left-string string (coerce-to-string left-primitive))
|
||||
(letexc (right-string string (coerce-to-string right-primitive))
|
||||
(string-result (append left-string right-string))))
|
||||
(apply-binary-float64-operator float64-add left-primitive right-primitive))))))))
|
||||
(production (:additive-expression :expr-kind) ((:additive-expression any-value) - (:multiplicative-expression any-value)) additive-expression-subtract
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :additive-expression) e))
|
||||
(letexc (right-value value ((eval :multiplicative-expression) e))
|
||||
(apply-binary-float64-operator float64-subtract left-value right-value)))))
|
||||
(%print-actions)
|
||||
|
||||
(%section "Bitwise Shift Operators")
|
||||
|
||||
(declare-action eval (:shift-expression :expr-kind) (-> (env) value-or-exception))
|
||||
(production (:shift-expression :expr-kind) ((:additive-expression :expr-kind)) shift-expression-additive
|
||||
(eval (eval :additive-expression)))
|
||||
(production (:shift-expression :expr-kind) ((:shift-expression any-value) << (:additive-expression any-value)) shift-expression-left
|
||||
((eval (e env))
|
||||
(letexc (bitmap-value value ((eval :shift-expression) e))
|
||||
(letexc (count-value value ((eval :additive-expression) e))
|
||||
(letexc (bitmap integer (coerce-to-uint32 bitmap-value))
|
||||
(letexc (count integer (coerce-to-uint32 count-value))
|
||||
(integer-result (uint32-to-int32 (bitwise-and (bitwise-shift bitmap (bitwise-and count #x1F))
|
||||
#xFFFFFFFF)))))))))
|
||||
(production (:shift-expression :expr-kind) ((:shift-expression any-value) >> (:additive-expression any-value)) shift-expression-right-signed
|
||||
((eval (e env))
|
||||
(letexc (bitmap-value value ((eval :shift-expression) e))
|
||||
(letexc (count-value value ((eval :additive-expression) e))
|
||||
(letexc (bitmap integer (coerce-to-int32 bitmap-value))
|
||||
(letexc (count integer (coerce-to-uint32 count-value))
|
||||
(integer-result (bitwise-shift bitmap (neg (bitwise-and count #x1F))))))))))
|
||||
(production (:shift-expression :expr-kind) ((:shift-expression any-value) >>> (:additive-expression any-value)) shift-expression-right-unsigned
|
||||
((eval (e env))
|
||||
(letexc (bitmap-value value ((eval :shift-expression) e))
|
||||
(letexc (count-value value ((eval :additive-expression) e))
|
||||
(letexc (bitmap integer (coerce-to-uint32 bitmap-value))
|
||||
(letexc (count integer (coerce-to-uint32 count-value))
|
||||
(integer-result (bitwise-shift bitmap (neg (bitwise-and count #x1F))))))))))
|
||||
(%print-actions)
|
||||
|
||||
(%section "Relational Operators")
|
||||
|
||||
(declare-action eval (:relational-expression :expr-kind) (-> (env) value-or-exception))
|
||||
(production (:relational-expression :expr-kind) ((:shift-expression :expr-kind)) relational-expression-shift
|
||||
(eval (eval :shift-expression)))
|
||||
(production (:relational-expression :expr-kind) ((:relational-expression any-value) < (:shift-expression any-value)) relational-expression-less
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :relational-expression) e))
|
||||
(letexc (right-value value ((eval :shift-expression) e))
|
||||
(order-values left-value right-value true false)))))
|
||||
(production (:relational-expression :expr-kind) ((:relational-expression any-value) > (:shift-expression any-value)) relational-expression-greater
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :relational-expression) e))
|
||||
(letexc (right-value value ((eval :shift-expression) e))
|
||||
(order-values right-value left-value true false)))))
|
||||
(production (:relational-expression :expr-kind) ((:relational-expression any-value) <= (:shift-expression any-value)) relational-expression-less-or-equal
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :relational-expression) e))
|
||||
(letexc (right-value value ((eval :shift-expression) e))
|
||||
(order-values right-value left-value false true)))))
|
||||
(production (:relational-expression :expr-kind) ((:relational-expression any-value) >= (:shift-expression any-value)) relational-expression-greater-or-equal
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :relational-expression) e))
|
||||
(letexc (right-value value ((eval :shift-expression) e))
|
||||
(order-values left-value right-value false true)))))
|
||||
(%print-actions)
|
||||
|
||||
(define (order-values (left-value value) (right-value value) (less boolean) (greater-or-equal boolean)) value-or-exception
|
||||
(letexc (left-primitive value (coerce-to-primitive left-value (oneof number-hint)))
|
||||
(letexc (right-primitive value (coerce-to-primitive right-value (oneof number-hint)))
|
||||
(if (and (is string-value left-primitive) (is string-value right-primitive))
|
||||
(boolean-result
|
||||
(compare-strings (select string-value left-primitive) (select string-value right-primitive) less greater-or-equal greater-or-equal))
|
||||
(letexc (left-number float64 (coerce-to-float64 left-primitive))
|
||||
(letexc (right-number float64 (coerce-to-float64 right-primitive))
|
||||
(boolean-result (float64-compare left-number right-number less greater-or-equal greater-or-equal false))))))))
|
||||
|
||||
(define (compare-strings (left string) (right string) (less boolean) (equal boolean) (greater boolean)) boolean
|
||||
(if (and (empty left) (empty right))
|
||||
equal
|
||||
(if (empty left)
|
||||
less
|
||||
(if (empty right)
|
||||
greater
|
||||
(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 (subseq left 1) (subseq right 1) less equal greater))))))))
|
||||
|
||||
(%section "Equality Operators")
|
||||
|
||||
(declare-action eval (:equality-expression :expr-kind) (-> (env) value-or-exception))
|
||||
(production (:equality-expression :expr-kind) ((:relational-expression :expr-kind)) equality-expression-relational
|
||||
(eval (eval :relational-expression)))
|
||||
(production (:equality-expression :expr-kind) ((:equality-expression any-value) == (:relational-expression any-value)) equality-expression-equal
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :equality-expression) e))
|
||||
(letexc (right-value value ((eval :relational-expression) e))
|
||||
(letexc (eq boolean (compare-values left-value right-value))
|
||||
(boolean-result eq))))))
|
||||
(production (:equality-expression :expr-kind) ((:equality-expression any-value) != (:relational-expression any-value)) equality-expression-not-equal
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :equality-expression) e))
|
||||
(letexc (right-value value ((eval :relational-expression) e))
|
||||
(letexc (eq boolean (compare-values left-value right-value))
|
||||
(boolean-result (not eq)))))))
|
||||
(production (:equality-expression :expr-kind) ((:equality-expression any-value) === (:relational-expression any-value)) equality-expression-strict-equal
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :equality-expression) e))
|
||||
(letexc (right-value value ((eval :relational-expression) e))
|
||||
(boolean-result (strict-compare-values left-value right-value))))))
|
||||
(production (:equality-expression :expr-kind) ((:equality-expression any-value) !== (:relational-expression any-value)) equality-expression-strict-not-equal
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :equality-expression) e))
|
||||
(letexc (right-value value ((eval :relational-expression) e))
|
||||
(boolean-result (not (strict-compare-values left-value right-value)))))))
|
||||
(%print-actions)
|
||||
|
||||
(define (compare-values (left-value value) (right-value value)) boolean-or-exception
|
||||
(case left-value
|
||||
(((undefined-value null-value))
|
||||
(case right-value
|
||||
(((undefined-value null-value)) (oneof normal true))
|
||||
(((boolean-value number-value string-value object-value)) (oneof normal false))))
|
||||
((boolean-value left-bool boolean)
|
||||
(case right-value
|
||||
(((undefined-value null-value)) (oneof normal false))
|
||||
((boolean-value right-bool boolean) (oneof normal (not (xor left-bool right-bool))))
|
||||
(((number-value string-value object-value))
|
||||
(compare-float64-to-value (coerce-boolean-to-float64 left-bool) right-value))))
|
||||
((number-value left-number float64)
|
||||
(compare-float64-to-value left-number right-value))
|
||||
((string-value left-str string)
|
||||
(case right-value
|
||||
(((undefined-value null-value)) (oneof normal false))
|
||||
((boolean-value right-bool boolean)
|
||||
(letexc (left-number float64 (coerce-to-float64 left-value))
|
||||
(oneof normal (float64-equal left-number (coerce-boolean-to-float64 right-bool)))))
|
||||
((number-value right-number float64)
|
||||
(letexc (left-number float64 (coerce-to-float64 left-value))
|
||||
(oneof normal (float64-equal left-number right-number))))
|
||||
((string-value right-str string)
|
||||
(oneof normal (compare-strings left-str right-str false true false)))
|
||||
(object-value
|
||||
(letexc (right-primitive value (coerce-to-primitive right-value (oneof no-hint)))
|
||||
(compare-values left-value right-primitive)))))
|
||||
((object-value left-obj object)
|
||||
(case right-value
|
||||
(((undefined-value null-value)) (oneof normal false))
|
||||
((boolean-value right-bool boolean)
|
||||
(letexc (left-primitive value (coerce-to-primitive left-value (oneof no-hint)))
|
||||
(compare-values left-primitive (oneof number-value (coerce-boolean-to-float64 right-bool)))))
|
||||
(((number-value string-value))
|
||||
(letexc (left-primitive value (coerce-to-primitive left-value (oneof no-hint)))
|
||||
(compare-values left-primitive right-value)))
|
||||
((object-value right-obj object)
|
||||
(oneof normal (address-equal (& properties left-obj) (& properties right-obj))))))))
|
||||
|
||||
(define (compare-float64-to-value (left-number float64) (right-value value)) boolean-or-exception
|
||||
(case right-value
|
||||
(((undefined-value null-value)) (oneof normal false))
|
||||
(((boolean-value number-value string-value))
|
||||
(letexc (right-number float64 (coerce-to-float64 right-value))
|
||||
(oneof normal (float64-equal left-number right-number))))
|
||||
(object-value
|
||||
(letexc (right-primitive value (coerce-to-primitive right-value (oneof no-hint)))
|
||||
(compare-float64-to-value left-number right-primitive)))))
|
||||
|
||||
(define (float64-equal (x float64) (y float64)) boolean
|
||||
(float64-compare x y false true false false))
|
||||
|
||||
(define (strict-compare-values (left-value value) (right-value value)) boolean
|
||||
(case left-value
|
||||
(undefined-value
|
||||
(is undefined-value right-value))
|
||||
(null-value
|
||||
(is null-value right-value))
|
||||
((boolean-value left-bool boolean)
|
||||
(case right-value
|
||||
((boolean-value right-bool boolean) (not (xor left-bool right-bool)))
|
||||
(((undefined-value null-value number-value string-value object-value)) false)))
|
||||
((number-value left-number float64)
|
||||
(case right-value
|
||||
((number-value right-number float64) (float64-equal left-number right-number))
|
||||
(((undefined-value null-value boolean-value string-value object-value)) false)))
|
||||
((string-value left-str string)
|
||||
(case right-value
|
||||
((string-value right-str string)
|
||||
(compare-strings left-str right-str false true false))
|
||||
(((undefined-value null-value boolean-value number-value object-value)) false)))
|
||||
((object-value left-obj object)
|
||||
(case right-value
|
||||
((object-value right-obj object)
|
||||
(address-equal (& properties left-obj) (& properties right-obj)))
|
||||
(((undefined-value null-value boolean-value number-value string-value)) false)))))
|
||||
|
||||
(%section "Binary Bitwise Operators")
|
||||
|
||||
(declare-action eval (:bitwise-and-expression :expr-kind) (-> (env) value-or-exception))
|
||||
(production (:bitwise-and-expression :expr-kind) ((:equality-expression :expr-kind)) bitwise-and-expression-equality
|
||||
(eval (eval :equality-expression)))
|
||||
(production (:bitwise-and-expression :expr-kind) ((:bitwise-and-expression any-value) & (:equality-expression any-value)) bitwise-and-expression-and
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :bitwise-and-expression) e))
|
||||
(letexc (right-value value ((eval :equality-expression) e))
|
||||
(apply-binary-bitwise-operator bitwise-and left-value right-value)))))
|
||||
|
||||
(declare-action eval (:bitwise-xor-expression :expr-kind) (-> (env) value-or-exception))
|
||||
(production (:bitwise-xor-expression :expr-kind) ((:bitwise-and-expression :expr-kind)) bitwise-xor-expression-bitwise-and
|
||||
(eval (eval :bitwise-and-expression)))
|
||||
(production (:bitwise-xor-expression :expr-kind) ((:bitwise-xor-expression any-value) ^ (:bitwise-and-expression any-value)) bitwise-xor-expression-xor
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :bitwise-xor-expression) e))
|
||||
(letexc (right-value value ((eval :bitwise-and-expression) e))
|
||||
(apply-binary-bitwise-operator bitwise-xor left-value right-value)))))
|
||||
|
||||
(declare-action eval (:bitwise-or-expression :expr-kind) (-> (env) value-or-exception))
|
||||
(production (:bitwise-or-expression :expr-kind) ((:bitwise-xor-expression :expr-kind)) bitwise-or-expression-bitwise-xor
|
||||
(eval (eval :bitwise-xor-expression)))
|
||||
(production (:bitwise-or-expression :expr-kind) ((:bitwise-or-expression any-value) \| (:bitwise-xor-expression any-value)) bitwise-or-expression-or
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :bitwise-or-expression) e))
|
||||
(letexc (right-value value ((eval :bitwise-xor-expression) e))
|
||||
(apply-binary-bitwise-operator bitwise-or left-value right-value)))))
|
||||
(%print-actions)
|
||||
|
||||
(define (apply-binary-bitwise-operator (operator (-> (integer integer) integer)) (left-value value) (right-value value)) value-or-exception
|
||||
(letexc (left-int integer (coerce-to-int32 left-value))
|
||||
(letexc (right-int integer (coerce-to-int32 right-value))
|
||||
(integer-result (operator left-int right-int)))))
|
||||
|
||||
(%section "Binary Logical Operators")
|
||||
|
||||
(declare-action eval (:logical-and-expression :expr-kind) (-> (env) value-or-exception))
|
||||
(production (:logical-and-expression :expr-kind) ((:bitwise-or-expression :expr-kind)) logical-and-expression-bitwise-or
|
||||
(eval (eval :bitwise-or-expression)))
|
||||
(production (:logical-and-expression :expr-kind) ((:logical-and-expression any-value) && (:bitwise-or-expression any-value)) logical-and-expression-and
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :logical-and-expression) e))
|
||||
(if (coerce-to-boolean left-value)
|
||||
((eval :bitwise-or-expression) e)
|
||||
(oneof normal left-value)))))
|
||||
|
||||
(declare-action eval (:logical-or-expression :expr-kind) (-> (env) value-or-exception))
|
||||
(production (:logical-or-expression :expr-kind) ((:logical-and-expression :expr-kind)) logical-or-expression-logical-and
|
||||
(eval (eval :logical-and-expression)))
|
||||
(production (:logical-or-expression :expr-kind) ((:logical-or-expression any-value) \|\| (:logical-and-expression any-value)) logical-or-expression-or
|
||||
((eval (e env))
|
||||
(letexc (left-value value ((eval :logical-or-expression) e))
|
||||
(if (coerce-to-boolean left-value)
|
||||
(oneof normal left-value)
|
||||
((eval :logical-and-expression) e)))))
|
||||
(%print-actions)
|
||||
|
||||
(%section "Conditional Operator")
|
||||
|
||||
(declare-action eval (:conditional-expression :expr-kind) (-> (env) value-or-exception))
|
||||
(production (:conditional-expression :expr-kind) ((:logical-or-expression :expr-kind)) conditional-expression-logical-or
|
||||
(eval (eval :logical-or-expression)))
|
||||
(production (:conditional-expression :expr-kind) ((:logical-or-expression any-value) ? (:assignment-expression any-value) \: (:assignment-expression any-value)) conditional-expression-conditional
|
||||
((eval (e env))
|
||||
(letexc (condition value ((eval :logical-or-expression) e))
|
||||
(if (coerce-to-boolean condition)
|
||||
((eval :assignment-expression 1) e)
|
||||
((eval :assignment-expression 2) e)))))
|
||||
(%print-actions)
|
||||
|
||||
(%section "Assignment Operators")
|
||||
|
||||
(declare-action eval (:assignment-expression :expr-kind) (-> (env) value-or-exception))
|
||||
(production (:assignment-expression :expr-kind) ((:conditional-expression :expr-kind)) assignment-expression-conditional
|
||||
(eval (eval :conditional-expression)))
|
||||
(production (:assignment-expression :expr-kind) (:lvalue = (:assignment-expression any-value)) assignment-expression-assignment
|
||||
((eval (e env))
|
||||
(letexc (left-reference reference ((eval :lvalue) e))
|
||||
(letexc (right-value value ((eval :assignment-expression) e))
|
||||
(letexc (u void (reference-put-value left-reference right-value) :unused)
|
||||
(oneof normal right-value))))))
|
||||
#|
|
||||
(production (:assignment-expression :expr-kind) (:lvalue :compound-assignment (:assignment-expression any-value)) assignment-expression-compound-assignment
|
||||
((eval (e env))
|
||||
(letexc (left-reference reference ((eval :lvalue) e))
|
||||
(letexc (left-value value (reference-get-value left-reference))
|
||||
(letexc (right-value value ((eval :assignment-expression) e))
|
||||
(letexc (res-value ((compound-operator :compound-assignment) left-value right-value))
|
||||
(letexc (u void (reference-put-value left-reference res-value) :unused)
|
||||
(oneof normal res-value))))))))
|
||||
|
||||
(declare-action compound-operator :compound-assignment (-> (value value) value-or-exception))
|
||||
(production :compound-assignment (*=) compound-assignment-multiply
|
||||
(compound-operator (binary-float64-compound-operator float64-multiply)))
|
||||
(production :compound-assignment (/=) compound-assignment-divide
|
||||
(compound-operator (binary-float64-compound-operator float64-divide)))
|
||||
(production :compound-assignment (%=) compound-assignment-remainder
|
||||
(compound-operator (binary-float64-compound-operator float64-remainder)))
|
||||
(production :compound-assignment (+=) compound-assignment-add
|
||||
(compound-operator (binary-float64-compound-operator float64-remainder)))
|
||||
(production :compound-assignment (-=) compound-assignment-subtract
|
||||
(compound-operator (binary-float64-compound-operator float64-subtract)))
|
||||
(%print-actions)
|
||||
|
||||
(define (binary-float64-compound-operator (operator (-> (float64 float64) float64))) (-> (value value) value-or-exception)
|
||||
(function ((left-value value) (right-value value))
|
||||
(letexc (left-number float64 (coerce-to-float64 left-value))
|
||||
(letexc (right-number float64 (coerce-to-float64 right-value))
|
||||
(oneof normal (oneof number-value (operator left-number right-number)))))))
|
||||
|#
|
||||
(%section "Expressions")
|
||||
|
||||
(declare-action eval (:comma-expression :expr-kind) (-> (env) value-or-exception))
|
||||
(production (:comma-expression :expr-kind) ((:assignment-expression :expr-kind)) comma-expression-assignment
|
||||
(eval (eval :assignment-expression)))
|
||||
(%print-actions)
|
||||
|
||||
(declare-action eval :expression (-> (env) value-or-exception))
|
||||
(production :expression ((:comma-expression any-value)) expression-comma-expression
|
||||
(eval (eval :comma-expression)))
|
||||
(%print-actions)
|
||||
|
||||
(%section "Programs")
|
||||
|
||||
(declare-action eval :program value-or-exception)
|
||||
(production :program (:expression $end) program
|
||||
(eval ((eval :expression) (tuple env (oneof null-object-or-null)))))
|
||||
)))
|
||||
|
||||
(defparameter *gg* (world-grammar *gw* 'code-grammar)))
|
||||
|
||||
|
||||
(defun token-terminal (token)
|
||||
(if (symbolp token)
|
||||
token
|
||||
(car token)))
|
||||
|
||||
(defun ecma-parse-tokens (tokens &key trace)
|
||||
(action-parse *gg* #'token-terminal tokens :trace trace))
|
||||
|
||||
|
||||
(defun ecma-parse (string &key trace)
|
||||
(let ((tokens (tokenize string)))
|
||||
(when trace
|
||||
(format *trace-output* "~S~%" tokens))
|
||||
(action-parse *gg* #'token-terminal tokens :trace trace)))
|
||||
|
||||
|
||||
; Same as ecma-parse except that also print the action results nicely.
|
||||
(defun ecma-pparse (string &key (stream t) trace)
|
||||
(multiple-value-bind (results types) (ecma-parse string :trace trace)
|
||||
(print-values results types stream)
|
||||
(terpri stream)
|
||||
(values results types)))
|
||||
|
||||
|
||||
#|
|
||||
(depict-rtf-to-local-file
|
||||
"JSECMA/ParserSemantics.rtf"
|
||||
"ECMAScript 1 Parser Semantics"
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *gw*)))
|
||||
|
||||
(depict-html-to-local-file
|
||||
"JSECMA/ParserSemantics.html"
|
||||
"ECMAScript 1 Parser Semantics"
|
||||
t
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *gw*)))
|
||||
|
||||
(with-local-output (s "JSECMA/ParserGrammar.txt") (print-grammar *gg* s))
|
||||
|
||||
|
||||
(ecma-pparse "('abc')")
|
||||
(ecma-pparse "!~ 352")
|
||||
(ecma-pparse "1e308%.125")
|
||||
(ecma-pparse "-3>>>10-6")
|
||||
(ecma-pparse "-3>>0")
|
||||
(ecma-pparse "1+2*3|16")
|
||||
(ecma-pparse "1==true")
|
||||
(ecma-pparse "1=true")
|
||||
(ecma-pparse "x=true")
|
||||
(ecma-pparse "2*4+17+0x32")
|
||||
(ecma-pparse "+'ab'+'de'")
|
||||
|#
|
||||
@@ -1,779 +0,0 @@
|
||||
;;; The contents of this file are subject to the Mozilla Public
|
||||
;;; License Version 1.1 (the "License"); you may not use this file
|
||||
;;; except in compliance with the License. You may obtain a copy of
|
||||
;;; the License at http://www.mozilla.org/MPL/
|
||||
;;;
|
||||
;;; Software distributed under the License is distributed on an "AS
|
||||
;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
;;; implied. See the License for the specific language governing
|
||||
;;; rights and limitations under the License.
|
||||
;;;
|
||||
;;; The Original Code is the Language Design and Prototyping Environment.
|
||||
;;;
|
||||
;;; The Initial Developer of the Original Code is Netscape Communications
|
||||
;;; Corporation. Portions created by Netscape Communications Corporation are
|
||||
;;; Copyright (C) 1999 Netscape Communications Corporation. All
|
||||
;;; Rights Reserved.
|
||||
;;;
|
||||
;;; Contributor(s): Waldemar Horwat <waldemar@acm.org>
|
||||
|
||||
;;;
|
||||
;;; Lexer grammar generator
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
|
||||
;;; A lexer grammar is an extension of a standard grammar that combines both parsing and combining
|
||||
;;; characters into character classes.
|
||||
;;;
|
||||
;;; A lexer grammar is comprised of the following:
|
||||
;;; a start nonterminal;
|
||||
;;; a list of grammar productions, in which each terminal must be a character;
|
||||
;;; a list of character classes, where each class is a list of:
|
||||
;;; a nonterminal C;
|
||||
;;; an expression <set-expr> that denotes the set of characters in character class C;
|
||||
;;; a list of bindings, each containing:
|
||||
;;; an action name;
|
||||
;;; a lexer-action name;
|
||||
;;; a list of lexer-action bindings, each containing:
|
||||
;;; a lexer-action name;
|
||||
;;; the type of this lexer-action's value;
|
||||
;;; the name of a lisp function (char -> value) that performs the lexer-action on a character.
|
||||
;;;
|
||||
;;; Grammar productions may refer to character classes C as nonterminals.
|
||||
;;;
|
||||
;;; An expression <set-expr> can be any of the following:
|
||||
;;; C The name of a previously defined character class.
|
||||
;;; (char1 char2 ... charn) The set of characters {char1, char2, ..., charn}
|
||||
;;; (+ <set-expr1> ... <set-exprn>) The set union of <set-expr1>, ..., <set-exprn>,
|
||||
;;; which should be disjoint.
|
||||
;;; (++ <set-expr1> ... <set-exprn>) Same as +, but printed on separate lines.
|
||||
;;; (- <set-expr1> <set-expr2>) The set of characters in <set-expr1> but not <set-expr2>;
|
||||
;;; <set-expr2> should be a subset of <set-expr1>.
|
||||
;;; (% <builtin-class> . <description>) A predefined set of characters. <description> is suitable for
|
||||
;;; depicting.
|
||||
;;;
|
||||
;;; <builtin-class> can be one of the following:
|
||||
;;; every The set of all characters
|
||||
;;; initial-alpha The set of characters suitable for the beginning of a Unicode identifier
|
||||
;;; alphanumeric The set of Unicode identifier continuation characters
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; SETS OF CHARACTERS
|
||||
|
||||
;;; A character set is represented by an integer.
|
||||
;;; The set may be infinite as long as its complement is finite.
|
||||
;;; Bit n is set if the character with code n is a member of the set.
|
||||
;;; The integer is negative if the set is infinite.
|
||||
|
||||
|
||||
; Print the charset
|
||||
(defun print-charset (charset &optional (stream t))
|
||||
(pprint-logical-block (stream (bitmap-to-ranges charset) :prefix "{" :suffix "}")
|
||||
(pprint-exit-if-list-exhausted)
|
||||
(loop
|
||||
(flet
|
||||
((int-to-char (i)
|
||||
(if (or (eq i :infinity) (= i char-code-limit))
|
||||
:infinity
|
||||
(code-char i))))
|
||||
(let* ((range (pprint-pop))
|
||||
(lo (int-to-char (car range)))
|
||||
(hi (int-to-char (cdr range))))
|
||||
(write (if (eql lo hi) lo (list lo hi)) :stream stream :pretty t)
|
||||
(pprint-exit-if-list-exhausted)
|
||||
(format stream " ~:_"))))))
|
||||
|
||||
|
||||
(defconstant *empty-charset* 0)
|
||||
|
||||
|
||||
; Return the character set consisting of the single character char.
|
||||
(declaim (inline char-charset))
|
||||
(defun char-charset (char)
|
||||
(ash 1 (char-code char)))
|
||||
|
||||
|
||||
; Return the character set consisting of adding char to the given charset.
|
||||
(defun charset-add-char (charset char)
|
||||
(let ((i (char-code char)))
|
||||
(if (logbitp i charset)
|
||||
charset
|
||||
(logior charset (ash 1 i)))))
|
||||
|
||||
|
||||
; Return the character set consisting of adding the character range to the given charset.
|
||||
(defun charset-add-range (charset low-char high-char)
|
||||
(let ((low (char-code low-char))
|
||||
(high (char-code high-char)))
|
||||
(assert-true (>= high low))
|
||||
(dpb -1 (byte (1+ (- high low)) low) charset)))
|
||||
|
||||
|
||||
; Return the union of the two character sets, which should be disjoint.
|
||||
(defun charset-union (charset1 charset2)
|
||||
(unless (zerop (logand charset1 charset2))
|
||||
(error "Union of overlapping character sets"))
|
||||
(logior charset1 charset2))
|
||||
|
||||
|
||||
; Return the difference of the two character sets, the second of which should be
|
||||
; a subset of the first.
|
||||
(defun charset-difference (charset1 charset2)
|
||||
(unless (zerop (logandc1 charset1 charset2))
|
||||
(error "Difference of non-subset character sets"))
|
||||
(logandc2 charset1 charset2))
|
||||
|
||||
|
||||
; Return true if the character set is empty.
|
||||
(declaim (inline charset-empty?))
|
||||
(defun charset-empty? (charset)
|
||||
(zerop charset))
|
||||
|
||||
|
||||
; Return true if the character set is infinite.
|
||||
(declaim (inline charset-infinite?))
|
||||
(defun charset-infinite? (charset)
|
||||
(minusp charset))
|
||||
|
||||
|
||||
; Return true if the character set contains the given character.
|
||||
(declaim (inline char-in-charset?))
|
||||
(defun char-in-charset? (charset char)
|
||||
(logbitp (char-code char) charset))
|
||||
|
||||
|
||||
; If the character set contains exactly one character, return that character;
|
||||
; otherwise, return nil.
|
||||
(defun charset-char (charset)
|
||||
(let ((hi (1- (integer-length charset))))
|
||||
(and (plusp charset) (= charset (ash 1 hi)) (code-char hi))))
|
||||
|
||||
|
||||
; Return the highest character in the character set, which must be finite and nonempty.
|
||||
(declaim (inline charset-highest-char))
|
||||
(defun charset-highest-char (charset)
|
||||
(assert-true (plusp charset))
|
||||
(code-char (1- (integer-length charset))))
|
||||
|
||||
|
||||
; Given a list of charsets, return a list of the largest possible
|
||||
; charsets (called partitions) such that:
|
||||
; for any input charset C and partition P, either P is entirely contained in C or it is disjoint from C;
|
||||
; all partitions are mutually disjoint;
|
||||
; the union of all partitions is the infinite set of all characters.
|
||||
(defun compute-partitions (charsets)
|
||||
(labels
|
||||
((split-partitions (partitions charset)
|
||||
(mapcan #'(lambda (partition)
|
||||
(remove-if #'zerop (list (logand partition charset) (logandc2 partition charset))))
|
||||
partitions))
|
||||
(partition< (partition1 partition2)
|
||||
(cond
|
||||
((minusp partition1) nil)
|
||||
((minusp partition2) t)
|
||||
(t (< partition1 partition2)))))
|
||||
(sort (reduce #'split-partitions charsets :initial-value '(-1))
|
||||
#'partition<)))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; PREDEFINED SETS OF CHARACTERS
|
||||
|
||||
(defmacro predefined-character-set (symbol)
|
||||
`(get ,symbol 'predefined-character-set))
|
||||
|
||||
|
||||
; Predefine a character set with the given name. The set is specified by char-ranges, which is a
|
||||
; list of single characters or two-elements (low-char high-char) lists; both low-char and high-char
|
||||
; are inclusive.
|
||||
|
||||
(defun define-character-set (symbol char-ranges)
|
||||
(let ((charset *empty-charset*))
|
||||
(dolist (char-range char-ranges)
|
||||
(setq charset
|
||||
(if (characterp char-range)
|
||||
(charset-add-char charset char-range)
|
||||
(charset-add-range charset (first char-range) (second char-range)))))
|
||||
(setf (predefined-character-set symbol) charset)))
|
||||
|
||||
|
||||
(setf (predefined-character-set 'every) -1)
|
||||
(define-character-set 'initial-alpha '((#\A #\Z) (#\a #\z)))
|
||||
(define-character-set 'alphanumeric '((#\0 #\9) (#\A #\Z) (#\a #\z)))
|
||||
|
||||
(define-character-set '*initial-identifier-character* '(#\$ #\_ (#\A #\Z) (#\a #\z)))
|
||||
(define-character-set '*continuing-identifier-character* '(#\$ #\_ (#\0 #\9) (#\A #\Z) (#\a #\z)))
|
||||
|
||||
(defun initial-identifier-character? (char)
|
||||
(char-in-charset? (predefined-character-set '*initial-identifier-character*) char))
|
||||
|
||||
(defun continuing-identifier-character? (char)
|
||||
(char-in-charset? (predefined-character-set '*continuing-identifier-character*) char))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; LEXER-ACTIONS
|
||||
|
||||
(defstruct (lexer-action (:constructor make-lexer-action (name number type-expr function-name function))
|
||||
(:copier nil)
|
||||
(:predicate lexer-action?))
|
||||
(name nil :type identifier :read-only t) ;The action name to use for this lexer-action
|
||||
(number nil :type integer :read-only t) ;Serial number of this lexer-action
|
||||
(type-expr nil :read-only t) ;A type expression that specifies the result type of function
|
||||
(function-name nil :type (or null identifier) :read-only t) ;Name of external function to use when depicting this lexer-action
|
||||
(function nil :type identifier :read-only t)) ;A lisp function (char -> value) that performs the lexer-action on a character
|
||||
|
||||
|
||||
(defun print-lexer-action (lexer-action &optional (stream t))
|
||||
(format stream "~@<~A ~@_~:I: ~<<<~;~W~;>>~:> ~_= ~<<~;#'~W~;>~:>~:>"
|
||||
(lexer-action-name lexer-action)
|
||||
(list (lexer-action-type-expr lexer-action))
|
||||
(list (lexer-action-function lexer-action))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; CHARCLASSES
|
||||
|
||||
(defstruct (charclass (:constructor make-charclass (nonterminal charset-source charset actions hidden))
|
||||
(:predicate charclass?))
|
||||
(nonterminal nil :type nonterminal :read-only t) ;The nonterminal on the left-hand side of this production
|
||||
(charset-source nil :read-only t) ;The source expression for the charset
|
||||
(charset nil :type integer :read-only t) ;The set of characters in this class
|
||||
(actions nil :type list :read-only t) ;List of (action-name . lexer-action)
|
||||
(hidden nil :type bool :read-only t)) ;True if this charclass should not be in the grammar
|
||||
|
||||
|
||||
; Return a copy of the charset expr with all parametrized nonterminals interned.
|
||||
(defun intern-charset-expr (parametrization expr)
|
||||
(cond
|
||||
((or (not (consp expr)) (eq (first expr) '%)) expr)
|
||||
((keywordp (first expr)) (assert-type (grammar-parametrization-intern parametrization expr) nonterminal))
|
||||
(t (mapcar #'(lambda (subexpr)
|
||||
(intern-charset-expr parametrization subexpr))
|
||||
expr))))
|
||||
|
||||
|
||||
; Evaluate a <set-expr> whose syntax is given at the top of this file.
|
||||
; Return the charset.
|
||||
; charclasses-hash is a hash table of nonterminal -> charclass.
|
||||
(defun eval-charset-expr (charclasses-hash expr)
|
||||
(cond
|
||||
((null expr) 0)
|
||||
((nonterminal? expr)
|
||||
(charclass-charset
|
||||
(or (gethash expr charclasses-hash)
|
||||
(error "Character class ~S not defined" expr))))
|
||||
((consp expr)
|
||||
(labels
|
||||
((recursive-eval (expr)
|
||||
(eval-charset-expr charclasses-hash expr)))
|
||||
(case (first expr)
|
||||
((+ ++) (reduce #'charset-union (rest expr) :initial-value 0 :key #'recursive-eval))
|
||||
(- (unless (rest expr)
|
||||
(error "Bad character set expression ~S" expr))
|
||||
(reduce #'charset-difference (rest expr) :key #'recursive-eval))
|
||||
(% (assert-non-null (predefined-character-set (second expr))))
|
||||
(t (reduce #'charset-union expr :key #'char-charset)))))
|
||||
(t (error "Bad character set expression ~S" expr))))
|
||||
|
||||
|
||||
(defun print-charclass (charclass &optional (stream t))
|
||||
(pprint-logical-block (stream nil)
|
||||
(format stream "~W -> ~@_~:I" (charclass-nonterminal charclass))
|
||||
(print-charset (charclass-charset charclass) stream)
|
||||
(format stream " ~_")
|
||||
(pprint-fill stream (mapcar #'car (charclass-actions charclass)))
|
||||
(when (charclass-hidden charclass)
|
||||
(format stream " ~_hidden"))))
|
||||
|
||||
|
||||
; Emit markup for the lexer charset expression.
|
||||
(defun depict-charset-source (markup-stream expr)
|
||||
(cond
|
||||
((null expr) (error "Can't emit null charset expression"))
|
||||
((nonterminal? expr) (depict-general-nonterminal markup-stream expr :reference))
|
||||
((consp expr)
|
||||
(case (first expr)
|
||||
((+ ++) (depict-list markup-stream #'depict-charset-source (rest expr) :separator " | "))
|
||||
(- (depict-charset-source markup-stream (second expr))
|
||||
(depict markup-stream " " :but-not " ")
|
||||
(depict-list markup-stream #'depict-charset-source (cddr expr) :separator " | "))
|
||||
(% (depict-styled-text markup-stream (cddr expr)))
|
||||
(t (depict-list markup-stream #'depict-terminal expr :separator " | "))))
|
||||
(t (error "Bad character set expression ~S" expr))))
|
||||
|
||||
|
||||
; Emit markup paragraphs for the lexer charclass.
|
||||
(defun depict-charclass (markup-stream charclass)
|
||||
(depict-block-style (markup-stream ':grammar-rule)
|
||||
(let ((nonterminal (charclass-nonterminal charclass))
|
||||
(expr (charclass-charset-source charclass)))
|
||||
(if (and (consp expr) (eq (first expr) '++))
|
||||
(let* ((subexprs (rest expr))
|
||||
(length (length subexprs)))
|
||||
(depict-paragraph (markup-stream ':grammar-lhs)
|
||||
(depict-general-nonterminal markup-stream nonterminal :definition)
|
||||
(depict markup-stream " " ':derives-10))
|
||||
(dotimes (i length)
|
||||
(depict-paragraph (markup-stream (if (= i (1- length)) ':grammar-rhs-last ':grammar-rhs))
|
||||
(if (zerop i)
|
||||
(depict markup-stream ':tab3)
|
||||
(depict markup-stream "|" ':tab2))
|
||||
(depict-charset-source markup-stream (nth i subexprs)))))
|
||||
(depict-paragraph (markup-stream ':grammar-lhs-last)
|
||||
(depict-general-nonterminal markup-stream (charclass-nonterminal charclass) :definition)
|
||||
(depict markup-stream " " ':derives-10 " ")
|
||||
(depict-charset-source markup-stream expr))))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; PARTITIONS
|
||||
|
||||
(defstruct (partition (:constructor make-partition (charset lexer-actions))
|
||||
(:predicate partition?))
|
||||
(charset nil :type integer :read-only t) ;The set of characters in this partition
|
||||
(lexer-actions nil :type list :read-only t)) ;List of lexer-actions needed on characters in this partition
|
||||
|
||||
(defconstant *default-partition-name* '$_other_) ;partition-name to use for characters not found in lexer-char-tokens
|
||||
|
||||
|
||||
(defun print-partition (partition-name partition &optional (stream t))
|
||||
(pprint-logical-block (stream nil)
|
||||
(format stream "~W -> ~@_~:I" partition-name)
|
||||
(print-charset (partition-charset partition) stream)
|
||||
(format stream " ~_")
|
||||
(pprint-fill stream (mapcar #'lexer-action-name (partition-lexer-actions partition)))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; LEXER
|
||||
|
||||
|
||||
(defstruct (lexer (:constructor allocate-lexer)
|
||||
(:copier nil)
|
||||
(:predicate lexer?))
|
||||
(lexer-actions nil :type hash-table :read-only t) ;Hash table of lexer-action-name -> lexer-action
|
||||
(charclasses nil :type list :read-only t) ;List of charclasses in the order in which they were given
|
||||
(charclasses-hash nil :type hash-table :read-only t) ;Hash table of nonterminal -> charclass
|
||||
(char-tokens nil :type hash-table :read-only t) ;Hash table of character -> (character or partition-name)
|
||||
(partition-names nil :type list :read-only t) ;List of partition names in the order in which they were created
|
||||
(partitions nil :type hash-table :read-only t) ;Hash table of partition-name -> partition
|
||||
(grammar nil :type (or null grammar)) ;Grammar that accepts exactly one lexer token
|
||||
(metagrammar nil :type (or null metagrammar))) ;Grammar that accepts the longest input sequence that forms a token
|
||||
|
||||
|
||||
; Return a function (character -> terminal) that classifies an input character
|
||||
; as either itself or a partition-name.
|
||||
; If the returned function is called on a non-character, it returns its input unchanged.
|
||||
(defun lexer-classifier (lexer)
|
||||
(let ((char-tokens (lexer-char-tokens lexer)))
|
||||
#'(lambda (char)
|
||||
(if (characterp char)
|
||||
(gethash char char-tokens *default-partition-name*)
|
||||
char))))
|
||||
|
||||
|
||||
; Return the charclass that defines the given lexer nonterminal or nil if none.
|
||||
(defun lexer-charclass (lexer nonterminal)
|
||||
(gethash nonterminal (lexer-charclasses-hash lexer)))
|
||||
|
||||
|
||||
; Return the charset of all characters that appear as terminals in grammar-source.
|
||||
(defun grammar-singletons (grammar-source)
|
||||
(assert-type grammar-source (list (tuple t (list t) identifier t)))
|
||||
(let ((singletons 0))
|
||||
(labels
|
||||
((scan-for-singletons (list)
|
||||
(dolist (element list)
|
||||
(cond
|
||||
((characterp element)
|
||||
(setq singletons (charset-add-char singletons element)))
|
||||
((consp element)
|
||||
(case (first element)
|
||||
(:- (scan-for-singletons (rest element)))
|
||||
(:-- (scan-for-singletons (cddr element)))))))))
|
||||
|
||||
(dolist (production-source grammar-source)
|
||||
(scan-for-singletons (second production-source))))
|
||||
singletons))
|
||||
|
||||
|
||||
; Return the list of all lexer-action-names that appear in at least one charclass of which this
|
||||
; partition is a subset.
|
||||
(defun collect-lexer-action-names (charclasses partition)
|
||||
(let ((lexer-action-names nil))
|
||||
(dolist (charclass charclasses)
|
||||
(unless (zerop (logand (charclass-charset charclass) partition))
|
||||
(dolist (action (charclass-actions charclass))
|
||||
(pushnew (cdr action) lexer-action-names))))
|
||||
(sort lexer-action-names #'< :key #'lexer-action-number)))
|
||||
|
||||
|
||||
; Make a lexer structure corresponding to a grammar with the given source.
|
||||
; charclasses-source is a list of character classes, where each class is a list of:
|
||||
; a nonterminal C (may be a list to specify an attributed-nonterminal);
|
||||
; an expression <set-expr> that denotes the set of characters in character class C;
|
||||
; a list of bindings, each containing:
|
||||
; an action name;
|
||||
; a lexer-action name;
|
||||
; an optional flag that indicatest that the character class should not be in the grammar.
|
||||
; lexer-actions-source is a list of lexer-action bindings, each containing:
|
||||
; a lexer-action name;
|
||||
; the type of this lexer-action's value;
|
||||
; the name of a primitive to use when depicting this lexer-action's definition;
|
||||
; the name of a lisp function (char -> value) that performs the lexer-action on a character.
|
||||
; This does not make the lexer's grammar; use make-lexer-and-grammar for that.
|
||||
(defun make-lexer (parametrization charclasses-source lexer-actions-source grammar-source)
|
||||
(assert-type charclasses-source (list (cons t (cons t (cons (list (tuple identifier identifier)) t)))))
|
||||
(assert-type lexer-actions-source (list (tuple identifier t (or null identifier) identifier)))
|
||||
(let ((lexer-actions (make-hash-table :test #'eq))
|
||||
(charclasses nil)
|
||||
(charclasses-hash (make-hash-table :test *grammar-symbol-=*))
|
||||
(charsets nil)
|
||||
(singletons (grammar-singletons grammar-source)))
|
||||
(let ((lexer-action-number 0))
|
||||
(dolist (lexer-action-source lexer-actions-source)
|
||||
(let ((name (first lexer-action-source))
|
||||
(type-expr (second lexer-action-source))
|
||||
(function-name (third lexer-action-source))
|
||||
(function (fourth lexer-action-source)))
|
||||
(when (gethash name lexer-actions)
|
||||
(error "Attempt to redefine lexer action ~S" name))
|
||||
(setf (gethash name lexer-actions)
|
||||
(make-lexer-action name (incf lexer-action-number) type-expr function-name function)))))
|
||||
|
||||
(dolist (charclass-source charclasses-source)
|
||||
(let* ((nonterminal (assert-type (grammar-parametrization-intern parametrization (first charclass-source)) nonterminal))
|
||||
(charset-source (intern-charset-expr parametrization (ensure-proper-form (second charclass-source))))
|
||||
(charset (eval-charset-expr charclasses-hash charset-source))
|
||||
(actions
|
||||
(mapcar #'(lambda (action-source)
|
||||
(let* ((lexer-action-name (second action-source))
|
||||
(lexer-action (gethash lexer-action-name lexer-actions)))
|
||||
(unless lexer-action
|
||||
(error "Unknown lexer-action ~S" lexer-action-name))
|
||||
(cons (first action-source) lexer-action)))
|
||||
(third charclass-source))))
|
||||
(when (gethash nonterminal charclasses-hash)
|
||||
(error "Attempt to redefine character class ~S" nonterminal))
|
||||
(when (charset-empty? charset)
|
||||
(error "Empty character class ~S" nonterminal))
|
||||
(let ((charclass (make-charclass nonterminal charset-source charset actions (fourth charclass-source))))
|
||||
(push charclass charclasses)
|
||||
(setf (gethash nonterminal charclasses-hash) charclass)
|
||||
(push charset charsets))))
|
||||
(setq charclasses (nreverse charclasses))
|
||||
(bitmap-each-bit #'(lambda (i) (push (ash 1 i) charsets))
|
||||
singletons)
|
||||
(let ((char-tokens (make-hash-table :test #'eql))
|
||||
(partition-names nil)
|
||||
(partitions (make-hash-table :test #'eq))
|
||||
(current-partition-number 0))
|
||||
(dolist (partition (compute-partitions charsets))
|
||||
(let ((singleton (charset-char partition)))
|
||||
(cond
|
||||
(singleton (setf (gethash singleton char-tokens) singleton))
|
||||
((charset-infinite? partition)
|
||||
(push *default-partition-name* partition-names)
|
||||
(setf (gethash *default-partition-name* partitions)
|
||||
(make-partition partition (collect-lexer-action-names charclasses partition))))
|
||||
(t (let ((token (intern (format nil "$_CHARS~D_" (incf current-partition-number)))))
|
||||
(bitmap-each-bit #'(lambda (i)
|
||||
(setf (gethash (code-char i) char-tokens) token))
|
||||
partition)
|
||||
(push token partition-names)
|
||||
(setf (gethash token partitions)
|
||||
(make-partition partition (collect-lexer-action-names charclasses partition))))))))
|
||||
(allocate-lexer
|
||||
:lexer-actions lexer-actions
|
||||
:charclasses charclasses
|
||||
:charclasses-hash charclasses-hash
|
||||
:char-tokens char-tokens
|
||||
:partition-names (nreverse partition-names)
|
||||
:partitions partitions))))
|
||||
|
||||
|
||||
(defun print-lexer (lexer &optional (stream t))
|
||||
(let* ((lexer-actions (lexer-lexer-actions lexer))
|
||||
(lexer-action-names (sort (hash-table-keys lexer-actions) #'<
|
||||
:key #'(lambda (lexer-action-name)
|
||||
(lexer-action-number (gethash lexer-action-name lexer-actions)))))
|
||||
(charclasses (lexer-charclasses lexer))
|
||||
(partition-names (lexer-partition-names lexer))
|
||||
(partitions (lexer-partitions lexer))
|
||||
(singletons nil))
|
||||
|
||||
(when lexer-action-names
|
||||
(pprint-logical-block (stream lexer-action-names)
|
||||
(format stream "Lexer Actions:~2I")
|
||||
(loop
|
||||
(pprint-newline :mandatory stream)
|
||||
(let ((lexer-action (gethash (pprint-pop) lexer-actions)))
|
||||
(print-lexer-action lexer-action stream))
|
||||
(pprint-exit-if-list-exhausted)))
|
||||
(pprint-newline :mandatory stream)
|
||||
(pprint-newline :mandatory stream))
|
||||
|
||||
(when charclasses
|
||||
(pprint-logical-block (stream charclasses)
|
||||
(format stream "Charclasses:~2I")
|
||||
(loop
|
||||
(pprint-newline :mandatory stream)
|
||||
(let ((charclass (pprint-pop)))
|
||||
(print-charclass charclass stream))
|
||||
(pprint-exit-if-list-exhausted)))
|
||||
(pprint-newline :mandatory stream)
|
||||
(pprint-newline :mandatory stream))
|
||||
|
||||
(when partition-names
|
||||
(pprint-logical-block (stream partition-names)
|
||||
(format stream "Partitions:~2I")
|
||||
(loop
|
||||
(pprint-newline :mandatory stream)
|
||||
(let ((partition-name (pprint-pop)))
|
||||
(print-partition partition-name (gethash partition-name partitions) stream))
|
||||
(pprint-exit-if-list-exhausted)))
|
||||
(pprint-newline :mandatory stream)
|
||||
(pprint-newline :mandatory stream))
|
||||
|
||||
(maphash
|
||||
#'(lambda (char char-or-partition)
|
||||
(if (eql char char-or-partition)
|
||||
(push char singletons)
|
||||
(assert-type char-or-partition identifier)))
|
||||
(lexer-char-tokens lexer))
|
||||
(setq singletons (sort singletons #'char<))
|
||||
(when singletons
|
||||
(format stream "Singletons: ~@_~<~@{~W ~:_~}~:>~:@_~:@_" singletons))))
|
||||
|
||||
|
||||
(defmethod print-object ((lexer lexer) stream)
|
||||
(print-unreadable-object (lexer stream :identity t)
|
||||
(write-string "lexer" stream)))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
|
||||
|
||||
; Return a freshly consed list of partitions for the given charclass.
|
||||
(defun charclass-partitions (lexer charclass)
|
||||
(do ((partitions nil)
|
||||
(charset (charclass-charset charclass)))
|
||||
((charset-empty? charset) partitions)
|
||||
(let* ((partition-name (if (charset-infinite? charset)
|
||||
*default-partition-name*
|
||||
(gethash (charset-highest-char charset) (lexer-char-tokens lexer))))
|
||||
(partition-charset (if (characterp partition-name)
|
||||
(char-charset partition-name)
|
||||
(partition-charset (gethash partition-name (lexer-partitions lexer))))))
|
||||
(push partition-name partitions)
|
||||
(setq charset (charset-difference charset partition-charset)))))
|
||||
|
||||
|
||||
; Return an updated grammar-source whose character class nonterminals are replaced with sets of
|
||||
; terminals inside :- and :-- constraints.
|
||||
(defun update-constraint-nonterminals (lexer grammar-source)
|
||||
(mapcar
|
||||
#'(lambda (production-source)
|
||||
(let ((rhs (second production-source)))
|
||||
(if (some #'(lambda (rhs-component)
|
||||
(and (consp rhs-component)
|
||||
(member (first rhs-component) '(:- :--))))
|
||||
rhs)
|
||||
(list*
|
||||
(first production-source)
|
||||
(mapcar
|
||||
#'(lambda (component)
|
||||
(when (consp component)
|
||||
(let ((tag (first component)))
|
||||
(when (eq tag ':-)
|
||||
(setq component (list* ':-- (rest component) (rest component)))
|
||||
(setq tag ':--))
|
||||
(when (eq tag ':--)
|
||||
(setq component
|
||||
(list* tag
|
||||
(second component)
|
||||
(mapcan #'(lambda (grammar-symbol)
|
||||
(if (nonterminal? grammar-symbol)
|
||||
(charclass-partitions lexer (assert-non-null (lexer-charclass lexer grammar-symbol)))
|
||||
(list grammar-symbol)))
|
||||
(cddr component)))))))
|
||||
component)
|
||||
rhs)
|
||||
(cddr production-source))
|
||||
production-source)))
|
||||
grammar-source))
|
||||
|
||||
|
||||
; Return two values:
|
||||
; An updated grammar-source that includes:
|
||||
; grammar productions that define the character class nonterminals out of characters and tokens;
|
||||
; character class nonterminals replaced with sets of terminals inside :- and :-- constraints.
|
||||
; Extra commands that:
|
||||
; define the partitions used in this lexer;
|
||||
; define the actions of these productions.
|
||||
(defun lexer-grammar-and-commands (lexer grammar-source)
|
||||
(labels
|
||||
((component-partitions (charset partitions)
|
||||
(if (charset-empty? charset)
|
||||
partitions
|
||||
(let* ((partition-name (if (charset-infinite? charset)
|
||||
*default-partition-name*
|
||||
(gethash (charset-highest-char charset) (lexer-char-tokens lexer))))
|
||||
(partition (gethash partition-name (lexer-partitions lexer))))
|
||||
(component-partitions (charset-difference charset (partition-charset partition))
|
||||
(cons partition partitions))))))
|
||||
(let ((productions nil)
|
||||
(commands nil))
|
||||
(dolist (charclass (lexer-charclasses lexer))
|
||||
(unless (charclass-hidden charclass)
|
||||
(let* ((nonterminal (charclass-nonterminal charclass))
|
||||
(nonterminal-source (general-grammar-symbol-source nonterminal))
|
||||
(production-prefix (if (consp nonterminal-source)
|
||||
(format nil "~{~A~^-~}" nonterminal-source)
|
||||
nonterminal-source))
|
||||
(production-number 0))
|
||||
(dolist (action (charclass-actions charclass))
|
||||
(let ((lexer-action (cdr action)))
|
||||
(push (list 'declare-action (car action) nonterminal-source (lexer-action-type-expr lexer-action)) commands)))
|
||||
(do ((charset (charclass-charset charclass)))
|
||||
((charset-empty? charset))
|
||||
(let* ((partition-name (if (charset-infinite? charset)
|
||||
*default-partition-name*
|
||||
(gethash (charset-highest-char charset) (lexer-char-tokens lexer))))
|
||||
(partition-charset (if (characterp partition-name)
|
||||
(char-charset partition-name)
|
||||
(partition-charset (gethash partition-name (lexer-partitions lexer)))))
|
||||
(production-name (intern (format nil "~A-~D" production-prefix (incf production-number)))))
|
||||
(push (list nonterminal-source (list partition-name) production-name nil) productions)
|
||||
(dolist (action (charclass-actions charclass))
|
||||
(let* ((lexer-action (cdr action))
|
||||
(body (if (characterp partition-name)
|
||||
(let* ((lexer-action-function (lexer-action-function lexer-action))
|
||||
(result (funcall lexer-action-function partition-name)))
|
||||
(typecase result
|
||||
(integer result)
|
||||
(character result)
|
||||
((eql nil) 'false)
|
||||
((eql t) 'true)
|
||||
(t (error "Cannot infer the type of ~S's result ~S" lexer-action-function result))))
|
||||
(list (lexer-action-name lexer-action) partition-name))))
|
||||
(push (list 'action (car action) production-name body nil) commands)))
|
||||
(setq charset (charset-difference charset partition-charset)))))))
|
||||
|
||||
(let ((partition-commands
|
||||
(mapcan
|
||||
#'(lambda (partition-name)
|
||||
(mapcan #'(lambda (lexer-action)
|
||||
(let ((lexer-action-name (lexer-action-name lexer-action)))
|
||||
(list
|
||||
(list 'declare-action lexer-action-name partition-name (lexer-action-type-expr lexer-action))
|
||||
(list 'terminal-action lexer-action-name partition-name (lexer-action-function lexer-action)))))
|
||||
(partition-lexer-actions (gethash partition-name (lexer-partitions lexer)))))
|
||||
(lexer-partition-names lexer))))
|
||||
(values
|
||||
(nreconc productions (update-constraint-nonterminals lexer grammar-source))
|
||||
(nconc partition-commands (nreverse commands)))))))
|
||||
|
||||
|
||||
; Make a lexer and grammar from the given source.
|
||||
; kind should be :lalr-1, :lr-1, or :canonical-lr-1.
|
||||
; charclasses-source is a list of character classes, and
|
||||
; lexer-actions-source is a list of lexer-action bindings; see make-lexer.
|
||||
; start-symbol is the grammar's start symbol, and grammar-source is its source.
|
||||
; Return two values:
|
||||
; the lexer (including the grammar in its grammar field);
|
||||
; list of extra commands that:
|
||||
; define the partitions used in this lexer;
|
||||
; define the actions of these productions.
|
||||
(defun make-lexer-and-grammar (kind charclasses-source lexer-actions-source parametrization start-symbol grammar-source &rest grammar-options)
|
||||
(let ((lexer (make-lexer parametrization charclasses-source lexer-actions-source grammar-source)))
|
||||
(multiple-value-bind (lexer-grammar-source extra-commands) (lexer-grammar-and-commands lexer grammar-source)
|
||||
(let ((grammar (apply #'make-and-compile-grammar kind parametrization start-symbol lexer-grammar-source grammar-options)))
|
||||
(setf (lexer-grammar lexer) grammar)
|
||||
(values lexer extra-commands)))))
|
||||
|
||||
|
||||
; Parse the input string to produce a list of action results.
|
||||
; If trace is:
|
||||
; nil, don't print trace information
|
||||
; :code, print trace information, including action code
|
||||
; other print trace information
|
||||
; Return two values:
|
||||
; the list of action results;
|
||||
; the list of action results' types.
|
||||
(defun lexer-parse (lexer string &key trace)
|
||||
(let ((in (coerce string 'list)))
|
||||
(action-parse (lexer-grammar lexer) (lexer-classifier lexer) in :trace trace)))
|
||||
|
||||
|
||||
; Same as lexer-parse except that also print the action results nicely.
|
||||
(defun lexer-pparse (lexer string &key (stream t) trace)
|
||||
(multiple-value-bind (results types) (lexer-parse lexer string :trace trace)
|
||||
(print-values results types stream)
|
||||
(terpri stream)
|
||||
(values results types)))
|
||||
|
||||
|
||||
; Compute the lexer grammar's metagrammar.
|
||||
(defun set-up-lexer-metagrammar (lexer)
|
||||
(setf (lexer-metagrammar lexer) (make-metagrammar (lexer-grammar lexer))))
|
||||
|
||||
|
||||
|
||||
; Parse the input string into elements, where each element is the longest
|
||||
; possible string of input characters that is accepted by the grammar.
|
||||
; The grammar's terminals are all characters that may appear in the input
|
||||
; string plus the symbol $END which is inserted after the last character of
|
||||
; the string.
|
||||
; Return the list of lists of action results of the elements.
|
||||
;
|
||||
; If initial-state and state-transition are non-nil, the parser has state.
|
||||
; initial-state is a list of input symbols to be prepended to the input string
|
||||
; before the first element is parsed. state-transition is a function that
|
||||
; takes the result of each successful action and produces two values:
|
||||
; a modified result of that action;
|
||||
; a list of input symbols to be prepended to the input string before the next
|
||||
; element is parsed.
|
||||
;
|
||||
; If trace is:
|
||||
; nil, don't print trace information
|
||||
; :code, print trace information, including action code
|
||||
; other print trace information
|
||||
;
|
||||
; Return three values:
|
||||
; the list of lists of action results;
|
||||
; the list of action results' types. Each of the lists of action results has
|
||||
; this type signature.
|
||||
; the last state
|
||||
(defun lexer-metaparse (lexer string &key initial-state state-transition trace)
|
||||
(let ((metagrammar (lexer-metagrammar lexer)))
|
||||
(do ((in (append (coerce string 'list) '($end)))
|
||||
(results-lists nil))
|
||||
((endp in) (values (nreverse results-lists)
|
||||
(grammar-user-start-action-types (metagrammar-grammar metagrammar))
|
||||
initial-state))
|
||||
(multiple-value-bind (results in-rest)
|
||||
(action-metaparse metagrammar (lexer-classifier lexer) (append initial-state in) :trace trace)
|
||||
(when state-transition
|
||||
(multiple-value-setq (results initial-state) (funcall state-transition results)))
|
||||
(setq in in-rest)
|
||||
(push results results-lists)))))
|
||||
|
||||
|
||||
; Same as lexer-metaparse except that also print the action results nicely.
|
||||
(defun lexer-pmetaparse (lexer string &key initial-state state-transition (stream t) trace)
|
||||
(multiple-value-bind (results-lists types final-state)
|
||||
(lexer-metaparse lexer string :initial-state initial-state :state-transition state-transition :trace trace)
|
||||
(pprint-logical-block (stream results-lists)
|
||||
(pprint-exit-if-list-exhausted)
|
||||
(loop
|
||||
(print-values (pprint-pop) types stream :prefix "(" :suffix ")")
|
||||
(pprint-exit-if-list-exhausted)
|
||||
(format stream " ~_")))
|
||||
(terpri stream)
|
||||
(values results-lists types final-state)))
|
||||
|
||||
@@ -1,89 +0,0 @@
|
||||
;;; The contents of this file are subject to the Mozilla Public
|
||||
;;; License Version 1.1 (the "License"); you may not use this file
|
||||
;;; except in compliance with the License. You may obtain a copy of
|
||||
;;; the License at http://www.mozilla.org/MPL/
|
||||
;;;
|
||||
;;; Software distributed under the License is distributed on an "AS
|
||||
;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
;;; implied. See the License for the specific language governing
|
||||
;;; rights and limitations under the License.
|
||||
;;;
|
||||
;;; The Original Code is the Language Design and Prototyping Environment.
|
||||
;;;
|
||||
;;; The Initial Developer of the Original Code is Netscape Communications
|
||||
;;; Corporation. Portions created by Netscape Communications Corporation are
|
||||
;;; Copyright (C) 1999 Netscape Communications Corporation. All
|
||||
;;; Rights Reserved.
|
||||
;;;
|
||||
;;; Contributor(s): Waldemar Horwat <waldemar@acm.org>
|
||||
|
||||
;;;
|
||||
;;; ECMAScript semantic loader
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
|
||||
#+allegro (shadow 'state)
|
||||
#+allegro (shadow 'type)
|
||||
#+lispworks (shadow 'define-action)
|
||||
#+lispworks (shadow 'type)
|
||||
|
||||
(defparameter *semantic-engine-filenames*
|
||||
'("Utilities" "Markup" "RTF" "HTML" "GrammarSymbol" "Grammar" "Parser" "Metaparser" "Lexer" "Calculus" "CalculusMarkup"))
|
||||
|
||||
(defparameter *semantics-filenames*
|
||||
'("JS20/Parser" "JS20/Lexer" "JS20/Units" "JS20/RegExp" "JS20/Kernel"))
|
||||
|
||||
(defparameter *semantic-engine-directory*
|
||||
(make-pathname
|
||||
#+lispworks :host #+lispworks (pathname-host *load-truename*)
|
||||
:directory (pathname-directory #-mcl *load-truename*
|
||||
#+mcl (truename *loading-file-source-file*))))
|
||||
|
||||
|
||||
; Convert a filename string possibly containing slashes into a Lisp relative pathname.
|
||||
(defun filename-to-relative-pathname (filename)
|
||||
(let ((directories nil))
|
||||
(loop
|
||||
(let ((slash (position #\/ filename)))
|
||||
(if slash
|
||||
(let ((dir-name (subseq filename 0 slash)))
|
||||
(push (if (equal dir-name "..") :up dir-name) directories)
|
||||
(setq filename (subseq filename (1+ slash))))
|
||||
(return (if directories
|
||||
(make-pathname :directory (cons ':relative (nreverse directories)) :name filename #+lispworks :type #+lispworks "lisp")
|
||||
#-lispworks filename
|
||||
#+lispworks (make-pathname :name filename :type "lisp"))))))))
|
||||
|
||||
|
||||
; Convert a filename string possibly containing slashes relative to *semantic-engine-directory*
|
||||
; into a Lisp absolute pathname.
|
||||
(defun filename-to-semantic-engine-pathname (filename)
|
||||
(merge-pathnames (filename-to-relative-pathname filename) *semantic-engine-directory*))
|
||||
|
||||
|
||||
(defun operate-on-files (f files &rest options)
|
||||
(with-compilation-unit ()
|
||||
(dolist (filename files)
|
||||
(apply f (filename-to-semantic-engine-pathname filename) :verbose t options))))
|
||||
|
||||
(defun compile-semantic-engine ()
|
||||
(operate-on-files #'compile-file *semantic-engine-filenames* :load t))
|
||||
|
||||
(defun load-semantic-engine ()
|
||||
(operate-on-files #-allegro #'load #+allegro #'load-compiled *semantic-engine-filenames*))
|
||||
|
||||
(defun load-semantics ()
|
||||
(operate-on-files #-allegro #'load #+allegro #'load-compiled *semantics-filenames*))
|
||||
|
||||
|
||||
(defmacro with-local-output ((stream filename) &body body)
|
||||
`(with-open-file (,stream (filename-to-semantic-engine-pathname ,filename)
|
||||
:direction :output
|
||||
:if-exists :supersede)
|
||||
,@body))
|
||||
|
||||
|
||||
(load-semantic-engine)
|
||||
(load-semantics)
|
||||
@@ -1,700 +0,0 @@
|
||||
;;; The contents of this file are subject to the Mozilla Public
|
||||
;;; License Version 1.1 (the "License"); you may not use this file
|
||||
;;; except in compliance with the License. You may obtain a copy of
|
||||
;;; the License at http://www.mozilla.org/MPL/
|
||||
;;;
|
||||
;;; Software distributed under the License is distributed on an "AS
|
||||
;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
;;; implied. See the License for the specific language governing
|
||||
;;; rights and limitations under the License.
|
||||
;;;
|
||||
;;; The Original Code is the Language Design and Prototyping Environment.
|
||||
;;;
|
||||
;;; The Initial Developer of the Original Code is Netscape Communications
|
||||
;;; Corporation. Portions created by Netscape Communications Corporation are
|
||||
;;; Copyright (C) 1999 Netscape Communications Corporation. All
|
||||
;;; Rights Reserved.
|
||||
;;;
|
||||
;;; Contributor(s): Waldemar Horwat <waldemar@acm.org>
|
||||
|
||||
;;;
|
||||
;;; Common RTF and HTML writing utilities
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
|
||||
(defvar *trace-logical-blocks* nil) ;Emit logical blocks to *trace-output* while processing
|
||||
(defvar *show-logical-blocks* nil) ;Emit logical block boundaries as hidden rtf text
|
||||
|
||||
(defvar *markup-logical-line-width* 90) ;Approximate maximum number of characters to display on a single logical line
|
||||
(defvar *average-space-width* 2/3) ;Width of a space as a percentage of average character width when calculating logical line widths
|
||||
|
||||
(defvar *external-link-base* nil) ;URL prefix for referring to a page with external links or nil if none
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; LINK TABLES
|
||||
|
||||
; Return a table for recording defined, referenced, and external links.
|
||||
; External links include a # character; locally defined and referenced ones do not.
|
||||
(declaim (inline make-link-table))
|
||||
(defun make-link-table ()
|
||||
(make-hash-table :test #'equal))
|
||||
|
||||
|
||||
; The concatenation of link-prefix and link-name is the name of a link. Mark the link defined.
|
||||
; Return the full name if links are allowed and this is the first definition of that name.
|
||||
; If duplicate is false, don't allow multiple definitions of the same link name.
|
||||
(defun record-link-definition (links link-prefix link-name duplicate)
|
||||
(assert-type link-prefix string)
|
||||
(assert-type link-name string)
|
||||
(and links
|
||||
(let ((name (concatenate 'string link-prefix link-name)))
|
||||
(cond
|
||||
((not (eq (gethash name links) :defined))
|
||||
(setf (gethash name links) :defined)
|
||||
name)
|
||||
(duplicate nil)
|
||||
(t (warn "Duplicate link definition ~S" name)
|
||||
name)))))
|
||||
|
||||
|
||||
; The concatenation of link-prefix and link-name is the name of a link. Mark the link referenced.
|
||||
; If external is true, the link refers to the page given by *external-link-base*; if *external-link-base*
|
||||
; is null and external is true, no link gets made.
|
||||
; Return the full href if links are allowed or nil if not.
|
||||
(defun record-link-reference (links link-prefix link-name external)
|
||||
(assert-type link-prefix string)
|
||||
(assert-type link-name string)
|
||||
(and links
|
||||
(if external
|
||||
(and *external-link-base*
|
||||
(let ((href (concatenate 'string *external-link-base* "#" link-prefix link-name)))
|
||||
(setf (gethash href links) :external)
|
||||
href))
|
||||
(let ((name (concatenate 'string link-prefix link-name)))
|
||||
(unless (eq (gethash name links) :defined)
|
||||
(setf (gethash name links) :referenced))
|
||||
(concatenate 'string "#" name)))))
|
||||
|
||||
|
||||
; Warn about all referenced but not defined links.
|
||||
(defun warn-missing-links (links)
|
||||
(when links
|
||||
(let ((missing-links nil)
|
||||
(external-links nil))
|
||||
(maphash #'(lambda (name link-state)
|
||||
(case link-state
|
||||
(:referenced (push name missing-links))
|
||||
(:external (push name external-links))))
|
||||
links)
|
||||
(setq missing-links (sort missing-links #'string<))
|
||||
(setq external-links (sort external-links #'string<))
|
||||
(when missing-links
|
||||
(warn "The following links have been referenced but not defined: ~S" missing-links))
|
||||
(when external-links
|
||||
(format *error-output* "External links:~%~{ ~A~%~}" external-links)))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; MARKUP ENVIRONMENTS
|
||||
|
||||
|
||||
(defstruct (markup-env (:constructor allocate-markup-env (macros widths)))
|
||||
(macros nil :type hash-table :read-only t) ;Hash table of keyword -> expansion list
|
||||
(widths nil :type hash-table :read-only t) ;Hash table of keyword -> estimated width of macro expansion;
|
||||
; ; zero-width entries can be omitted; multiline entries have t for a width.
|
||||
(links nil :type (or null hash-table))) ;Hash table of string -> either :referenced or :defined;
|
||||
; ; nil if links not supported
|
||||
|
||||
|
||||
; Make a markup-env. If links is true, allow links.
|
||||
(defun make-markup-env (links)
|
||||
(let ((markup-env (allocate-markup-env (make-hash-table :test #'eq) (make-hash-table :test #'eq))))
|
||||
(when links
|
||||
(setf (markup-env-links markup-env) (make-link-table)))
|
||||
markup-env))
|
||||
|
||||
|
||||
; Recursively expand all keywords in markup-tree, producing a freshly consed expansion tree.
|
||||
; Allow keywords in the permitted-keywords list to be present in the output without generating an error.
|
||||
(defun markup-env-expand (markup-env markup-tree permitted-keywords)
|
||||
(mapcan
|
||||
#'(lambda (markup-element)
|
||||
(cond
|
||||
((keywordp markup-element)
|
||||
(let ((expansion (gethash markup-element (markup-env-macros markup-env) *get2-nonce*)))
|
||||
(if (eq expansion *get2-nonce*)
|
||||
(if (member markup-element permitted-keywords :test #'eq)
|
||||
(list markup-element)
|
||||
(error "Unknown markup macro ~S" markup-element))
|
||||
(markup-env-expand markup-env expansion permitted-keywords))))
|
||||
((listp markup-element)
|
||||
(list (markup-env-expand markup-env markup-element permitted-keywords)))
|
||||
(t (list markup-element))))
|
||||
markup-tree))
|
||||
|
||||
|
||||
(defun markup-env-define (markup-env keyword expansion &optional width)
|
||||
(assert-type keyword keyword)
|
||||
(assert-type expansion (list t))
|
||||
(assert-type width (or null integer (eql t)))
|
||||
(when (gethash keyword (markup-env-macros markup-env))
|
||||
(warn "Redefining markup macro ~S" keyword))
|
||||
(setf (gethash keyword (markup-env-macros markup-env)) expansion)
|
||||
(if width
|
||||
(setf (gethash keyword (markup-env-widths markup-env)) width)
|
||||
(remhash keyword (markup-env-widths markup-env))))
|
||||
|
||||
|
||||
(defun markup-env-append (markup-env keyword expansion)
|
||||
(assert-type keyword keyword)
|
||||
(assert-type expansion (list t))
|
||||
(setf (gethash keyword (markup-env-macros markup-env))
|
||||
(append (gethash keyword (markup-env-macros markup-env)) expansion)))
|
||||
|
||||
|
||||
(defun markup-env-define-alist (markup-env keywords-and-expansions)
|
||||
(dolist (keyword-and-expansion keywords-and-expansions)
|
||||
(let ((keyword (car keyword-and-expansion))
|
||||
(expansion (cdr keyword-and-expansion)))
|
||||
(cond
|
||||
((not (consp keyword))
|
||||
(markup-env-define markup-env keyword expansion))
|
||||
((eq (first keyword) '+)
|
||||
(markup-env-append markup-env (second keyword) expansion))
|
||||
(t (markup-env-define markup-env (first keyword) expansion (second keyword)))))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; LOGICAL POSITIONS
|
||||
|
||||
(defstruct logical-position
|
||||
(n-hard-breaks 0 :type integer) ;Number of :new-line's in the current paragraph or logical block
|
||||
(position 0 :type integer) ;Current character position. If n-hard-breaks is zero, only includes characters written into this logical block
|
||||
; ; plus the minimal position from the enclosing block. If n-hard-breaks is nonzero, includes indent and characters
|
||||
; ; written since the last hard break.
|
||||
(surplus 0 :type integer) ;Value to subtract from position if soft breaks were hard breaks in this logical block
|
||||
(n-soft-breaks nil :type (or null integer)) ;Number of soft-breaks in the current paragraph or nil if not inside a depict-logical-block
|
||||
(indent 0 :type (or null integer))) ;Indent for next line
|
||||
|
||||
|
||||
; Return the value the position would have if soft breaks became hard breaks in this logical block.
|
||||
(declaim (inline logical-position-minimal-position))
|
||||
(defun logical-position-minimal-position (logical-position)
|
||||
(- (logical-position-position logical-position) (logical-position-surplus logical-position)))
|
||||
|
||||
|
||||
; Advance the logical position by width characters. If width is t,
|
||||
; advance to the next line.
|
||||
(defun logical-position-advance (logical-position width)
|
||||
(if (eq width t)
|
||||
(progn
|
||||
(incf (logical-position-n-hard-breaks logical-position))
|
||||
(setf (logical-position-position logical-position) 0)
|
||||
(setf (logical-position-surplus logical-position) 0))
|
||||
(incf (logical-position-position logical-position) width)))
|
||||
|
||||
|
||||
(defstruct (soft-break (:constructor make-soft-break (width)))
|
||||
(width 0 :type integer)) ;Number of spaces by which to replace this soft break if it doesn't turn into a hard break; t if unconditional
|
||||
|
||||
|
||||
; Destructively replace any soft-break that appears in a car position in the tree with
|
||||
; the spliced result of calling f on that soft-break. f should return a non-null list that can
|
||||
; be nconc'd.
|
||||
(defun substitute-soft-breaks (tree f)
|
||||
(do ((subtree tree next-subtree)
|
||||
(next-subtree (cdr tree) (cdr next-subtree)))
|
||||
((endp subtree))
|
||||
(let ((item (car subtree)))
|
||||
(cond
|
||||
((soft-break-p item)
|
||||
(let* ((splice (assert-non-null (funcall f item)))
|
||||
(splice-rest (cdr splice)))
|
||||
(setf (car subtree) (car splice))
|
||||
(setf (cdr subtree) (nconc splice-rest next-subtree))))
|
||||
((consp item) (substitute-soft-breaks item f)))))
|
||||
tree)
|
||||
|
||||
|
||||
; Destructively replace any soft-break that appears in a car position in the tree
|
||||
; with width spaces, where width is the soft-break's width.
|
||||
(defun remove-soft-breaks (tree)
|
||||
(substitute-soft-breaks
|
||||
tree
|
||||
#'(lambda (soft-break)
|
||||
(list (make-string (soft-break-width soft-break) :initial-element #\space :element-type #-mcl 'character #+mcl 'base-character)))))
|
||||
|
||||
|
||||
; Return a freshly consed markup list for a hard line break followed by indent spaces.
|
||||
(defun hard-break-markup (indent)
|
||||
(if (zerop indent)
|
||||
(list ':new-line)
|
||||
(list ':new-line (make-string indent :initial-element #\space :element-type #-mcl 'character #+mcl 'base-character))))
|
||||
|
||||
|
||||
; Destructively replace any soft-break that appears in a car position in the tree
|
||||
; with a line break followed by indent spaces.
|
||||
(defun expand-soft-breaks (tree indent)
|
||||
(substitute-soft-breaks
|
||||
tree
|
||||
#'(lambda (soft-break)
|
||||
(declare (ignore soft-break))
|
||||
(hard-break-markup indent))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; MARKUP STREAMS
|
||||
|
||||
(defstruct (markup-stream (:copier nil) (:predicate markup-stream?))
|
||||
(env nil :type markup-env :read-only t)
|
||||
(level nil :type integer) ;0 for emitting top-level group; 1 for emitting sections; 2 for emitting paragraphs; 3 for emitting paragraph contents
|
||||
(head nil :type list) ;Pointer to a dummy cons-cell whose cdr is the output markup list.
|
||||
; ; A markup-stream may destructively modify any sublists of head that contain a soft-break.
|
||||
(tail nil :type list) ;Last cons cell of the output list; new cells are added in place to this cell's cdr; nil after markup-stream is closed.
|
||||
(pretail nil :type list) ;Tail's predecessor if tail's car is a block that can be inlined at the end of the output list; nil otherwise.
|
||||
(logical-position nil :type logical-position)) ;Information about the current logical lines or nil if not emitting paragraph contents
|
||||
|
||||
; ;RTF ;HTML
|
||||
(defconstant *markup-stream-top-level* 0) ;Top-level group ;Top level
|
||||
(defconstant *markup-stream-section-level* 1) ;Sections ;(not used)
|
||||
(defconstant *markup-stream-paragraph-level* 2) ;Paragraphs ;Block tags
|
||||
(defconstant *markup-stream-content-level* 3) ;Paragraph contents ;Inline tags
|
||||
|
||||
|
||||
; Return the markup accumulated in the markup-stream.
|
||||
; The markup-stream is closed after this function is called.
|
||||
(defun markup-stream-unexpanded-output (markup-stream)
|
||||
(when (markup-stream-pretail markup-stream)
|
||||
;Inline the last block at the end of the markup-stream.
|
||||
(setf (cdr (markup-stream-pretail markup-stream)) (car (markup-stream-tail markup-stream)))
|
||||
(setf (markup-stream-pretail markup-stream) nil))
|
||||
(setf (markup-stream-tail markup-stream) nil) ;Close the stream.
|
||||
(cdr (assert-non-null (markup-stream-head markup-stream))))
|
||||
|
||||
|
||||
; Return the markup accumulated in the markup-stream after expanding all of its macros.
|
||||
; The markup-stream is closed after this function is called.
|
||||
(defgeneric markup-stream-output (markup-stream))
|
||||
|
||||
|
||||
; Append one item to the end of the markup-stream.
|
||||
(defun markup-stream-append1 (markup-stream item)
|
||||
(setf (markup-stream-pretail markup-stream) nil)
|
||||
(let ((item-cons (list item)))
|
||||
(setf (cdr (markup-stream-tail markup-stream)) item-cons)
|
||||
(setf (markup-stream-tail markup-stream) item-cons)))
|
||||
|
||||
|
||||
; Return the approximate width of the markup item; return t if it is a line break.
|
||||
(defun markup-width (markup-stream item)
|
||||
(cond
|
||||
((stringp item) (round (- (length item) (* (count #\space item) (- 1 *average-space-width*)))))
|
||||
((keywordp item) (gethash item (markup-env-widths (markup-stream-env markup-stream)) 0))
|
||||
((and item (symbolp item)) 0)
|
||||
(t (error "Bad item in markup-width" item))))
|
||||
|
||||
|
||||
; Return the approximate width of the markup item; return t if it is a line break.
|
||||
; Also allow markup groups as long as they do not contain line breaks.
|
||||
(defgeneric markup-group-width (markup-stream item))
|
||||
|
||||
|
||||
; Append zero or more markup items to the end of the markup-stream.
|
||||
; The items must be either keywords, symbols, or strings.
|
||||
(defun depict (markup-stream &rest markup-list)
|
||||
(assert-true (>= (markup-stream-level markup-stream) *markup-stream-content-level*))
|
||||
(dolist (markup markup-list)
|
||||
(markup-stream-append1 markup-stream markup)
|
||||
(logical-position-advance (markup-stream-logical-position markup-stream) (markup-width markup-stream markup))))
|
||||
|
||||
|
||||
; Same as depict except that the items may be groups as well.
|
||||
(defun depict-group (markup-stream &rest markup-list)
|
||||
(assert-true (>= (markup-stream-level markup-stream) *markup-stream-content-level*))
|
||||
(dolist (markup markup-list)
|
||||
(markup-stream-append1 markup-stream markup)
|
||||
(logical-position-advance (markup-stream-logical-position markup-stream) (markup-group-width markup-stream markup))))
|
||||
|
||||
|
||||
; If markup-item-or-list is a list, emit its contents via depict.
|
||||
; If markup-item-or-list is not a list, emit it via depict.
|
||||
(defun depict-item-or-list (markup-stream markup-item-or-list)
|
||||
(if (listp markup-item-or-list)
|
||||
(apply #'depict markup-stream markup-item-or-list)
|
||||
(depict markup-stream markup-item-or-list)))
|
||||
|
||||
|
||||
; If markup-item-or-list is a list, emit its contents via depict-group.
|
||||
; If markup-item-or-list is not a list, emit it via depict.
|
||||
(defun depict-item-or-group-list (markup-stream markup-item-or-list)
|
||||
(if (listp markup-item-or-list)
|
||||
(apply #'depict-group markup-stream markup-item-or-list)
|
||||
(depict markup-stream markup-item-or-list)))
|
||||
|
||||
|
||||
; markup-stream must be a variable that names a markup-stream that is currently
|
||||
; accepting paragraphs. Execute body with markup-stream bound to a markup-stream
|
||||
; to which the body can emit contents. If non-null, the given block-style is applied to all
|
||||
; paragraphs emitted by body (in the HTML emitter only; RTF has no block styles).
|
||||
; If flatten is true, do not emit the style if it is already in effect from a surrounding block
|
||||
; or if its contents are empty.
|
||||
; Return the result value of body.
|
||||
(defmacro depict-block-style ((markup-stream block-style &optional flatten) &body body)
|
||||
`(depict-block-style-f ,markup-stream ,block-style ,flatten
|
||||
#'(lambda (,markup-stream) ,@body)))
|
||||
|
||||
(defgeneric depict-block-style-f (markup-stream block-style flatten emitter))
|
||||
|
||||
|
||||
; markup-stream must be a variable that names a markup-stream that is currently
|
||||
; accepting paragraphs. Emit a paragraph with the given paragraph-style (which
|
||||
; must be a symbol) whose contents are emitted by body. When executing body,
|
||||
; markup-stream is bound to a markup-stream to which body should emit the paragraph's contents.
|
||||
; Return the result value of body.
|
||||
(defmacro depict-paragraph ((markup-stream paragraph-style) &body body)
|
||||
`(depict-paragraph-f ,markup-stream ,paragraph-style
|
||||
#'(lambda (,markup-stream) ,@body)))
|
||||
|
||||
(defgeneric depict-paragraph-f (markup-stream paragraph-style emitter))
|
||||
|
||||
|
||||
; markup-stream must be a variable that names a markup-stream that is currently
|
||||
; accepting paragraph contents. Execute body with markup-stream bound to a markup-stream
|
||||
; to which the body can emit contents. If non-null, the given char-style is applied to all such
|
||||
; contents emitted by body.
|
||||
; Return the result value of body.
|
||||
(defmacro depict-char-style ((markup-stream char-style) &body body)
|
||||
`(depict-char-style-f ,markup-stream ,char-style
|
||||
#'(lambda (,markup-stream) ,@body)))
|
||||
|
||||
(defgeneric depict-char-style-f (markup-stream char-style emitter))
|
||||
|
||||
|
||||
; Ensure that the given style is not currently in effect in the markup-stream.
|
||||
; RTF streams don't currently keep track of styles, so this function does nothing for RTF streams.
|
||||
(defgeneric ensure-no-enclosing-style (markup-stream style))
|
||||
|
||||
|
||||
; Return a value that captures the current sequence of enclosing block styles.
|
||||
(defgeneric save-block-style (markup-stream))
|
||||
|
||||
; markup-stream must be a variable that names a markup-stream that is currently
|
||||
; accepting paragraphs. Execute body with markup-stream bound to a markup-stream
|
||||
; to which the body can emit contents. The given saved-block-style is applied to all
|
||||
; paragraphs emitted by body (in the HTML emitter only; RTF has no block styles).
|
||||
; saved-block-style should have been obtained from a past call to save-block-style.
|
||||
; If flatten is true, do not emit the style if it is already in effect from a surrounding block
|
||||
; or if its contents are empty.
|
||||
; Return the result value of body.
|
||||
(defmacro with-saved-block-style ((markup-stream saved-block-style &optional flatten) &body body)
|
||||
`(with-saved-block-style-f ,markup-stream ,saved-block-style ,flatten
|
||||
#'(lambda (,markup-stream) ,@body)))
|
||||
|
||||
(defgeneric with-saved-block-style-f (markup-stream saved-block-style flatten emitter))
|
||||
|
||||
|
||||
; Depict an anchor. The concatenation of link-prefix and link-name must be a string
|
||||
; suitable for an anchor name.
|
||||
; If duplicate is true, allow duplicate calls for the same link-name, in which case only
|
||||
; the first one takes effect.
|
||||
(defgeneric depict-anchor (markup-stream link-prefix link-name duplicate))
|
||||
|
||||
|
||||
; markup-stream must be a variable that names a markup-stream that is currently
|
||||
; accepting paragraph contents. Execute body with markup-stream bound to a markup-stream
|
||||
; to which the body can emit contents. The given link name is the destination of a local
|
||||
; link for which body is the contents. The concatenation of link-prefix and link-name
|
||||
; must be a string suitable for an anchor name.
|
||||
; Return the result value of body.
|
||||
(defmacro depict-link-reference ((markup-stream link-prefix link-name external) &body body)
|
||||
`(depict-link-reference-f ,markup-stream ,link-prefix ,link-name ,external
|
||||
#'(lambda (,markup-stream) ,@body)))
|
||||
|
||||
(defgeneric depict-link-reference-f (markup-stream link-prefix link-name external emitter))
|
||||
|
||||
|
||||
; markup-stream must be a variable that names a markup-stream that is currently
|
||||
; accepting paragraph contents. Execute body with markup-stream bound to a markup-stream
|
||||
; to which the body can emit contents. Depending on link, do one of the following:
|
||||
; :reference Emit a reference to the link with the given body of the reference;
|
||||
; :external Emit an external reference to the link with the given body of the reference;
|
||||
; :definition Emit the link as an anchor, followed by the body;
|
||||
; nil Emit the body only.
|
||||
; If duplicate is true, allow duplicate anchors, in which case only the first one takes effect.
|
||||
; Return the result value of body.
|
||||
(defmacro depict-link ((markup-stream link link-prefix link-name duplicate) &body body)
|
||||
`(depict-link-f ,markup-stream ,link ,link-prefix ,link-name ,duplicate
|
||||
#'(lambda (,markup-stream) ,@body)))
|
||||
|
||||
(defun depict-link-f (markup-stream link link-prefix link-name duplicate emitter)
|
||||
(ecase link
|
||||
(:reference (depict-link-reference-f markup-stream link-prefix link-name nil emitter))
|
||||
(:external (depict-link-reference-f markup-stream link-prefix link-name t emitter))
|
||||
(:definition
|
||||
(depict-anchor markup-stream link-prefix link-name duplicate)
|
||||
(funcall emitter markup-stream))
|
||||
((nil) (funcall emitter markup-stream))))
|
||||
|
||||
|
||||
(defun depict-logical-block-f (markup-stream indent emitter)
|
||||
(assert-true (>= (markup-stream-level markup-stream) *markup-stream-content-level*))
|
||||
(if indent
|
||||
(let* ((logical-position (markup-stream-logical-position markup-stream))
|
||||
(cumulative-indent (+ (logical-position-indent logical-position) indent))
|
||||
(minimal-position (logical-position-minimal-position logical-position))
|
||||
(inner-logical-position (make-logical-position :position minimal-position
|
||||
:n-soft-breaks 0
|
||||
:indent cumulative-indent))
|
||||
(old-tail (markup-stream-tail markup-stream)))
|
||||
(setf (markup-stream-logical-position markup-stream) inner-logical-position)
|
||||
(when *show-logical-blocks*
|
||||
(markup-stream-append1 markup-stream (list ':invisible (format nil "<~D" indent))))
|
||||
(prog1
|
||||
(funcall emitter markup-stream)
|
||||
(when *show-logical-blocks*
|
||||
(markup-stream-append1 markup-stream '(:invisible ">")))
|
||||
(assert-true (eq (markup-stream-logical-position markup-stream) inner-logical-position))
|
||||
(let* ((tree (cdr old-tail))
|
||||
(inner-position (logical-position-position inner-logical-position))
|
||||
(inner-count (- inner-position minimal-position))
|
||||
(inner-n-hard-breaks (logical-position-n-hard-breaks inner-logical-position))
|
||||
(inner-n-soft-breaks (logical-position-n-soft-breaks inner-logical-position)))
|
||||
(when *trace-logical-blocks*
|
||||
(format *trace-output* "Block ~:W:~%position ~D, count ~D, n-hard-breaks ~D, n-soft-breaks ~D~%~%"
|
||||
tree inner-position inner-count inner-n-hard-breaks inner-n-soft-breaks))
|
||||
(cond
|
||||
((zerop inner-n-soft-breaks)
|
||||
(assert-true (zerop (logical-position-surplus inner-logical-position)))
|
||||
(if (zerop inner-n-hard-breaks)
|
||||
(incf (logical-position-position logical-position) inner-count)
|
||||
(progn
|
||||
(incf (logical-position-n-hard-breaks logical-position) inner-n-hard-breaks)
|
||||
(setf (logical-position-position logical-position) inner-position)
|
||||
(setf (logical-position-surplus logical-position) 0))))
|
||||
((and (zerop inner-n-hard-breaks) (<= inner-position *markup-logical-line-width*))
|
||||
(assert-true tree)
|
||||
(remove-soft-breaks tree)
|
||||
(incf (logical-position-position logical-position) inner-count))
|
||||
(t
|
||||
(assert-true tree)
|
||||
(expand-soft-breaks tree cumulative-indent)
|
||||
(incf (logical-position-n-hard-breaks logical-position) (+ inner-n-hard-breaks inner-n-soft-breaks))
|
||||
(setf (logical-position-position logical-position) (logical-position-minimal-position inner-logical-position))
|
||||
(setf (logical-position-surplus logical-position) 0))))
|
||||
(setf (markup-stream-logical-position markup-stream) logical-position)))
|
||||
(funcall emitter markup-stream)))
|
||||
|
||||
|
||||
; markup-stream must be a variable that names a markup-stream that is currently
|
||||
; accepting paragraph contents. Execute body with markup-stream bound to a markup-stream
|
||||
; to which the body can emit contents. body can call depict-break, which will either
|
||||
; all expand to the widths given to the depict-break calls or all expand to line breaks
|
||||
; followed by indents to the current indent level plus the given indent.
|
||||
; If indent is nil, don't create the logical block and just evaluate body.
|
||||
; Return the result value of body.
|
||||
(defmacro depict-logical-block ((markup-stream indent) &body body)
|
||||
`(depict-logical-block-f ,markup-stream ,indent
|
||||
#'(lambda (,markup-stream) ,@body)))
|
||||
|
||||
|
||||
; Emit a conditional line break. If the line break is not needed, emit width spaces instead.
|
||||
; If width is t or omitted, the line break is unconditional.
|
||||
; If width is nil, do nothing.
|
||||
; If the line break is needed, the new line is indented to the current indent level.
|
||||
; Must be called from the dynamic scope of a depict-logical-block.
|
||||
(defun depict-break (markup-stream &optional (width t))
|
||||
(assert-true (>= (markup-stream-level markup-stream) *markup-stream-content-level*))
|
||||
(when width
|
||||
(let* ((logical-position (markup-stream-logical-position markup-stream))
|
||||
(indent (logical-position-indent logical-position)))
|
||||
(if (eq width t)
|
||||
(depict-item-or-list markup-stream (hard-break-markup indent))
|
||||
(progn
|
||||
(incf (logical-position-n-soft-breaks logical-position))
|
||||
(incf (logical-position-position logical-position) width)
|
||||
(let ((surplus (- (logical-position-position logical-position) (round (* indent *average-space-width*)))))
|
||||
(when (< surplus 0)
|
||||
(setq surplus 0))
|
||||
(setf (logical-position-surplus logical-position) surplus))
|
||||
(when *show-logical-blocks*
|
||||
(markup-stream-append1 markup-stream '(:invisible :bullet)))
|
||||
(markup-stream-append1 markup-stream (make-soft-break width)))))))
|
||||
|
||||
|
||||
; Call emitter to emit each element of the given list onto the markup-stream.
|
||||
; emitter takes two arguments -- the markup-stream and the element of list to be emitted.
|
||||
; Emit prefix before the list and suffix after the list. If prefix-break is supplied, call
|
||||
; depict-break with it as the argument after the prefix.
|
||||
; If indent is non-nil, enclose the list elements in a logical block with the given indent.
|
||||
; Emit separator between any two emitted elements. If break is supplied, call
|
||||
; depict-break with it as the argument after each separator.
|
||||
; If the list is empty, emit empty unless it is :error, in which case signal an error.
|
||||
;
|
||||
; prefix, suffix, separator, and empty should be lists of markup elements appropriate for depict.
|
||||
; If any of these lists has only one element that is not itself a list, then that list can be
|
||||
; abbreviated to just that element (as in depict-item-or-list).
|
||||
;
|
||||
(defun depict-list (markup-stream emitter list &key indent prefix prefix-break suffix separator break (empty :error))
|
||||
(assert-true (or indent (not (or prefix-break break))))
|
||||
(labels
|
||||
((emit-element (markup-stream list)
|
||||
(funcall emitter markup-stream (first list))
|
||||
(let ((rest (rest list)))
|
||||
(when rest
|
||||
(depict-item-or-list markup-stream separator)
|
||||
(depict-break markup-stream break)
|
||||
(emit-element markup-stream rest)))))
|
||||
|
||||
(depict-item-or-list markup-stream prefix)
|
||||
(cond
|
||||
(list
|
||||
(depict-logical-block (markup-stream indent)
|
||||
(depict-break markup-stream prefix-break)
|
||||
(emit-element markup-stream list)))
|
||||
((eq empty ':error) (error "Non-empty list required"))
|
||||
(t (depict-item-or-list markup-stream empty)))
|
||||
(depict-item-or-list markup-stream suffix)))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; MARKUP FOR CHARACTERS AND STRINGS
|
||||
|
||||
(defparameter *character-names*
|
||||
'((#x00 . "NUL")
|
||||
(#x08 . "BS")
|
||||
(#x09 . "TAB")
|
||||
(#x0A . "LF")
|
||||
(#x0B . "VT")
|
||||
(#x0C . "FF")
|
||||
(#x0D . "CR")
|
||||
(#x20 . "SP")))
|
||||
|
||||
; Emit markup for the given character. The character is emitted without any formatting if it is a
|
||||
; printable character and not a member of the escape-list list of characters. Otherwise the
|
||||
; character is emitted with :character-literal-control formatting.
|
||||
; The markup-stream should already be set to :character-literal formatting.
|
||||
(defun depict-character (markup-stream char &optional (escape-list '(#\space)))
|
||||
(let ((code (char-code char)))
|
||||
(if (and (>= code 32) (< code 127) (not (member char escape-list)))
|
||||
(depict markup-stream (string char))
|
||||
(depict-char-style (markup-stream ':character-literal-control)
|
||||
(let ((name (or (cdr (assoc code *character-names*))
|
||||
(format nil "u~4,'0X" code))))
|
||||
(depict markup-stream ':left-angle-quote name ':right-angle-quote))))))
|
||||
|
||||
|
||||
; Emit markup for the given string, enclosing it in curly double quotes.
|
||||
; The markup-stream should be set to normal formatting.
|
||||
(defun depict-string (markup-stream string)
|
||||
(depict markup-stream ':left-double-quote)
|
||||
(unless (equal string "")
|
||||
(depict-char-style (markup-stream ':character-literal)
|
||||
(dotimes (i (length string))
|
||||
(depict-character markup-stream (char string i) nil))))
|
||||
(depict markup-stream ':right-double-quote))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; IDENTIFIER ABBREVIATIONS
|
||||
|
||||
; Return a symbol with the same package as the given symbol but whose name omits everything
|
||||
; after the first underscore, if any, in the given symbol's name. The returned symbol is eq
|
||||
; to the given symbol if its name contains no underscores.
|
||||
(defun symbol-to-abbreviation (symbol)
|
||||
(let* ((name (symbol-name symbol))
|
||||
(pos (position #\_ name)))
|
||||
(if pos
|
||||
(intern (subseq name 0 pos) (symbol-package symbol))
|
||||
symbol)))
|
||||
|
||||
|
||||
; A caching version of symbol-to-abbreviation.
|
||||
(defun symbol-abbreviation (symbol)
|
||||
(or (get symbol :abbreviation)
|
||||
(setf (get symbol :abbreviation) (symbol-to-abbreviation symbol))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; MARKUP FOR IDENTIFIERS
|
||||
|
||||
; Return string converted from dash-separated-uppercase-words to mixed case,
|
||||
; with the first character capitalized if capitalize is true.
|
||||
; The string should contain only letters, dashes, and numbers.
|
||||
(defun string-to-mixed-case (string &optional capitalize)
|
||||
(let* ((length (length string))
|
||||
(dst-string (make-array length :element-type #-mcl 'character #+mcl 'base-character :fill-pointer 0)))
|
||||
(dotimes (i length)
|
||||
(let ((char (char string i)))
|
||||
(if (eql char #\-)
|
||||
(if capitalize
|
||||
(error "Double capitalize")
|
||||
(setq capitalize t))
|
||||
(progn
|
||||
(cond
|
||||
((upper-case-p char)
|
||||
(if capitalize
|
||||
(setq capitalize nil)
|
||||
(setq char (char-downcase char))))
|
||||
((digit-char-p char))
|
||||
((member char '(#\$ #\_)))
|
||||
(t (error "Bad string-to-mixed-case character ~A" char)))
|
||||
(vector-push char dst-string)))))
|
||||
dst-string))
|
||||
|
||||
|
||||
; Return a string containing the symbol's name in mixed case with the first letter capitalized.
|
||||
(defun symbol-upper-mixed-case-name (symbol)
|
||||
(or (get symbol :upper-mixed-case-name)
|
||||
(setf (get symbol :upper-mixed-case-name) (string-to-mixed-case (symbol-name symbol) t))))
|
||||
|
||||
|
||||
; Return a string containing the symbol's name in mixed case with the first letter in lower case.
|
||||
(defun symbol-lower-mixed-case-name (symbol)
|
||||
(or (get symbol :lower-mixed-case-name)
|
||||
(setf (get symbol :lower-mixed-case-name) (string-to-mixed-case (symbol-name symbol)))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; MISCELLANEOUS MARKUP
|
||||
|
||||
|
||||
; Append a space to the end of the markup-stream.
|
||||
(defun depict-space (markup-stream)
|
||||
(depict markup-stream " "))
|
||||
|
||||
|
||||
; Emit markup for the given integer, displaying it in decimal.
|
||||
(defun depict-integer (markup-stream i)
|
||||
(depict markup-stream (format nil "~D" i)))
|
||||
|
||||
|
||||
(defmacro styled-text-depictor (symbol)
|
||||
`(get ,symbol 'styled-text-depictor))
|
||||
|
||||
|
||||
; Emit markup for the given <text>, which should be a list of:
|
||||
; <string> display as is
|
||||
; <keyword> display as is
|
||||
; (<symbol> . <args>) if <symbol>'s styled-text-depictor property is present, call it giving it <args>
|
||||
; as arguments; otherwise treat this case as the following:
|
||||
; (<style> . <text>) display <text> with the given <style> keyword
|
||||
; <character> display using depict-character
|
||||
(defun depict-styled-text (markup-stream text)
|
||||
(dolist (item text)
|
||||
(cond
|
||||
((or (stringp item) (keywordp item))
|
||||
(depict markup-stream item))
|
||||
((consp item)
|
||||
(let* ((first (first item))
|
||||
(rest (rest item))
|
||||
(depictor (styled-text-depictor first)))
|
||||
(if depictor
|
||||
(apply depictor markup-stream rest)
|
||||
(depict-char-style (markup-stream first)
|
||||
(depict-styled-text markup-stream rest)))))
|
||||
((characterp item)
|
||||
(depict-character markup-stream item))
|
||||
(t (error "Bad depict-styled-text item: ~S" item)))))
|
||||
@@ -1,360 +0,0 @@
|
||||
;;; The contents of this file are subject to the Mozilla Public
|
||||
;;; License Version 1.1 (the "License"); you may not use this file
|
||||
;;; except in compliance with the License. You may obtain a copy of
|
||||
;;; the License at http://www.mozilla.org/MPL/
|
||||
;;;
|
||||
;;; Software distributed under the License is distributed on an "AS
|
||||
;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
;;; implied. See the License for the specific language governing
|
||||
;;; rights and limitations under the License.
|
||||
;;;
|
||||
;;; The Original Code is the Language Design and Prototyping Environment.
|
||||
;;;
|
||||
;;; The Initial Developer of the Original Code is Netscape Communications
|
||||
;;; Corporation. Portions created by Netscape Communications Corporation are
|
||||
;;; Copyright (C) 1999 Netscape Communications Corporation. All
|
||||
;;; Rights Reserved.
|
||||
;;;
|
||||
;;; Contributor(s): Waldemar Horwat <waldemar@acm.org>
|
||||
|
||||
;;;
|
||||
;;; Finite-state machine generator
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; METATRANSITION
|
||||
|
||||
(defstruct (metatransition (:constructor make-metatransition (next-metastate pre-productions post-productions)))
|
||||
(next-metastate nil :read-only t) ;Next metastate to enter or nil if this is an accept transition
|
||||
(pre-productions nil :read-only t) ;List of productions reduced by this transition (in order from first to last) before the shift
|
||||
(post-productions nil :read-only t)) ;List of productions reduced by this transition (in order from first to last) after the shift
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; METASTATE
|
||||
|
||||
;;; A metastate is a list of states that represents a possible stack that the
|
||||
;;; LALR(1) parser may encounter.
|
||||
(defstruct (metastate (:constructor make-metastate (stack number transitions)))
|
||||
(stack nil :type list :read-only t) ;List of states that comprises a possible stack
|
||||
(number nil :type integer :read-only t) ;Serial number of this metastate
|
||||
(transitions nil :type simple-vector :read-only t)) ;Array, indexed by terminal numbers, of either nil or metatransition structures
|
||||
|
||||
(declaim (inline metastate-transition))
|
||||
(defun metastate-transition (metastate terminal-number)
|
||||
(svref (metastate-transitions metastate) terminal-number))
|
||||
|
||||
|
||||
(defun print-metastate (metastate metagrammar &optional (stream t))
|
||||
(let ((grammar (metagrammar-grammar metagrammar)))
|
||||
(pprint-logical-block (stream nil)
|
||||
(format stream "M~D:~2I ~@_~<~@{S~D ~:_~}~:>~:@_"
|
||||
(metastate-number metastate)
|
||||
(nreverse (mapcar #'state-number (metastate-stack metastate))))
|
||||
(let ((transitions (metastate-transitions metastate)))
|
||||
(dotimes (terminal-number (length transitions))
|
||||
(let ((transition (svref transitions terminal-number))
|
||||
(terminal (svref (grammar-terminals grammar) terminal-number)))
|
||||
(when transition
|
||||
(let ((next-metastate (metatransition-next-metastate transition)))
|
||||
(pprint-logical-block (stream nil)
|
||||
(format stream "~W ==> ~@_~:I~:[accept~;M~:*~D~] ~_"
|
||||
terminal
|
||||
(and next-metastate (metastate-number next-metastate)))
|
||||
(pprint-fill stream (mapcar #'production-name (metatransition-pre-productions transition)))
|
||||
(format stream " ~@_")
|
||||
(pprint-fill stream (mapcar #'production-name (metatransition-post-productions transition))))
|
||||
(pprint-newline :mandatory stream)))))))))
|
||||
|
||||
|
||||
(defmethod print-object ((metastate metastate) stream)
|
||||
(print-unreadable-object (metastate stream)
|
||||
(format stream "metastate S~D" (metastate-number metastate))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; METAGRAMMAR
|
||||
|
||||
(defstruct (metagrammar (:constructor allocate-metagrammar))
|
||||
(grammar nil :type grammar :read-only t) ;The grammar to which this metagrammar corresponds
|
||||
(metastates nil :type list :read-only t) ;List of metastates ordered by metastate numbers
|
||||
(start nil :type metastate :read-only t)) ;The start metastate
|
||||
|
||||
|
||||
(defun make-metagrammar (grammar)
|
||||
(let* ((terminals (grammar-terminals grammar))
|
||||
(n-terminals (length terminals))
|
||||
(metastates-hash (make-hash-table :test #'equal)) ;Hash table of (list of state) -> metastate
|
||||
(metastates nil)
|
||||
(metastate-number -1))
|
||||
(labels
|
||||
(;Return the stack after applying the given reduction production.
|
||||
(apply-reduction-production (stack production)
|
||||
(let* ((stack (nthcdr (production-rhs-length production) stack))
|
||||
(state (first stack))
|
||||
(dst-state (assert-non-null
|
||||
(cdr (assoc (production-lhs production) (state-gotos state) :test *grammar-symbol-=*))))
|
||||
(dst-stack (cons dst-state stack)))
|
||||
(if (member dst-state stack :test #'eq)
|
||||
(error "This grammar cannot be represented by a FSM. Stack: ~S" dst-stack)
|
||||
dst-stack)))
|
||||
|
||||
(get-metatransition (stack terminal productions)
|
||||
(let* ((state (first stack))
|
||||
(transition (cdr (assoc terminal (state-transitions state) :test *grammar-symbol-=*))))
|
||||
(when transition
|
||||
(case (transition-kind transition)
|
||||
(:shift
|
||||
(multiple-value-bind (metastate forwarding-productions) (get-metastate (transition-state transition) stack t)
|
||||
(make-metatransition metastate (nreverse productions) forwarding-productions)))
|
||||
(:reduce
|
||||
(let ((production (transition-production transition)))
|
||||
(get-metatransition (apply-reduction-production stack production) terminal (cons production productions))))
|
||||
(:accept (make-metatransition nil (nreverse productions) nil))
|
||||
(t (error "Bad transition: ~S" transition))))))
|
||||
|
||||
;Return the metastate corresponding to the state stack (stack-top . stack-rest). Construct a new
|
||||
;metastate if necessary.
|
||||
;If simplify is true and stack-top is a state for which every outgoing transition is the same
|
||||
;reduction, return two values:
|
||||
; the metastate reached by following that reduction (doing it recursively if needed)
|
||||
; a list of reduction productions followed this way.
|
||||
(get-metastate (stack-top stack-rest simplify)
|
||||
(let* ((stack (cons stack-top stack-rest))
|
||||
(existing-metastate (gethash stack metastates-hash)))
|
||||
(cond
|
||||
(existing-metastate (values existing-metastate nil))
|
||||
((member stack-top stack-rest :test #'eq)
|
||||
(error "This grammar cannot be represented by a FSM. Stack: ~S" stack))
|
||||
(t (let ((forwarding-production (and simplify (forwarding-state-production stack-top))))
|
||||
(if forwarding-production
|
||||
(let ((stack (apply-reduction-production stack forwarding-production)))
|
||||
(multiple-value-bind (metastate forwarding-productions) (get-metastate (car stack) (cdr stack) simplify)
|
||||
(values metastate (cons forwarding-production forwarding-productions))))
|
||||
(let* ((transitions (make-array n-terminals :initial-element nil))
|
||||
(metastate (make-metastate stack (incf metastate-number) transitions)))
|
||||
(setf (gethash stack metastates-hash) metastate)
|
||||
(push metastate metastates)
|
||||
(dotimes (n n-terminals)
|
||||
(setf (svref transitions n)
|
||||
(get-metatransition stack (svref terminals n) nil)))
|
||||
(values metastate nil)))))))))
|
||||
|
||||
(let ((start-metastate (get-metastate (grammar-start-state grammar) nil nil)))
|
||||
(allocate-metagrammar :grammar grammar
|
||||
:metastates (nreverse metastates)
|
||||
:start start-metastate)))))
|
||||
|
||||
|
||||
; Print the metagrammar nicely.
|
||||
(defun print-metagrammar (metagrammar &optional (stream t) &key (grammar t) (details t))
|
||||
(pprint-logical-block (stream nil)
|
||||
(when grammar
|
||||
(print-grammar (metagrammar-grammar metagrammar) stream :details details))
|
||||
|
||||
;Print the metastates.
|
||||
(format stream "Start metastate: ~@_M~D~:@_~:@_" (metastate-number (metagrammar-start metagrammar)))
|
||||
(pprint-logical-block (stream (metagrammar-metastates metagrammar))
|
||||
(pprint-exit-if-list-exhausted)
|
||||
(format stream "Metastates:~2I~:@_")
|
||||
(loop
|
||||
(print-metastate (pprint-pop) metagrammar stream)
|
||||
(pprint-exit-if-list-exhausted)
|
||||
(pprint-newline :mandatory stream))))
|
||||
(pprint-newline :mandatory stream))
|
||||
|
||||
|
||||
(defmethod print-object ((metagrammar metagrammar) stream)
|
||||
(print-unreadable-object (metagrammar stream :identity t)
|
||||
(write-string "metagrammar" stream)))
|
||||
|
||||
|
||||
; Find the longest possible prefix of the input list of tokens that is accepted by the
|
||||
; grammar. Parse that prefix and return two values:
|
||||
; the list of action results;
|
||||
; the tail of the input list of tokens remaining to be parsed.
|
||||
; Signal an error if no prefix of the input list is accepted by the grammar.
|
||||
;
|
||||
; token-terminal is a function that returns a terminal symbol when given an input token.
|
||||
; If trace is:
|
||||
; nil, don't print trace information
|
||||
; :code, print trace information, including action code
|
||||
; other print trace information
|
||||
(defun action-metaparse (metagrammar token-terminal input &key trace)
|
||||
(if trace
|
||||
(trace-action-metaparse metagrammar token-terminal input trace)
|
||||
(let ((grammar (metagrammar-grammar metagrammar)))
|
||||
(labels
|
||||
((transition-value-stack (value-stack productions)
|
||||
(dolist (production productions)
|
||||
(setq value-stack (funcall (production-evaluator production) value-stack)))
|
||||
value-stack)
|
||||
|
||||
(cut (input good-metastate good-input good-value-stack)
|
||||
(unless good-metastate
|
||||
(error "Parse error on ~S ..." (ldiff input (nthcdr 10 input))))
|
||||
(let ((last-metatransition (metastate-transition good-metastate *end-marker-terminal-number*)))
|
||||
(assert-true (null (metatransition-next-metastate last-metatransition)))
|
||||
(assert-true (null (metatransition-post-productions last-metatransition)))
|
||||
(values
|
||||
(reverse (transition-value-stack good-value-stack (metatransition-pre-productions last-metatransition)))
|
||||
good-input))))
|
||||
|
||||
(do ((metastate (metagrammar-start metagrammar))
|
||||
(input input (cdr input))
|
||||
(value-stack nil)
|
||||
(last-good-metastate nil)
|
||||
last-good-input
|
||||
last-good-value-stack)
|
||||
(nil)
|
||||
(when (metastate-transition metastate *end-marker-terminal-number*)
|
||||
(setq last-good-metastate metastate)
|
||||
(setq last-good-input input)
|
||||
(setq last-good-value-stack value-stack))
|
||||
(when (endp input)
|
||||
(return (cut input last-good-metastate last-good-input last-good-value-stack)))
|
||||
(let* ((token (first input))
|
||||
(terminal (funcall token-terminal token))
|
||||
(terminal-number (terminal-number grammar terminal))
|
||||
(metatransition (metastate-transition metastate terminal-number)))
|
||||
(unless metatransition
|
||||
(return (cut input last-good-metastate last-good-input last-good-value-stack)))
|
||||
(setq value-stack (transition-value-stack value-stack (metatransition-pre-productions metatransition)))
|
||||
(dolist (action-function-binding (gethash terminal (grammar-terminal-actions grammar)))
|
||||
(push (funcall (cdr action-function-binding) token) value-stack))
|
||||
(setq value-stack (transition-value-stack value-stack (metatransition-post-productions metatransition)))
|
||||
(setq metastate (metatransition-next-metastate metatransition))))))))
|
||||
|
||||
|
||||
; Same as action-parse, but with tracing information
|
||||
; If trace is:
|
||||
; :code, print trace information, including action code
|
||||
; other print trace information
|
||||
(defun trace-action-metaparse (metagrammar token-terminal input trace)
|
||||
(let
|
||||
((grammar (metagrammar-grammar metagrammar)))
|
||||
(labels
|
||||
((print-stacks (value-stack type-stack)
|
||||
(write-string " " *trace-output*)
|
||||
(if value-stack
|
||||
(print-values (reverse value-stack) (reverse type-stack) *trace-output*)
|
||||
(write-string "empty" *trace-output*))
|
||||
(pprint-newline :mandatory *trace-output*))
|
||||
|
||||
(transition-value-stack (value-stack type-stack productions)
|
||||
(dolist (production productions)
|
||||
(write-string " reduce " *trace-output*)
|
||||
(if (eq trace :code)
|
||||
(write production :stream *trace-output* :pretty t)
|
||||
(print-production production *trace-output*))
|
||||
(pprint-newline :mandatory *trace-output*)
|
||||
(setq value-stack (funcall (production-evaluator production) value-stack))
|
||||
(setq type-stack (nthcdr (production-n-action-args production) type-stack))
|
||||
(dolist (action-signature (grammar-symbol-signature grammar (production-lhs production)))
|
||||
(push (cdr action-signature) type-stack))
|
||||
(print-stacks value-stack type-stack))
|
||||
(values value-stack type-stack))
|
||||
|
||||
(cut (input good-metastate good-input good-value-stack good-type-stack)
|
||||
(unless good-metastate
|
||||
(error "Parse error on ~S ..." (ldiff input (nthcdr 10 input))))
|
||||
(let ((last-metatransition (metastate-transition good-metastate *end-marker-terminal-number*)))
|
||||
(assert-true (null (metatransition-next-metastate last-metatransition)))
|
||||
(assert-true (null (metatransition-post-productions last-metatransition)))
|
||||
(format *trace-output* "cut to M~D~:@_" (metastate-number good-metastate))
|
||||
(print-stacks good-value-stack good-type-stack)
|
||||
(pprint-newline :mandatory *trace-output*)
|
||||
(values
|
||||
(reverse (transition-value-stack good-value-stack good-type-stack (metatransition-pre-productions last-metatransition)))
|
||||
good-input))))
|
||||
|
||||
(do ((metastate (metagrammar-start metagrammar))
|
||||
(input input (cdr input))
|
||||
(value-stack nil)
|
||||
(type-stack nil)
|
||||
(last-good-metastate nil)
|
||||
last-good-input
|
||||
last-good-value-stack
|
||||
last-good-type-stack)
|
||||
(nil)
|
||||
(format *trace-output* "M~D" (metastate-number metastate))
|
||||
(when (metastate-transition metastate *end-marker-terminal-number*)
|
||||
(write-string " (good)" *trace-output*)
|
||||
(setq last-good-metastate metastate)
|
||||
(setq last-good-input input)
|
||||
(setq last-good-value-stack value-stack)
|
||||
(setq last-good-type-stack type-stack))
|
||||
(write-string ": " *trace-output*)
|
||||
(when (endp input)
|
||||
(return (cut input last-good-metastate last-good-input last-good-value-stack last-good-type-stack)))
|
||||
(let* ((token (first input))
|
||||
(terminal (funcall token-terminal token))
|
||||
(terminal-number (terminal-number grammar terminal))
|
||||
(metatransition (metastate-transition metastate terminal-number)))
|
||||
(unless metatransition
|
||||
(format *trace-output* "shift ~W: " terminal)
|
||||
(return (cut input last-good-metastate last-good-input last-good-value-stack last-good-type-stack)))
|
||||
(format *trace-output* "transition to M~D~:@_" (metastate-number (metatransition-next-metastate metatransition)))
|
||||
(multiple-value-setq (value-stack type-stack)
|
||||
(transition-value-stack value-stack type-stack (metatransition-pre-productions metatransition)))
|
||||
(dolist (action-function-binding (gethash terminal (grammar-terminal-actions grammar)))
|
||||
(push (funcall (cdr action-function-binding) token) value-stack))
|
||||
(dolist (action-signature (grammar-symbol-signature grammar terminal))
|
||||
(push (cdr action-signature) type-stack))
|
||||
(format *trace-output* "shift ~W~:@_" terminal)
|
||||
(print-stacks value-stack type-stack)
|
||||
(multiple-value-setq (value-stack type-stack)
|
||||
(transition-value-stack value-stack type-stack (metatransition-post-productions metatransition)))
|
||||
(setq metastate (metatransition-next-metastate metatransition)))))))
|
||||
|
||||
|
||||
; Compute all representative strings of terminals such that, for each such string S:
|
||||
; S is rejected by the grammar's language;
|
||||
; all prefixes of S are also rejected by the grammar's language;
|
||||
; for any S and all strings of terminals T, the concatenated string ST is also
|
||||
; rejected by the grammar's language;
|
||||
; no string S1 is a prefix of (or equal to) another string S2.
|
||||
; Often there are infinitely many such strings S, so only output one for each illegal
|
||||
; metaparser transition.
|
||||
; Return a list of S's, where each S is itself a list of terminals.
|
||||
(defun compute-illegal-strings (metagrammar)
|
||||
(let* ((grammar (metagrammar-grammar metagrammar))
|
||||
(terminals (grammar-terminals grammar))
|
||||
(n-terminals (length terminals))
|
||||
(metastates (metagrammar-metastates metagrammar))
|
||||
(n-metastates (length metastates))
|
||||
(visited-metastates (make-array n-metastates :element-type 'bit :initial-element 0))
|
||||
(illegal-strings nil))
|
||||
(labels
|
||||
((visit (metastate reversed-string)
|
||||
(let ((metastate-number (metastate-number metastate)))
|
||||
(when (= (sbit visited-metastates metastate-number) 0)
|
||||
(setf (sbit visited-metastates metastate-number) 1)
|
||||
(let ((metatransitions (metastate-transitions metastate)))
|
||||
;If there is a transition for the end marker from this state, then string
|
||||
;is accepted by the language, so cut off the search.
|
||||
(unless (svref metatransitions *end-marker-terminal-number*)
|
||||
(dotimes (terminal-number n-terminals)
|
||||
(unless (= terminal-number *end-marker-terminal-number*)
|
||||
(let ((metatransition (svref metatransitions terminal-number))
|
||||
(reversed-string (cons (svref terminals terminal-number) reversed-string)))
|
||||
(if metatransition
|
||||
(visit (metatransition-next-metastate metatransition) reversed-string)
|
||||
(push (reverse reversed-string) illegal-strings)))))))))))
|
||||
|
||||
(visit (metagrammar-start metagrammar) nil)
|
||||
(nreverse illegal-strings))))
|
||||
|
||||
|
||||
; Compute and print illegal strings of terminals. See compute-illegal-strings.
|
||||
(defun print-illegal-strings (metagrammar &optional (stream t))
|
||||
(pprint-logical-block (stream (compute-illegal-strings metagrammar))
|
||||
(format stream "Illegal strings:~2I")
|
||||
(loop
|
||||
(pprint-exit-if-list-exhausted)
|
||||
(pprint-newline :mandatory stream)
|
||||
(pprint-fill stream (pprint-pop))))
|
||||
(pprint-newline :mandatory stream))
|
||||
@@ -1,837 +0,0 @@
|
||||
;;; The contents of this file are subject to the Mozilla Public
|
||||
;;; License Version 1.1 (the "License"); you may not use this file
|
||||
;;; except in compliance with the License. You may obtain a copy of
|
||||
;;; the License at http://www.mozilla.org/MPL/
|
||||
;;;
|
||||
;;; Software distributed under the License is distributed on an "AS
|
||||
;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
;;; implied. See the License for the specific language governing
|
||||
;;; rights and limitations under the License.
|
||||
;;;
|
||||
;;; The Original Code is the Language Design and Prototyping Environment.
|
||||
;;;
|
||||
;;; The Initial Developer of the Original Code is Netscape Communications
|
||||
;;; Corporation. Portions created by Netscape Communications Corporation are
|
||||
;;; Copyright (C) 1999 Netscape Communications Corporation. All
|
||||
;;; Rights Reserved.
|
||||
;;;
|
||||
;;; Contributor(s): Waldemar Horwat <waldemar@acm.org>
|
||||
|
||||
;;;
|
||||
;;; LALR(1) and LR(1) grammar generator
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
|
||||
; kernel-item-alist is a list of pairs (item . prev), where item is a kernel item
|
||||
; and prev is either nil or a laitem. kernel is a list of the kernel items in a canonical order.
|
||||
; Return a new state with the given list of kernel items and state number.
|
||||
; If mode is :lalr-1, for each non-null prev in kernel-item-alist, update
|
||||
; (laitem-propagates prev) to include the corresponding laitem in the new state. Do this anyway
|
||||
; for internal lookaheads, regardless of mode.
|
||||
;
|
||||
; If mode is :canonical-lr-1, kernel-item-alist is a list of pairs (item . lookaheads), where
|
||||
; lookaheads is a terminalset of lookaheads for that item. Use these lookaheads instead of
|
||||
; initial-lookaheads.
|
||||
(defun make-state (grammar kernel kernel-item-alist mode number initial-lookaheads)
|
||||
(let ((laitems nil)
|
||||
(laitems-hash (make-hash-table :test #'eq))
|
||||
(laitems-maybe-forbidden nil)) ;Association list of: laitem -> terminalset of potentially forbidden terminals; missing means *empty-terminalset*
|
||||
(labels
|
||||
;Create a laitem for this item and add the association item->laitem to the laitems-hash
|
||||
;hash table if it's not there already. Regardless of whether a new laitem was created,
|
||||
;update the laitem's lookaheads to also include the given lookaheads.
|
||||
;forbidden is a terminalset of terminals that must not occur immediately after the dot in this
|
||||
;laitem. The forbidden set is inherited from constraints in parent laitems in the same state.
|
||||
;maybe-forbidden is an upper bounds on the forbidden lookaheads in this laitem.
|
||||
;If prev is non-null, update (laitem-propagates prev) to include the laitem and the given
|
||||
;passthrough terminalset if it's not already included there.
|
||||
;If a new laitem was created and its first symbol after the dot exists and is a
|
||||
;nonterminal A, recursively close items A->.rhs corresponding to all rhs's in the
|
||||
;grammar's rule for A.
|
||||
((close-item (item forbidden maybe-forbidden lookaheads prev passthroughs)
|
||||
(let ((production (item-production item))
|
||||
(dot (item-dot item))
|
||||
(laitem (gethash item laitems-hash)))
|
||||
(let ((extra-forbidden (terminalset-complement (general-production-constraint production dot))))
|
||||
(terminalset-union-f forbidden extra-forbidden)
|
||||
(terminalset-union-f maybe-forbidden extra-forbidden))
|
||||
(unless (terminalset-empty? forbidden)
|
||||
(multiple-value-bind (dot-lookaheads dot-passthroughs)
|
||||
(string-initial-terminals grammar (item-unseen item) (production-constraints production) (item-dot item) t)
|
||||
(let ((dot-initial (terminalset-union dot-lookaheads dot-passthroughs)))
|
||||
;Check whether any terminal can start this item. If not, skip this item altogether.
|
||||
(when (terminalset-empty? (terminalset-difference dot-initial forbidden))
|
||||
;Mark skipped items in the laitems-hash table.
|
||||
(when (and laitem (not (eq laitem 'forbidden)))
|
||||
(error "Two laitems in the same state differing only in forbidden initial terminal constraints: ~S" laitem))
|
||||
(setf (gethash item laitems-hash) 'forbidden)
|
||||
(return-from close-item))
|
||||
;Convert forbidden into a canonical format by removing terminals that cannot begin this item's expansion anyway.
|
||||
(terminalset-intersection-f forbidden dot-initial))))
|
||||
(if laitem
|
||||
(let ((laitem-maybe-forbidden-entry (assoc laitem laitems-maybe-forbidden))
|
||||
(new-forbidden (terminalset-union forbidden (laitem-forbidden laitem))))
|
||||
(when laitem-maybe-forbidden-entry
|
||||
(terminalset-intersection-f (cdr laitem-maybe-forbidden-entry) maybe-forbidden))
|
||||
(unless (terminalset-<= new-forbidden (or (cdr laitem-maybe-forbidden-entry) *empty-terminalset*))
|
||||
(error "Two laitems in the same state differing only in forbidden initial terminal constraints: ~S ~%old forbidden: ~S ~%new forbidden: ~S~%maybe forbidden: ~S"
|
||||
laitem
|
||||
(terminalset-list grammar (laitem-forbidden laitem))
|
||||
(terminalset-list grammar forbidden)
|
||||
(and laitem-maybe-forbidden-entry (terminalset-list grammar (cdr laitem-maybe-forbidden-entry)))))
|
||||
(setf (laitem-forbidden laitem) new-forbidden)
|
||||
(terminalset-union-f (laitem-lookaheads laitem) lookaheads))
|
||||
(let ((item-next-symbol (item-next-symbol item)))
|
||||
(setq laitem (allocate-laitem grammar item forbidden lookaheads))
|
||||
(push laitem laitems)
|
||||
(setf (gethash item laitems-hash) laitem)
|
||||
(unless (terminalset-empty? maybe-forbidden)
|
||||
(push (cons laitem maybe-forbidden) laitems-maybe-forbidden))
|
||||
(when (nonterminal? item-next-symbol)
|
||||
(multiple-value-bind (next-lookaheads next-passthroughs)
|
||||
(string-initial-terminals grammar (rest (item-unseen item)) (production-constraints production) (1+ dot) nil)
|
||||
(let ((next-prev (and (not (terminalset-empty? next-passthroughs)) laitem)))
|
||||
(dolist (production (rule-productions (grammar-rule grammar item-next-symbol)))
|
||||
(close-item (make-item grammar production 0) forbidden maybe-forbidden next-lookaheads next-prev next-passthroughs)))))))
|
||||
(when prev
|
||||
(laitem-add-propagation prev laitem passthroughs)))))
|
||||
|
||||
(dolist (acons kernel-item-alist)
|
||||
(close-item (car acons)
|
||||
*empty-terminalset*
|
||||
*empty-terminalset*
|
||||
(if (eq mode :canonical-lr-1) (cdr acons) initial-lookaheads)
|
||||
(and (eq mode :lalr-1) (cdr acons))
|
||||
*full-terminalset*))
|
||||
(allocate-state number kernel (nreverse laitems)))))
|
||||
|
||||
|
||||
; f is a function that takes three arguments:
|
||||
; a grammar symbol;
|
||||
; a list of kernel items in order of increasing item number [list of (item . lookahead) when mode is :canonical-lr-1];
|
||||
; a list of pairs (item . prev), where item is a kernel item and prev is a laitem.
|
||||
; For each possible symbol X that can be shifted while in the given state S, call
|
||||
; f giving it S and the list of items that constitute the kernel of that shift's destination
|
||||
; state. The prev's are the sources of the corresponding shifted items.
|
||||
(defun state-each-shift-item-alist (f state mode)
|
||||
(let ((shift-symbols-hash (make-hash-table :test *grammar-symbol-=*)))
|
||||
(dolist (source-laitem (state-laitems state))
|
||||
(let* ((source-item (laitem-item source-laitem))
|
||||
(shift-symbol (item-next-symbol source-item)))
|
||||
(when shift-symbol
|
||||
(push (cons (item-next source-item) source-laitem)
|
||||
(gethash shift-symbol shift-symbols-hash)))))
|
||||
;Use dolist/gethash instead of maphash to make state assignments deterministic.
|
||||
(dolist (shift-symbol (sorted-hash-table-keys shift-symbols-hash))
|
||||
(let* ((kernel-item-alist (gethash shift-symbol shift-symbols-hash))
|
||||
(kernel (if (eq mode :canonical-lr-1)
|
||||
(sort (mapcar #'(lambda (acons)
|
||||
(cons (car acons) (laitem-lookaheads (cdr acons))))
|
||||
kernel-item-alist)
|
||||
#'<
|
||||
:key #'(lambda (acons) (item-number (car acons))))
|
||||
(sort (mapcar #'car kernel-item-alist) #'< :key #'item-number))))
|
||||
(funcall f shift-symbol kernel kernel-item-alist)))))
|
||||
|
||||
|
||||
; f is a function that takes a terminal variant as an argument.
|
||||
; For each variant of the given terminal (which, along with kernel-item-alist, was obtained from
|
||||
; state-each-shift-item-alist's callback), determine whether that variant can actually occur at the
|
||||
; current position or whether it is forbidden by constraints. If it can occur, call f with that variant.
|
||||
; Signal an error if some laitems in kernel-item-alist indicate that a variant can occur while others
|
||||
; indicate that the same variant cannot occur. Also signal an internal error if no variant can occur, as
|
||||
; make-state should have filtered such shift items out.
|
||||
(defun each-shift-symbol-variant (f grammar terminal kernel-item-alist)
|
||||
(let ((n-applicable-variants 0))
|
||||
(dolist (variant (terminal-variants grammar terminal))
|
||||
(let ((allowed nil)
|
||||
(forbidden nil))
|
||||
(dolist (acons kernel-item-alist)
|
||||
(if (terminal-in-terminalset grammar variant (laitem-forbidden (cdr acons)))
|
||||
(setq forbidden t)
|
||||
(setq allowed t)))
|
||||
(when (eq allowed forbidden)
|
||||
(error "Symbol ~S ~A" variant
|
||||
(if allowed "both allowed and forbidden" "neither allowed nor forbidden")))
|
||||
(unless forbidden
|
||||
(incf n-applicable-variants)
|
||||
(funcall f variant))))
|
||||
(when (zerop n-applicable-variants)
|
||||
(error "Internal parser error"))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; CANONICAL LR(1)
|
||||
;;;
|
||||
;;; Canonical LR(1) is accepts the same set of languages as LR(1) except that it produces vastly larger,
|
||||
;;; unoptimizied state tables. The only advantage to using Canonical LR(1) instead of LR(1) is that
|
||||
;;; a Canonical LR(1) parser will not make any reductions from an error state, whereas a LR(1) or LALR(1)
|
||||
;;; parser might make reductions (but not shifts). In other words, a Canonical LR(1) parser's shift and
|
||||
;;; reduce tables are fully accurate rather than conservative approximations based on merged states.
|
||||
|
||||
|
||||
; Make all states in the grammar and return the initial state.
|
||||
; Initialize the grammar's list of states.
|
||||
; Initialize the states' gotos lists.
|
||||
; Initialize the states' shift (but not reduce or accept) transitions in the transitions lists.
|
||||
(defun add-all-canonical-lr-states (grammar)
|
||||
(let* ((initial-item (make-item grammar (grammar-start-production grammar) 0))
|
||||
(lr-states-hash (make-hash-table :test #'equal)) ;canonical kernel -> state
|
||||
(initial-kernel (list (cons initial-item (make-terminalset grammar *end-marker*))))
|
||||
(initial-state (make-state grammar initial-kernel initial-kernel :canonical-lr-1 0 nil))
|
||||
(states (list initial-state))
|
||||
(next-state-number 1))
|
||||
(setf (gethash initial-kernel lr-states-hash) initial-state)
|
||||
(do ((source-states (list initial-state)))
|
||||
((endp source-states))
|
||||
(let ((source-state (pop source-states)))
|
||||
;Propagate the source state's internal lookaheads and then erase the propagates chains.
|
||||
(propagate-internal-lookaheads source-state)
|
||||
(dolist (laitem (state-laitems source-state))
|
||||
(setf (laitem-propagates laitem) nil))
|
||||
|
||||
(state-each-shift-item-alist
|
||||
#'(lambda (shift-symbol kernel kernel-item-alist)
|
||||
(let ((destination-state (gethash kernel lr-states-hash)))
|
||||
(unless destination-state
|
||||
(setq destination-state (make-state grammar kernel kernel :canonical-lr-1 next-state-number nil))
|
||||
(setf (gethash kernel lr-states-hash) destination-state)
|
||||
(incf next-state-number)
|
||||
(push destination-state states)
|
||||
(push destination-state source-states))
|
||||
(if (nonterminal? shift-symbol)
|
||||
(push (cons shift-symbol destination-state)
|
||||
(state-gotos source-state))
|
||||
(each-shift-symbol-variant
|
||||
#'(lambda (shift-symbol-variant)
|
||||
(push (cons shift-symbol-variant (make-shift-transition destination-state))
|
||||
(state-transitions source-state)))
|
||||
grammar shift-symbol kernel-item-alist))))
|
||||
source-state :canonical-lr-1)))
|
||||
(setf (grammar-states grammar) (nreverse states))
|
||||
initial-state))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; LR(1)
|
||||
|
||||
|
||||
; kernel-item-alist should have the same kernel items as state.
|
||||
; Return true if the prev lookaheads in kernel-item-alist are the same as or subsets of
|
||||
; the corresponding lookaheads in the state's kernel laitems.
|
||||
(defun state-subsumes-lookaheads (state kernel-item-alist)
|
||||
(every
|
||||
#'(lambda (acons)
|
||||
(terminalset-<= (laitem-lookaheads (cdr acons))
|
||||
(laitem-lookaheads (state-laitem state (car acons)))))
|
||||
kernel-item-alist))
|
||||
|
||||
|
||||
; kernel-item-alist should have the same kernel items as state.
|
||||
; Return true if the prev lookaheads in kernel-item-alist are weakly compatible
|
||||
; with the lookaheads in the state's kernel laitems.
|
||||
(defun state-weakly-compatible (state kernel-item-alist)
|
||||
(labels
|
||||
((lookahead-weakly-compatible (lookahead1a lookahead1b lookahead2a lookahead2b)
|
||||
(or (and (terminalsets-disjoint lookahead1a lookahead2b)
|
||||
(terminalsets-disjoint lookahead1b lookahead2a))
|
||||
(not (terminalsets-disjoint lookahead1a lookahead1b))
|
||||
(not (terminalsets-disjoint lookahead2a lookahead2b))))
|
||||
|
||||
(lookahead-list-weakly-compatible (lookahead1a lookaheads1 lookahead2a lookaheads2)
|
||||
(or (endp lookaheads1)
|
||||
(and (lookahead-weakly-compatible lookahead1a (first lookaheads1) lookahead2a (first lookaheads2))
|
||||
(lookahead-list-weakly-compatible lookahead1a (rest lookaheads1) lookahead2a (rest lookaheads2)))))
|
||||
|
||||
(lookahead-lists-weakly-compatible (lookaheads1 lookaheads2)
|
||||
(or (endp lookaheads1)
|
||||
(and (lookahead-list-weakly-compatible (first lookaheads1) (rest lookaheads1) (first lookaheads2) (rest lookaheads2))
|
||||
(lookahead-lists-weakly-compatible (rest lookaheads1) (rest lookaheads2))))))
|
||||
|
||||
(or (= (length kernel-item-alist) 1)
|
||||
(lookahead-lists-weakly-compatible
|
||||
(mapcar #'(lambda (acons) (laitem-lookaheads (state-laitem state (car acons)))) kernel-item-alist)
|
||||
(mapcar #'(lambda (acons) (laitem-lookaheads (cdr acons))) kernel-item-alist)))))
|
||||
|
||||
|
||||
; Propagate all lookaheads in the state.
|
||||
(defun propagate-internal-lookaheads (state)
|
||||
(do ((changed t))
|
||||
((not changed))
|
||||
(setq changed nil)
|
||||
(dolist (src-laitem (state-laitems state))
|
||||
(let ((src-lookaheads (laitem-lookaheads src-laitem)))
|
||||
(dolist (propagation (laitem-propagates src-laitem))
|
||||
(let* ((dst-laitem (car propagation))
|
||||
(mask (cdr propagation))
|
||||
(old-dst-lookaheads (laitem-lookaheads dst-laitem))
|
||||
(new-dst-lookaheads (terminalset-union old-dst-lookaheads (terminalset-intersection src-lookaheads mask))))
|
||||
(setf (laitem-lookaheads dst-laitem) new-dst-lookaheads)
|
||||
(unless (terminalset-= old-dst-lookaheads new-dst-lookaheads)
|
||||
(setq changed t))))))))
|
||||
|
||||
|
||||
; Propagate all lookaheads in kernel-item-alist, which must target destination-state.
|
||||
; Mark destination-state as dirty in the dirty-states hash table.
|
||||
(defun propagate-external-lookaheads (kernel-item-alist destination-state dirty-states)
|
||||
(dolist (acons kernel-item-alist)
|
||||
(let ((dest-laitem (state-laitem destination-state (car acons)))
|
||||
(src-laitem (cdr acons)))
|
||||
(terminalset-union-f (laitem-lookaheads dest-laitem) (laitem-lookaheads src-laitem))))
|
||||
(setf (gethash destination-state dirty-states) t))
|
||||
|
||||
|
||||
; Make all states in the grammar and return the initial state.
|
||||
; Initialize the grammar's list of states.
|
||||
; Initialize the states' gotos lists.
|
||||
; Initialize the states' shift (but not reduce or accept) transitions in the transitions lists.
|
||||
(defun add-all-lr-states (grammar)
|
||||
(let* ((initial-item (make-item grammar (grammar-start-production grammar) 0))
|
||||
(lr-states-hash (make-hash-table :test #'equal)) ;kernel -> list of states with that kernel
|
||||
(initial-kernel (list initial-item))
|
||||
(initial-state (make-state grammar initial-kernel (list (cons initial-item nil)) :lr-1 0 (make-terminalset grammar *end-marker*)))
|
||||
(states (list initial-state))
|
||||
(next-state-number 1))
|
||||
(setf (gethash initial-kernel lr-states-hash) (list initial-state))
|
||||
(do ((source-states (list initial-state))
|
||||
(dirty-states (make-hash-table :test #'eq))) ;Set of states whose kernel lookaheads changed and haven't been propagated yet
|
||||
((and (endp source-states) (zerop (hash-table-count dirty-states))))
|
||||
(labels
|
||||
((make-destination-state (kernel kernel-item-alist)
|
||||
(let* ((possible-destination-states (gethash kernel lr-states-hash))
|
||||
(destination-state (find-if #'(lambda (possible-destination-state)
|
||||
(state-subsumes-lookaheads possible-destination-state kernel-item-alist))
|
||||
possible-destination-states)))
|
||||
(cond
|
||||
(destination-state)
|
||||
((setq destination-state (find-if #'(lambda (possible-destination-state)
|
||||
(state-weakly-compatible possible-destination-state kernel-item-alist))
|
||||
possible-destination-states))
|
||||
(propagate-external-lookaheads kernel-item-alist destination-state dirty-states))
|
||||
(t
|
||||
(setq destination-state (make-state grammar kernel kernel-item-alist :lr-1 next-state-number *empty-terminalset*))
|
||||
(propagate-external-lookaheads kernel-item-alist destination-state dirty-states)
|
||||
(push destination-state (gethash kernel lr-states-hash))
|
||||
(incf next-state-number)
|
||||
(push destination-state states)
|
||||
(push destination-state source-states)))
|
||||
destination-state))
|
||||
|
||||
(update-destination-state (destination-state kernel-item-alist)
|
||||
(cond
|
||||
((state-subsumes-lookaheads destination-state kernel-item-alist)
|
||||
destination-state)
|
||||
((state-weakly-compatible destination-state kernel-item-alist)
|
||||
(propagate-external-lookaheads kernel-item-alist destination-state dirty-states)
|
||||
destination-state)
|
||||
(t (make-destination-state (state-kernel destination-state) kernel-item-alist)))))
|
||||
|
||||
(if source-states
|
||||
(let ((source-state (pop source-states)))
|
||||
(remhash source-state dirty-states)
|
||||
(propagate-internal-lookaheads source-state)
|
||||
(state-each-shift-item-alist
|
||||
#'(lambda (shift-symbol kernel kernel-item-alist)
|
||||
(let ((destination-state (make-destination-state kernel kernel-item-alist)))
|
||||
(if (nonterminal? shift-symbol)
|
||||
(push (cons shift-symbol destination-state)
|
||||
(state-gotos source-state))
|
||||
(each-shift-symbol-variant
|
||||
#'(lambda (shift-symbol-variant)
|
||||
(push (cons shift-symbol-variant (make-shift-transition destination-state))
|
||||
(state-transitions source-state)))
|
||||
grammar shift-symbol kernel-item-alist))))
|
||||
source-state :lr-1))
|
||||
(dolist (dirty-state (sort (hash-table-keys dirty-states) #'< :key #'state-number))
|
||||
(when (remhash dirty-state dirty-states)
|
||||
(propagate-internal-lookaheads dirty-state)
|
||||
(state-each-shift-item-alist
|
||||
#'(lambda (shift-symbol kernel kernel-item-alist)
|
||||
(declare (ignore kernel))
|
||||
(if (nonterminal? shift-symbol)
|
||||
(let* ((destination-binding (assoc shift-symbol (state-gotos dirty-state) :test *grammar-symbol-=*))
|
||||
(destination-state (assert-non-null (cdr destination-binding))))
|
||||
(setf (cdr destination-binding) (update-destination-state destination-state kernel-item-alist)))
|
||||
(each-shift-symbol-variant
|
||||
#'(lambda (shift-symbol-variant)
|
||||
(let* ((destination-transition (state-transition dirty-state shift-symbol-variant))
|
||||
(destination-state (assert-non-null (transition-state destination-transition))))
|
||||
(setf (transition-state destination-transition)
|
||||
(update-destination-state destination-state kernel-item-alist))))
|
||||
grammar shift-symbol kernel-item-alist)))
|
||||
dirty-state :lr-1))))))
|
||||
(setf (grammar-states grammar) (nreverse states))
|
||||
initial-state))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; LALR(1)
|
||||
|
||||
|
||||
; Make all states in the grammar and return the initial state.
|
||||
; Initialize the grammar's list of states.
|
||||
; Set up the laitems' propagate lists but do not propagate lookaheads yet.
|
||||
; Initialize the states' gotos lists.
|
||||
; Initialize the states' shift (but not reduce or accept) transitions in the transitions lists.
|
||||
(defun add-all-lalr-states (grammar)
|
||||
(let* ((initial-item (make-item grammar (grammar-start-production grammar) 0))
|
||||
(lalr-states-hash (make-hash-table :test #'equal)) ;kernel -> state
|
||||
(initial-kernel (list initial-item))
|
||||
(initial-state (make-state grammar initial-kernel (list (cons initial-item nil)) :lalr-1 0 (make-terminalset grammar *end-marker*)))
|
||||
(states (list initial-state))
|
||||
(next-state-number 1))
|
||||
(setf (gethash initial-kernel lalr-states-hash) initial-state)
|
||||
(do ((source-states (list initial-state)))
|
||||
((endp source-states))
|
||||
(let ((source-state (pop source-states)))
|
||||
(state-each-shift-item-alist
|
||||
#'(lambda (shift-symbol kernel kernel-item-alist)
|
||||
(let ((destination-state (gethash kernel lalr-states-hash)))
|
||||
(if destination-state
|
||||
(dolist (acons kernel-item-alist)
|
||||
(laitem-add-propagation (cdr acons) (state-laitem destination-state (car acons)) *full-terminalset*))
|
||||
(progn
|
||||
(setq destination-state (make-state grammar kernel kernel-item-alist :lalr-1 next-state-number *empty-terminalset*))
|
||||
(setf (gethash kernel lalr-states-hash) destination-state)
|
||||
(incf next-state-number)
|
||||
(push destination-state states)
|
||||
(push destination-state source-states)))
|
||||
(if (nonterminal? shift-symbol)
|
||||
(push (cons shift-symbol destination-state)
|
||||
(state-gotos source-state))
|
||||
(each-shift-symbol-variant
|
||||
#'(lambda (shift-symbol-variant)
|
||||
(push (cons shift-symbol-variant (make-shift-transition destination-state))
|
||||
(state-transitions source-state)))
|
||||
grammar shift-symbol kernel-item-alist))))
|
||||
source-state :lalr-1)))
|
||||
(setf (grammar-states grammar) (nreverse states))
|
||||
initial-state))
|
||||
|
||||
|
||||
; Propagate the lookaheads in the LALR(1) grammar.
|
||||
(defun propagate-lalr-lookaheads (grammar)
|
||||
(let ((dirty-laitems (make-hash-table :test #'eq)))
|
||||
(dolist (state (grammar-states grammar))
|
||||
(dolist (laitem (state-laitems state))
|
||||
(when (and (laitem-propagates laitem) (not (terminalset-empty? (laitem-lookaheads laitem))))
|
||||
(setf (gethash laitem dirty-laitems) t))))
|
||||
(do ()
|
||||
((zerop (hash-table-count dirty-laitems)))
|
||||
(dolist (dirty-laitem (hash-table-keys dirty-laitems))
|
||||
(remhash dirty-laitem dirty-laitems)
|
||||
(let ((src-lookaheads (laitem-lookaheads dirty-laitem)))
|
||||
(dolist (propagation (laitem-propagates dirty-laitem))
|
||||
(let ((dst-laitem (car propagation))
|
||||
(mask (cdr propagation)))
|
||||
(let* ((old-dst-lookaheads (laitem-lookaheads dst-laitem))
|
||||
(new-dst-lookaheads (terminalset-union old-dst-lookaheads (terminalset-intersection src-lookaheads mask))))
|
||||
(unless (terminalset-= old-dst-lookaheads new-dst-lookaheads)
|
||||
(setf (laitem-lookaheads dst-laitem) new-dst-lookaheads)
|
||||
(setf (gethash dst-laitem dirty-laitems) t))))))))
|
||||
|
||||
;Erase the propagates chains in all laitems.
|
||||
(dolist (state (grammar-states grammar))
|
||||
(dolist (laitem (state-laitems state))
|
||||
(setf (laitem-propagates laitem) nil)))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
|
||||
|
||||
; Calculate the reduce and accept transitions in the grammar.
|
||||
; Also sort all transitions by their terminal numbers and gotos by their nonterminal numbers.
|
||||
; Conflicting transitions are sorted as follows:
|
||||
; shifts come before reduces and accepts
|
||||
; accepts come before reduces
|
||||
; reduces with lower production numbers come before reduces with higher production numbers
|
||||
; Disambiguation will choose the first member of a sorted list of conflicting transitions.
|
||||
(defun finish-transitions (grammar)
|
||||
(dolist (state (grammar-states grammar))
|
||||
(dolist (laitem (state-laitems state))
|
||||
(let ((item (laitem-item laitem)))
|
||||
(unless (item-next-symbol item)
|
||||
(let ((lookaheads (terminalset-difference
|
||||
(terminalset-intersection
|
||||
(laitem-lookaheads laitem)
|
||||
(general-production-constraint (item-production item) (item-dot item)))
|
||||
(laitem-forbidden laitem))))
|
||||
(if (grammar-symbol-= (item-lhs item) *start-nonterminal*)
|
||||
(when (terminal-in-terminalset grammar *end-marker* lookaheads)
|
||||
(push (cons *end-marker* (make-accept-transition))
|
||||
(state-transitions state)))
|
||||
(map-terminalset-reverse
|
||||
#'(lambda (lookahead)
|
||||
(push (cons lookahead (make-reduce-transition (item-production item)))
|
||||
(state-transitions state)))
|
||||
grammar
|
||||
lookaheads))))))
|
||||
(setf (state-gotos state)
|
||||
(sort (state-gotos state) #'< :key #'(lambda (goto-cons) (state-number (cdr goto-cons)))))
|
||||
(setf (state-transitions state)
|
||||
(sort (state-transitions state)
|
||||
#'(lambda (transition-cons-1 transition-cons-2)
|
||||
(let ((terminal-number-1 (terminal-number grammar (car transition-cons-1)))
|
||||
(terminal-number-2 (terminal-number grammar (car transition-cons-2))))
|
||||
(cond
|
||||
((< terminal-number-1 terminal-number-2) t)
|
||||
((> terminal-number-1 terminal-number-2) nil)
|
||||
(t (let* ((transition1 (cdr transition-cons-1))
|
||||
(transition2 (cdr transition-cons-2))
|
||||
(transition-kind-1 (transition-kind transition1))
|
||||
(transition-kind-2 (transition-kind transition2)))
|
||||
(cond
|
||||
((eq transition-kind-2 :shift) nil)
|
||||
((eq transition-kind-1 :shift) t)
|
||||
((eq transition-kind-2 :accept) nil)
|
||||
((eq transition-kind-1 :accept) t)
|
||||
(t (let ((production-number-1 (production-number (transition-production transition1)))
|
||||
(production-number-2 (production-number (transition-production transition2))))
|
||||
(< production-number-1 production-number-2)))))))))))))
|
||||
|
||||
|
||||
; Find ambiguities, if any, in the grammar. Report them on the given stream.
|
||||
; Fix all ambiguities in favor of the first transition listed
|
||||
; (the transitions were ordered by finish-transitions).
|
||||
; Return true if ambiguities were found.
|
||||
(defun report-and-fix-ambiguities (grammar stream)
|
||||
(let ((found-ambiguities nil))
|
||||
(dolist (state (grammar-states grammar))
|
||||
(labels
|
||||
|
||||
((report-ambiguity (transition-cons other-transition-conses)
|
||||
(unless found-ambiguities
|
||||
(setq found-ambiguities t)
|
||||
(format stream "~&Ambiguities:"))
|
||||
(write-char #\newline stream)
|
||||
(pprint-logical-block (stream nil)
|
||||
(format stream "S~D: ~W => " (state-number state) (car transition-cons))
|
||||
(pprint-logical-block (stream nil)
|
||||
(dolist (a (cons transition-cons other-transition-conses))
|
||||
(print-transition (cdr a) stream)
|
||||
(format stream " ~:_")))))
|
||||
|
||||
; Check the list of transition-conses and report ambiguities.
|
||||
; start is the start of a possibly larger list of transition-conses whose tail
|
||||
; is the given list. If ambiguities exist, return a copy of start up to the
|
||||
; position of list in it followed by list with ambiguities removed. If not,
|
||||
; return start unchanged.
|
||||
(check (transition-conses start)
|
||||
(if transition-conses
|
||||
(let* ((transition-cons (first transition-conses))
|
||||
(transition-terminal (car transition-cons))
|
||||
(transition-conses-rest (rest transition-conses)))
|
||||
(if transition-conses-rest
|
||||
(if (grammar-symbol-= transition-terminal (car (first transition-conses-rest)))
|
||||
(let ((unrelated-transitions
|
||||
(member-if #'(lambda (a) (not (grammar-symbol-= transition-terminal (car a))))
|
||||
transition-conses-rest)))
|
||||
(report-ambiguity transition-cons (ldiff transition-conses-rest unrelated-transitions))
|
||||
(check unrelated-transitions (append (ldiff start transition-conses-rest) unrelated-transitions)))
|
||||
(check transition-conses-rest start))
|
||||
start))
|
||||
start)))
|
||||
|
||||
(let ((transition-conses (state-transitions state)))
|
||||
(setf (state-transitions state) (check transition-conses transition-conses)))))
|
||||
(when found-ambiguities
|
||||
(write-char #\newline stream))
|
||||
found-ambiguities))
|
||||
|
||||
|
||||
; Remove the temporary item and laitem lists from the grammar's states. This reduces the grammar's lisp
|
||||
; heap usage but prevents it from being printed.
|
||||
(defun clean-grammar (grammar)
|
||||
(when (grammar-items-hash grammar)
|
||||
(setf (grammar-items-hash grammar) nil)
|
||||
(dolist (state (grammar-states grammar))
|
||||
(setf (state-kernel state) nil)
|
||||
(setf (state-laitems state) nil))))
|
||||
|
||||
|
||||
; Erase the existing parser, if any, for the given grammar.
|
||||
(defun clear-parser (grammar)
|
||||
(setf (grammar-items-hash grammar) nil)
|
||||
(setf (grammar-states grammar) nil))
|
||||
|
||||
|
||||
; Construct a LR or LALR parser in the given grammar. kind should be :lalr-1, :lr-1, or :canonical-lr-1.
|
||||
; Return true if ambiguities were found.
|
||||
(defun compile-parser (grammar kind)
|
||||
(clear-parser grammar)
|
||||
(setf (grammar-items-hash grammar) (make-hash-table :test #'equal))
|
||||
(ecase kind
|
||||
(:lalr-1
|
||||
(add-all-lalr-states grammar)
|
||||
(propagate-lalr-lookaheads grammar))
|
||||
(:lr-1
|
||||
(add-all-lr-states grammar))
|
||||
(:canonical-lr-1
|
||||
(add-all-canonical-lr-states grammar)))
|
||||
(finish-transitions grammar)
|
||||
(report-and-fix-ambiguities grammar *error-output*))
|
||||
|
||||
|
||||
|
||||
; (cons (list <kind> <start-symbol> <grammar-source> <grammar-options>) <grammar>)
|
||||
(defvar *make-and-compile-grammar-cache* (cons nil nil))
|
||||
|
||||
; Make the grammar and compile its parser. kind should be :lalr-1, :lr-1, or :canonical-lr-1.
|
||||
(defun make-and-compile-grammar (kind parametrization start-symbol grammar-source &rest grammar-options)
|
||||
(let ((key (list kind start-symbol grammar-source grammar-options))
|
||||
(cached-grammar (cdr *make-and-compile-grammar-cache*)))
|
||||
(if (and (equal key (car *make-and-compile-grammar-cache*))
|
||||
(grammar-parametrization-= parametrization cached-grammar))
|
||||
(progn
|
||||
(format *trace-output* "Re-using grammar ~S ~S ~S~%" kind start-symbol grammar-options)
|
||||
cached-grammar)
|
||||
(let* ((grammar (apply #'make-grammar parametrization start-symbol grammar-source grammar-options))
|
||||
(found-ambiguities (compile-parser grammar kind)))
|
||||
(setq *make-and-compile-grammar-cache*
|
||||
(if found-ambiguities
|
||||
(cons nil nil)
|
||||
(cons key grammar)))
|
||||
grammar))))
|
||||
|
||||
|
||||
; Collapse states that have at most one possible reduction into forwarding states.
|
||||
; DON'T DO THIS ON GRAMMARS THAT HAVE CONSTRAINTS AT THE TAIL END OF A PRODUCTION.
|
||||
; Return the number of states optimized.
|
||||
(defun forward-parser-states (grammar)
|
||||
(let ((n-forwarded-states 0))
|
||||
(dolist (state (grammar-states grammar))
|
||||
(let ((production (forwarding-state-production state)))
|
||||
(when production
|
||||
(setf (state-transitions state) (list (cons nil (make-reduce-transition production))))
|
||||
(incf n-forwarded-states))))
|
||||
n-forwarded-states))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
|
||||
; Parse the input list of tokens to produce a parse tree.
|
||||
; token-terminal is a function that returns a terminal symbol when given an input token.
|
||||
(defun parse (grammar token-terminal input)
|
||||
(labels
|
||||
(;Continue the parse with the given parser stack and remainder of input.
|
||||
(parse-step (stack input)
|
||||
(if (endp input)
|
||||
(parse-step-1 stack *end-marker* nil nil)
|
||||
(let ((token (first input)))
|
||||
(parse-step-1 stack (funcall token-terminal token) token (rest input)))))
|
||||
|
||||
;Same as parse-step except that the next input terminal has been determined already.
|
||||
;input-rest contains the input tokens after the next token.
|
||||
(parse-step-1 (stack terminal token input-rest)
|
||||
(let* ((state (caar stack))
|
||||
(transition (state-transition state terminal)))
|
||||
(if transition
|
||||
(case (transition-kind transition)
|
||||
(:shift (parse-step (acons (transition-state transition) token stack) input-rest))
|
||||
(:reduce (let ((production (transition-production transition))
|
||||
(expansion nil))
|
||||
(dotimes (i (production-rhs-length production))
|
||||
(push (cdr (pop stack)) expansion))
|
||||
(let* ((state (caar stack))
|
||||
(dst-state (assert-non-null
|
||||
(cdr (assoc (production-lhs production) (state-gotos state) :test *grammar-symbol-=*))))
|
||||
(named-expansion (cons (production-name production) expansion)))
|
||||
(parse-step-1 (acons dst-state named-expansion stack) terminal token input-rest))))
|
||||
(:accept (cdar stack))
|
||||
(t (error "Bad transition: ~S" transition)))
|
||||
(error "Parse error on ~S followed by ~S ..." token (ldiff input-rest (nthcdr 10 input-rest)))))))
|
||||
|
||||
(parse-step (list (cons (grammar-start-state grammar) nil)) input)))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; ACTIONS
|
||||
|
||||
; Initialize the action-signatures hash table, setting each grammar symbol's signature
|
||||
; to null for now. Also clear all production actions in the grammar.
|
||||
(defun clear-actions (grammar)
|
||||
(let ((action-signatures (make-hash-table :test *grammar-symbol-=*))
|
||||
(terminals (grammar-terminals grammar))
|
||||
(nonterminals (grammar-nonterminals grammar)))
|
||||
(dotimes (i (length terminals))
|
||||
(setf (gethash (svref terminals i) action-signatures) nil))
|
||||
(dotimes (i (length nonterminals))
|
||||
(setf (gethash (svref nonterminals i) action-signatures) nil))
|
||||
(setf (grammar-action-signatures grammar) action-signatures)
|
||||
(each-grammar-production
|
||||
grammar
|
||||
#'(lambda (production)
|
||||
(setf (production-actions production) nil)
|
||||
(setf (production-n-action-args production) nil)
|
||||
(setf (production-evaluator-code production) nil)
|
||||
(setf (production-evaluator production) nil)))
|
||||
(clrhash (grammar-terminal-actions grammar))))
|
||||
|
||||
|
||||
; Declare the type of action action-symbol, when called on general-grammar-symbol, to be type-expr.
|
||||
; Signal an error on duplicate actions.
|
||||
; It's OK if some of the symbol instances don't exist, as long as at least one does.
|
||||
(defun declare-action (grammar general-grammar-symbol action-symbol type-expr)
|
||||
(unless (and action-symbol (symbolp action-symbol))
|
||||
(error "Bad action name ~S" action-symbol))
|
||||
(let ((action-signatures (grammar-action-signatures grammar))
|
||||
(grammar-symbols (general-grammar-symbol-instances grammar general-grammar-symbol))
|
||||
(symbol-exists nil))
|
||||
(dolist (grammar-symbol grammar-symbols)
|
||||
(let ((signature (gethash grammar-symbol action-signatures :undefined)))
|
||||
(unless (eq signature :undefined)
|
||||
(setq symbol-exists t)
|
||||
(when (assoc action-symbol signature :test #'eq)
|
||||
(error "Attempt to redefine the type of action ~S on ~S" action-symbol grammar-symbol))
|
||||
(setf (gethash grammar-symbol action-signatures)
|
||||
(nconc signature (list (cons action-symbol type-expr))))
|
||||
(if (nonterminal? grammar-symbol)
|
||||
(dolist (production (rule-productions (grammar-rule grammar grammar-symbol)))
|
||||
(setf (production-actions production)
|
||||
(nconc (production-actions production) (list (cons action-symbol nil)))))
|
||||
(let ((terminal-actions (grammar-terminal-actions grammar)))
|
||||
(assert-type grammar-symbol terminal)
|
||||
(setf (gethash grammar-symbol terminal-actions)
|
||||
(nconc (gethash grammar-symbol terminal-actions) (list (cons action-symbol nil)))))))))
|
||||
(unless symbol-exists
|
||||
(error "Bad action grammar symbol ~S" grammar-symbols))))
|
||||
|
||||
|
||||
; Return the list of pairs (action-symbol . type-or-type-expr) for this grammar-symbol.
|
||||
; The pairs are in order from oldest to newest action-symbols added to this grammar-symbol.
|
||||
(declaim (inline grammar-symbol-signature))
|
||||
(defun grammar-symbol-signature (grammar grammar-symbol)
|
||||
(gethash grammar-symbol (grammar-action-signatures grammar)))
|
||||
|
||||
|
||||
; Return the list of action types of the grammar's user start-symbol.
|
||||
(defun grammar-user-start-action-types (grammar)
|
||||
(mapcar #'cdr (grammar-symbol-signature grammar (gramar-user-start-symbol grammar))))
|
||||
|
||||
|
||||
; If action action-symbol is declared on grammar-symbol, return two values:
|
||||
; t, and
|
||||
; the action's type-expr;
|
||||
; If not, return nil.
|
||||
(defun action-declaration (grammar grammar-symbol action-symbol)
|
||||
(let ((declaration (assoc action-symbol (grammar-symbol-signature grammar grammar-symbol) :test #'eq)))
|
||||
(and declaration
|
||||
(values t (cdr declaration)))))
|
||||
|
||||
|
||||
; Call f on every action declaration, passing it two arguments:
|
||||
; the grammar-symbol;
|
||||
; a pair (action-symbol . type-expr).
|
||||
; f may modify the action's type-expr.
|
||||
(defun each-action-declaration (grammar f)
|
||||
(maphash #'(lambda (grammar-symbol signature)
|
||||
(dolist (action-declaration signature)
|
||||
(funcall f grammar-symbol action-declaration)))
|
||||
(grammar-action-signatures grammar)))
|
||||
|
||||
|
||||
; Define action action-symbol, when called on the production with the given name,
|
||||
; to be action-expr. The action should have been declared already.
|
||||
(defun define-action (grammar production-name action-symbol action-expr)
|
||||
(dolist (production (general-production-productions (grammar-general-production grammar production-name)))
|
||||
(let ((definition (assoc action-symbol (production-actions production) :test #'eq)))
|
||||
(cond
|
||||
((null definition)
|
||||
(error "Attempt to define action ~S on ~S, which hasn't been declared yet" action-symbol production-name))
|
||||
((cdr definition)
|
||||
(error "Duplicate definition of action ~S on ~S" action-symbol production-name))
|
||||
(t (setf (cdr definition) (make-action action-expr)))))))
|
||||
|
||||
|
||||
; Define action action-symbol, when called on the given terminal,
|
||||
; to execute the given function, which should take a token as an input and
|
||||
; produce a value of the proper type as output.
|
||||
; The action should have been declared already.
|
||||
(defun define-terminal-action (grammar terminal action-symbol action-function)
|
||||
(assert-type action-function function)
|
||||
(let ((definition (assoc action-symbol (gethash terminal (grammar-terminal-actions grammar)) :test #'eq)))
|
||||
(cond
|
||||
((null definition)
|
||||
(error "Attempt to define action ~S on ~S, which hasn't been declared yet" action-symbol terminal))
|
||||
((cdr definition)
|
||||
(error "Duplicate definition of action ~S on ~S" action-symbol terminal))
|
||||
(t (setf (cdr definition) action-function)))))
|
||||
|
||||
|
||||
|
||||
; Parse the input list of tokens to produce a list of action results.
|
||||
; token-terminal is a function that returns a terminal symbol when given an input token.
|
||||
; If trace is:
|
||||
; nil, don't print trace information
|
||||
; :code, print trace information, including action code
|
||||
; other print trace information
|
||||
; Return two values:
|
||||
; the list of action results;
|
||||
; the list of action results' types.
|
||||
(defun action-parse (grammar token-terminal input &key trace)
|
||||
(labels
|
||||
(;Continue the parse with the given stacks and remainder of input.
|
||||
;When trace is non-null, type-stack contains the types of corresponding value-stack entries.
|
||||
(parse-step (state-stack value-stack type-stack input)
|
||||
(if (endp input)
|
||||
(parse-step-1 state-stack value-stack type-stack *end-marker* nil nil)
|
||||
(let ((token (first input)))
|
||||
(parse-step-1 state-stack value-stack type-stack (funcall token-terminal token) token (rest input)))))
|
||||
|
||||
;Same as parse-step except that the next input terminal has been determined already.
|
||||
;input-rest contains the input tokens after the next token.
|
||||
(parse-step-1 (state-stack value-stack type-stack terminal token input-rest)
|
||||
(let* ((state (car state-stack))
|
||||
(transition (state-transition state terminal)))
|
||||
(when trace
|
||||
(format *trace-output* "S~D: ~@_" (state-number state))
|
||||
(print-values (reverse value-stack) (reverse type-stack) *trace-output*)
|
||||
(pprint-newline :mandatory *trace-output*))
|
||||
(if transition
|
||||
(case (transition-kind transition)
|
||||
(:shift
|
||||
(when trace
|
||||
(format *trace-output* " shift ~W~:@_" terminal)
|
||||
(dolist (action-signature (grammar-symbol-signature grammar terminal))
|
||||
(push (cdr action-signature) type-stack)))
|
||||
(dolist (action-function-binding (gethash terminal (grammar-terminal-actions grammar)))
|
||||
(push (funcall (cdr action-function-binding) token) value-stack))
|
||||
(parse-step (cons (transition-state transition) state-stack) value-stack type-stack input-rest))
|
||||
|
||||
(:reduce
|
||||
(let ((production (transition-production transition)))
|
||||
(when trace
|
||||
(write-string " reduce " *trace-output*)
|
||||
(if (eq trace :code)
|
||||
(write production :stream *trace-output* :pretty t)
|
||||
(print-production production *trace-output*))
|
||||
(pprint-newline :mandatory *trace-output*))
|
||||
(let* ((state-stack (nthcdr (production-rhs-length production) state-stack))
|
||||
(state (car state-stack))
|
||||
(dst-state (assert-non-null
|
||||
(cdr (assoc (production-lhs production) (state-gotos state) :test *grammar-symbol-=*))))
|
||||
(value-stack (funcall (production-evaluator production) value-stack)))
|
||||
(when trace
|
||||
(setq type-stack (nthcdr (production-n-action-args production) type-stack))
|
||||
(dolist (action-signature (grammar-symbol-signature grammar (production-lhs production)))
|
||||
(push (cdr action-signature) type-stack)))
|
||||
(parse-step-1 (cons dst-state state-stack) value-stack type-stack terminal token input-rest))))
|
||||
|
||||
(:accept
|
||||
(when trace
|
||||
(format *trace-output* " accept~:@_"))
|
||||
(values
|
||||
(nreverse value-stack)
|
||||
(if trace
|
||||
(nreverse type-stack)
|
||||
(grammar-user-start-action-types grammar))))
|
||||
|
||||
(t (error "Bad transition: ~S" transition)))
|
||||
(error "Parse error on ~S followed by ~S ..." token (ldiff input-rest (nthcdr 10 input-rest)))))))
|
||||
|
||||
(parse-step (list (grammar-start-state grammar)) nil nil input)))
|
||||
|
||||
@@ -1,11 +0,0 @@
|
||||
js/semantics contains experimental code used to generate LR(1) and LALR(1)
|
||||
grammars for JavaScript as well as compile and check formal semantics for
|
||||
JavaScript. The semantics can be executed directly or printed into either
|
||||
HTML or Microsoft Word RTF formats.
|
||||
|
||||
This code is written in standard Common Lisp. It's been used under Macintosh
|
||||
Common Lisp 4.0, and Allegro Common Lisp 5.0.1 for Windows, but should also work
|
||||
under other Common Lisp implementations.
|
||||
|
||||
Contact Waldemar Horwat (waldemar@netscape.com or waldemar@acm.org) for
|
||||
more information.
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,68 +0,0 @@
|
||||
(progn
|
||||
(defparameter *bew*
|
||||
(generate-world
|
||||
"BE"
|
||||
'((lexer base-example-lexer
|
||||
:lalr-1
|
||||
:numeral
|
||||
((:digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
|
||||
((value $digit-value))))
|
||||
(($digit-value integer digit-value digit-char-36)))
|
||||
|
||||
(deftype semantic-exception (oneof syntax-error))
|
||||
|
||||
(%charclass :digit)
|
||||
|
||||
(rule :digits ((decimal-value integer)
|
||||
(base-value (-> (integer) integer)))
|
||||
(production :digits (:digit) digits-first
|
||||
(decimal-value (value :digit))
|
||||
((base-value (base integer))
|
||||
(let ((d integer (value :digit)))
|
||||
(if (< d base) d (throw (oneof syntax-error))))))
|
||||
(production :digits (:digits :digit) digits-rest
|
||||
(decimal-value (+ (* 10 (decimal-value :digits)) (value :digit)))
|
||||
((base-value (base integer))
|
||||
(let ((d integer (value :digit)))
|
||||
(if (< d base)
|
||||
(+ (* base ((base-value :digits) base)) d)
|
||||
(throw (oneof syntax-error)))))))
|
||||
|
||||
(rule :numeral ((value integer))
|
||||
(production :numeral (:digits) numeral-digits
|
||||
(value (decimal-value :digits)))
|
||||
(production :numeral (:digits #\# :digits) numeral-digits-and-base
|
||||
(value
|
||||
(let ((base integer (decimal-value :digits 2)))
|
||||
(if (and (>= base 2) (<= base 10))
|
||||
((base-value :digits 1) base)
|
||||
(throw (oneof syntax-error)))))))
|
||||
(%print-actions)
|
||||
)))
|
||||
|
||||
(defparameter *bel* (world-lexer *bew* 'base-example-lexer))
|
||||
(defparameter *beg* (lexer-grammar *bel*)))
|
||||
|
||||
#|
|
||||
(depict-rtf-to-local-file
|
||||
"Test/BaseExampleSemantics.rtf"
|
||||
"Base Example Semantics"
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *bew*)))
|
||||
|
||||
(depict-html-to-local-file
|
||||
"Test/BaseExampleSemantics.html"
|
||||
"Base Example Semantics"
|
||||
t
|
||||
#'(lambda (html-stream)
|
||||
(depict-world-commands html-stream *bew*))
|
||||
:external-link-base "")
|
||||
|
||||
|
||||
(lexer-pparse *bel* "37")
|
||||
(lexer-pparse *bel* "33#4")
|
||||
(lexer-pparse *bel* "30#2")
|
||||
|
||||
|#
|
||||
|
||||
(length (grammar-states *beg*))
|
||||
@@ -1,66 +0,0 @@
|
||||
;;; The contents of this file are subject to the Mozilla Public
|
||||
;;; License Version 1.1 (the "License"); you may not use this file
|
||||
;;; except in compliance with the License. You may obtain a copy of
|
||||
;;; the License at http://www.mozilla.org/MPL/
|
||||
;;;
|
||||
;;; Software distributed under the License is distributed on an "AS
|
||||
;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
;;; implied. See the License for the specific language governing
|
||||
;;; rights and limitations under the License.
|
||||
;;;
|
||||
;;; The Original Code is the Language Design and Prototyping Environment.
|
||||
;;;
|
||||
;;; The Initial Developer of the Original Code is Netscape Communications
|
||||
;;; Corporation. Portions created by Netscape Communications Corporation are
|
||||
;;; Copyright (C) 1999 Netscape Communications Corporation. All
|
||||
;;; Rights Reserved.
|
||||
;;;
|
||||
;;; Contributor(s): Waldemar Horwat <waldemar@acm.org>
|
||||
|
||||
;;;
|
||||
;;; Canonical LR(1) test grammar
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
(declaim (optimize (debug 3)))
|
||||
|
||||
(progn
|
||||
(defparameter *clrtw*
|
||||
(generate-world
|
||||
"T"
|
||||
'((grammar canonical-lr-test-grammar :canonical-lr-1 :start)
|
||||
|
||||
(production :start (:expr) start-expr)
|
||||
(production :start (:expr !) start-expr-!)
|
||||
|
||||
(production :expr (id) expr-id)
|
||||
(production :expr (:expr + id) expr-plus)
|
||||
(production :expr (:expr - id (:- -)) expr-minus)
|
||||
(production :expr (\( :expr \)) expr-parens)
|
||||
)))
|
||||
|
||||
(defparameter *clrtg* (world-grammar *clrtw* 'canonical-lr-test-grammar)))
|
||||
|
||||
|
||||
#|
|
||||
(depict-rtf-to-local-file
|
||||
"Test/CanonicalLRTestGrammar.rtf"
|
||||
"Canonical LR(1) Test Grammar"
|
||||
#'(lambda (markup-stream)
|
||||
(depict-world-commands markup-stream *clrtw* :visible-semantics nil)))
|
||||
|
||||
(depict-html-to-local-file
|
||||
"Test/CanonicalLRTestGrammar.html"
|
||||
"Canonical LR(1) Test Grammar"
|
||||
t
|
||||
#'(lambda (markup-stream)
|
||||
(depict-world-commands markup-stream *clrtw* :visible-semantics nil)))
|
||||
|
||||
(print-grammar *clrtg*)
|
||||
(with-local-output (s "Test/CanonicalLRTestGrammar.txt") (print-grammar *clrtg* s))
|
||||
|
||||
(pprint (parse *clrtg* #'identity '(begin letter letter letter digit end)))
|
||||
|#
|
||||
|
||||
(length (grammar-states *clrtg*))
|
||||
@@ -1,71 +0,0 @@
|
||||
;;; The contents of this file are subject to the Mozilla Public
|
||||
;;; License Version 1.1 (the "License"); you may not use this file
|
||||
;;; except in compliance with the License. You may obtain a copy of
|
||||
;;; the License at http://www.mozilla.org/MPL/
|
||||
;;;
|
||||
;;; Software distributed under the License is distributed on an "AS
|
||||
;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
;;; implied. See the License for the specific language governing
|
||||
;;; rights and limitations under the License.
|
||||
;;;
|
||||
;;; The Original Code is the Language Design and Prototyping Environment.
|
||||
;;;
|
||||
;;; The Initial Developer of the Original Code is Netscape Communications
|
||||
;;; Corporation. Portions created by Netscape Communications Corporation are
|
||||
;;; Copyright (C) 1999 Netscape Communications Corporation. All
|
||||
;;; Rights Reserved.
|
||||
;;;
|
||||
;;; Contributor(s): Waldemar Horwat <waldemar@acm.org>
|
||||
|
||||
;;;
|
||||
;;; Constraint test grammar
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
(declaim (optimize (debug 3)))
|
||||
|
||||
(progn
|
||||
(defparameter *ctw*
|
||||
(generate-world
|
||||
"T"
|
||||
'((grammar constraint-test-grammar :lr-1 :start)
|
||||
|
||||
(production :start (:string) start-string)
|
||||
(production :start ((:- letter digit) :chars) start-escape)
|
||||
(production :start ((:- escape) :char) start-letter-digit)
|
||||
|
||||
(production :string (begin :chars end) string)
|
||||
|
||||
(production :chars () chars-none)
|
||||
(production :chars (:chars :char) chars-some)
|
||||
|
||||
(production :char (letter (:- letter)) char-letter)
|
||||
(production :char (digit) char-digit)
|
||||
(production :char (escape digit (:- digit)) char-escape-1)
|
||||
(production :char (escape digit digit) char-escape-2)
|
||||
)))
|
||||
|
||||
(defparameter *ctg* (world-grammar *ctw* 'constraint-test-grammar)))
|
||||
|
||||
|
||||
#|
|
||||
(depict-rtf-to-local-file
|
||||
"Test/ConstraintTestGrammar.rtf"
|
||||
"Constraint Test Grammar"
|
||||
#'(lambda (markup-stream)
|
||||
(depict-world-commands markup-stream *ctw* :visible-semantics nil)))
|
||||
|
||||
(depict-html-to-local-file
|
||||
"Test/ConstraintTestGrammar.html"
|
||||
"Constraint Test Grammar"
|
||||
t
|
||||
#'(lambda (markup-stream)
|
||||
(depict-world-commands markup-stream *ctw* :visible-semantics nil)))
|
||||
|
||||
(with-local-output (s "Test/ConstraintTestGrammar.txt") (print-grammar *ctg* s))
|
||||
|
||||
(pprint (parse *ctg* #'identity '(begin letter letter letter digit end)))
|
||||
|#
|
||||
|
||||
(length (grammar-states *ctg*))
|
||||
@@ -1,68 +0,0 @@
|
||||
;;; The contents of this file are subject to the Mozilla Public
|
||||
;;; License Version 1.1 (the "License"); you may not use this file
|
||||
;;; except in compliance with the License. You may obtain a copy of
|
||||
;;; the License at http://www.mozilla.org/MPL/
|
||||
;;;
|
||||
;;; Software distributed under the License is distributed on an "AS
|
||||
;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
;;; implied. See the License for the specific language governing
|
||||
;;; rights and limitations under the License.
|
||||
;;;
|
||||
;;; The Original Code is the Language Design and Prototyping Environment.
|
||||
;;;
|
||||
;;; The Initial Developer of the Original Code is Netscape Communications
|
||||
;;; Corporation. Portions created by Netscape Communications Corporation are
|
||||
;;; Copyright (C) 1999 Netscape Communications Corporation. All
|
||||
;;; Rights Reserved.
|
||||
;;;
|
||||
;;; Contributor(s): Waldemar Horwat <waldemar@acm.org>
|
||||
|
||||
;;;
|
||||
;;; Line-break sensitive test grammar
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
(declaim (optimize (debug 3)))
|
||||
|
||||
(progn
|
||||
(defparameter *ltw*
|
||||
(generate-world
|
||||
"T"
|
||||
'((line-grammar line-test-grammar :lalr-1 :start)
|
||||
|
||||
(production :start (a) start-a)
|
||||
(production :start (b :no-line-break c) start-b-c)
|
||||
(production :start (d :no-line-break :y z) start-d-y-z)
|
||||
(production :start (e :y z) start-e-y-z)
|
||||
(production :start (:q :no-line-break a) start-q-a)
|
||||
(production :start (c :q a) start-c-q-a)
|
||||
(production :y () y-empty)
|
||||
(production :y (x) y-x)
|
||||
(production :q (x x) q-x-x)
|
||||
)))
|
||||
|
||||
(defparameter *ltg* (world-grammar *ltw* 'line-test-grammar)))
|
||||
|
||||
|
||||
#|
|
||||
(depict-rtf-to-local-file
|
||||
"Test/LineTestGrammar.rtf"
|
||||
"Line Test Grammar"
|
||||
#'(lambda (markup-stream)
|
||||
(depict-world-commands markup-stream *ltw* :visible-semantics nil)))
|
||||
|
||||
(depict-html-to-local-file
|
||||
"Test/LineTestGrammar.html"
|
||||
"Line Test Grammar"
|
||||
t
|
||||
#'(lambda (markup-stream)
|
||||
(depict-world-commands markup-stream *ltw* :visible-semantics nil)))
|
||||
|
||||
(print-grammar *ltg*)
|
||||
(with-local-output (s "Test/LineTestGrammar.txt") (print-grammar *ltg* s))
|
||||
|
||||
;(pprint (parse *ltg* #'identity '(begin letter letter letter digit end)))
|
||||
|#
|
||||
|
||||
(length (grammar-states *ltg*))
|
||||
@@ -1,71 +0,0 @@
|
||||
(progn
|
||||
(defparameter *nw*
|
||||
(generate-world
|
||||
"N"
|
||||
'((grammar name-resolution-grammar :lalr-1 :start)
|
||||
|
||||
(production :start () start-none)
|
||||
|
||||
(deftype value (oneof null abstract-value))
|
||||
(deftype class (oneof abstract-class))
|
||||
(deftype type (oneof abstract-type))
|
||||
(deftype namespace (oneof abstract-namespace))
|
||||
(deftype scope (oneof abstract-scope))
|
||||
|
||||
(deftype getter (-> (value) value))
|
||||
(deftype setter (-> (value value) value))
|
||||
|
||||
(%section "Namespaces")
|
||||
|
||||
(define (create-namespace (supernamespaces (vector namespace))) namespace
|
||||
(bottom))
|
||||
|
||||
(%section "Classes and Intefaces")
|
||||
|
||||
(define (create-class (interface boolean) (superclasses (vector class)) (implementees (vector class))) class
|
||||
(bottom))
|
||||
|
||||
(define (create-uninitialized-instance-slot (c class) (t type)) (tuple (get getter) (set setter))
|
||||
(bottom))
|
||||
|
||||
(define (create-instance-slot (c class) (t type) (initial-value value)) (tuple (get getter) (set setter))
|
||||
(bottom))
|
||||
|
||||
(define (freeze-instance-slots (c class)) void
|
||||
(bottom))
|
||||
|
||||
(define (create-instance (c class)) value
|
||||
(bottom))
|
||||
|
||||
(%section "Members")
|
||||
|
||||
(define (add-getter-member (visibility scope) (n namespace) (c class) (name string) (g getter)) void
|
||||
(bottom))
|
||||
(define (add-setter-member (visibility scope) (n namespace) (c class) (name string) (s setter)) void
|
||||
(bottom))
|
||||
|
||||
(define (lookup-getter-member (s scope) (n namespace) (v value) (name string)) getter
|
||||
(bottom))
|
||||
(define (lookup-setter-member (s scope) (n namespace) (v value) (name string)) setter
|
||||
(bottom))
|
||||
)))
|
||||
|
||||
(defparameter *ng* (world-grammar *nw* 'name-resolution-grammar)))
|
||||
|
||||
#|
|
||||
(depict-rtf-to-local-file
|
||||
"Test/NameResolutionSemantics.rtf"
|
||||
"Name Resolution Semantics"
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *nw*)))
|
||||
|#
|
||||
|
||||
(depict-html-to-local-file
|
||||
"Test/NameResolutionSemantics.html"
|
||||
"Name Resolution Semantics"
|
||||
t
|
||||
#'(lambda (html-stream)
|
||||
(depict-world-commands html-stream *nw*))
|
||||
:external-link-base "")
|
||||
|
||||
(length (grammar-states *ng*))
|
||||
@@ -1,37 +0,0 @@
|
||||
(progn
|
||||
(defparameter *sfw*
|
||||
(generate-world
|
||||
"SF"
|
||||
'((grammar standard-function-grammar :lalr-1 :start)
|
||||
|
||||
(production :start () start-none)
|
||||
|
||||
(define (x-digit-value (c character)) integer
|
||||
(if (character-set-member c (set-of-ranges character #\0 #\9))
|
||||
(- (character-to-code c) (character-to-code #\0))
|
||||
(if (character-set-member c (set-of-ranges character #\A #\Z))
|
||||
(+ (- (character-to-code c) (character-to-code #\A)) 10)
|
||||
(if (character-set-member c (set-of-ranges character #\a #\z))
|
||||
(+ (- (character-to-code c) (character-to-code #\a)) 10)
|
||||
(bottom)))))
|
||||
)))
|
||||
|
||||
(defparameter *sfg* (world-grammar *sfw* 'standard-function-grammar)))
|
||||
|
||||
#|
|
||||
(depict-rtf-to-local-file
|
||||
"Test/StandardFunctionSemantics.rtf"
|
||||
"Standard Function Semantics"
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *sfw*)))
|
||||
|
||||
(depict-html-to-local-file
|
||||
"Test/StandardFunctionSemantics.html"
|
||||
"Standard Function Semantics"
|
||||
t
|
||||
#'(lambda (html-stream)
|
||||
(depict-world-commands html-stream *sfw*))
|
||||
:external-link-base "")
|
||||
|#
|
||||
|
||||
(length (grammar-states *sfg*))
|
||||
@@ -1,56 +0,0 @@
|
||||
(progn
|
||||
(defparameter *tcw*
|
||||
(generate-world
|
||||
"TC"
|
||||
'((lexer throw-catch-lexer
|
||||
:lalr-1
|
||||
:main
|
||||
((:digit (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
|
||||
((value $digit-value))))
|
||||
(($digit-value integer digit-value digit-char-36)))
|
||||
|
||||
(%charclass :digit)
|
||||
|
||||
(deftype semantic-exception integer)
|
||||
|
||||
(rule :expr ((value (-> () integer)))
|
||||
(production :expr (:digit) expr-digit
|
||||
((value) (value :digit)))
|
||||
(production :expr (#\t :expr) expr-throw
|
||||
((value) (throw ((value :expr)))))
|
||||
(production :expr (#\c #\{ :expr #\} :expr) expr-catch
|
||||
((value) (catch ((value :expr 1))
|
||||
(e) (+ (* e 10) ((value :expr 2)))))))
|
||||
|
||||
(rule :main ((value integer))
|
||||
(production :main (:expr) main-expr
|
||||
(value ((value :expr)))))
|
||||
(%print-actions)
|
||||
)))
|
||||
|
||||
(defparameter *tcl* (world-lexer *tcw* 'throw-catch-lexer))
|
||||
(defparameter *tcg* (lexer-grammar *tcl*)))
|
||||
|
||||
#|
|
||||
(depict-rtf-to-local-file
|
||||
"Test/ThrowCatchSemantics.rtf"
|
||||
"Base Example Semantics"
|
||||
#'(lambda (rtf-stream)
|
||||
(depict-world-commands rtf-stream *tcw*)))
|
||||
|
||||
(depict-html-to-local-file
|
||||
"Test/ThrowCatchSemantics.html"
|
||||
"Base Example Semantics"
|
||||
t
|
||||
#'(lambda (html-stream)
|
||||
(depict-world-commands html-stream *tcw*))
|
||||
:external-link-base "")
|
||||
|
||||
|
||||
(lexer-pparse *tcl* "7")
|
||||
(lexer-pparse *tcl* "t3")
|
||||
(lexer-pparse *tcl* "c{t6}5")
|
||||
|
||||
|#
|
||||
|
||||
(length (grammar-states *tcg*))
|
||||
@@ -1,736 +0,0 @@
|
||||
;;; The contents of this file are subject to the Mozilla Public
|
||||
;;; License Version 1.1 (the "License"); you may not use this file
|
||||
;;; except in compliance with the License. You may obtain a copy of
|
||||
;;; the License at http://www.mozilla.org/MPL/
|
||||
;;;
|
||||
;;; Software distributed under the License is distributed on an "AS
|
||||
;;; IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
;;; implied. See the License for the specific language governing
|
||||
;;; rights and limitations under the License.
|
||||
;;;
|
||||
;;; The Original Code is the Language Design and Prototyping Environment.
|
||||
;;;
|
||||
;;; The Initial Developer of the Original Code is Netscape Communications
|
||||
;;; Corporation. Portions created by Netscape Communications Corporation are
|
||||
;;; Copyright (C) 1999 Netscape Communications Corporation. All
|
||||
;;; Rights Reserved.
|
||||
;;;
|
||||
;;; Contributor(s): Waldemar Horwat <waldemar@acm.org>
|
||||
|
||||
;;;
|
||||
;;; Handy lisp utilities
|
||||
;;;
|
||||
;;; Waldemar Horwat (waldemar@acm.org)
|
||||
;;;
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; MCL FIXES
|
||||
|
||||
|
||||
(setq *print-right-margin* 150)
|
||||
|
||||
;;; Fix name-char and char-name.
|
||||
#+mcl
|
||||
(locally
|
||||
(declare (optimize (speed 3) (safety 0) (debug 1)))
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setq *warn-if-redefine* nil)
|
||||
(setq *warn-if-redefine-kernel* nil))
|
||||
|
||||
(defun char-name (c)
|
||||
(dolist (e ccl::*name-char-alist*)
|
||||
(declare (list e))
|
||||
(when (eq c (cdr e))
|
||||
(return-from char-name (car e))))
|
||||
(let ((code (char-code c)))
|
||||
(declare (fixnum code))
|
||||
(cond ((< code #x100)
|
||||
(unless (and (>= code 32) (<= code 216) (/= code 127))
|
||||
(format nil "x~2,'0X" code)))
|
||||
(t (format nil "u~4,'0X" code)))))
|
||||
|
||||
(defun name-char (name)
|
||||
(if (characterp name)
|
||||
name
|
||||
(let* ((name (string name))
|
||||
(namelen (length name)))
|
||||
(declare (fixnum namelen))
|
||||
(or (cdr (assoc name ccl::*name-char-alist* :test #'string-equal))
|
||||
(if (= namelen 1)
|
||||
(char name 0)
|
||||
(when (>= namelen 2)
|
||||
(flet
|
||||
((number-char (name base lg-base)
|
||||
(let ((n 0))
|
||||
(dotimes (i (length name) (code-char n))
|
||||
(let ((code (digit-char-p (char name i) base)))
|
||||
(if code
|
||||
(setq n (logior code (ash n lg-base)))
|
||||
(return)))))))
|
||||
(case (char name 0)
|
||||
(#\^
|
||||
(when (= namelen 2)
|
||||
(code-char (the fixnum (logxor (the fixnum (char-code (char-upcase (char name 1)))) #x40)))))
|
||||
((#\x #\X #\u #\U)
|
||||
(number-char (subseq name 1) 16 4))
|
||||
((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7)
|
||||
(number-char name 8 3))))))))))
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setq *warn-if-redefine* t)
|
||||
(setq *warn-if-redefine-kernel* t)))
|
||||
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; READER SYNTAX
|
||||
|
||||
; Define #?num to produce a character with code given by the hexadecimal number num.
|
||||
; (This is a portable extension; the #\u syntax installed above does the same thing
|
||||
; but is not portable.)
|
||||
(set-dispatch-macro-character
|
||||
#\# #\?
|
||||
#'(lambda (stream subchar arg)
|
||||
(declare (ignore subchar arg))
|
||||
(let ((*read-base* 16))
|
||||
(code-char (read stream t nil t)))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; MACROS
|
||||
|
||||
; (list*-bind (var1 var2 ... varn) expr body):
|
||||
; evaluates expr to obtain a value v;
|
||||
; binds var1, var2, ..., varn such that (list* var1 var2 ... varn) is equal to v;
|
||||
; evaluates body with these bindings;
|
||||
; returns the result values from the body.
|
||||
(defmacro list*-bind ((var1 &rest vars) expr &body body)
|
||||
(labels
|
||||
((gen-let*-bindings (var1 vars expr)
|
||||
(if vars
|
||||
(let ((expr-var (gensym "REST")))
|
||||
(list*
|
||||
(list expr-var expr)
|
||||
(list var1 (list 'car expr-var))
|
||||
(gen-let*-bindings (car vars) (cdr vars) (list 'cdr expr-var))))
|
||||
(list
|
||||
(list var1 expr)))))
|
||||
(list* 'let* (gen-let*-bindings var1 vars expr) body)))
|
||||
|
||||
(set-pprint-dispatch '(cons (member list*-bind))
|
||||
(pprint-dispatch '(multiple-value-bind () ())))
|
||||
|
||||
|
||||
; (multiple-value-map-bind (var1 var2 ... varn) f (src1 src2 ... srcm) body)
|
||||
; evaluates src1, src2, ..., srcm to obtain lists l1, l2, ..., lm;
|
||||
; calls f on corresponding elements of lists l1, ..., lm; each such call should return n values v1 v2 ... vn;
|
||||
; binds var1, var2, ..., varn such var1 is the list of all v1's, var2 is the list of all v2's, etc.;
|
||||
; evaluates body with these bindings;
|
||||
; returns the result values from the body.
|
||||
(defmacro multiple-value-map-bind ((&rest vars) f (&rest srcs) &body body)
|
||||
(let ((n (length vars))
|
||||
(m (length srcs))
|
||||
(fun (gensym "F"))
|
||||
(ss nil)
|
||||
(vs nil)
|
||||
(accumulators nil))
|
||||
(dotimes (i n)
|
||||
(push (gensym "V") vs)
|
||||
(push (gensym "ACC") accumulators))
|
||||
(dotimes (i m)
|
||||
(push (gensym "S") ss))
|
||||
`(let ((,fun ,f)
|
||||
,@(mapcar #'(lambda (acc) (list acc nil)) accumulators))
|
||||
(mapc #'(lambda ,ss
|
||||
(multiple-value-bind ,vs (funcall ,fun ,@ss)
|
||||
,@(mapcar #'(lambda (accumulator v) (list 'push v accumulator))
|
||||
accumulators vs)))
|
||||
,@srcs)
|
||||
(let ,(mapcar #'(lambda (var accumulator) (list var (list 'nreverse accumulator)))
|
||||
vars accumulators)
|
||||
,@body))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; VALUE ASSERTS
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(defconstant *value-asserts* t))
|
||||
|
||||
; Assert that (test value) returns non-nil. Return value.
|
||||
(defmacro assert-value (value test &rest format-and-parameters)
|
||||
(if *value-asserts*
|
||||
(let ((v (gensym "VALUE")))
|
||||
`(let ((,v ,value))
|
||||
(unless (,test ,v)
|
||||
,(if format-and-parameters
|
||||
`(error ,@format-and-parameters)
|
||||
`(error "~S doesn't satisfy ~S" ',value ',test)))
|
||||
,v))
|
||||
value))
|
||||
|
||||
|
||||
; Assert that value is non-nil. Return value.
|
||||
(defmacro assert-non-null (value &rest format-and-parameters)
|
||||
`(assert-value ,value identity .
|
||||
,(or format-and-parameters
|
||||
`("~S is null" ',value))))
|
||||
|
||||
|
||||
; Assert that value is non-nil. Return nil.
|
||||
; Do not evaluate value in nondebug versions.
|
||||
(defmacro assert-true (value &rest format-and-parameters)
|
||||
(if *value-asserts*
|
||||
`(unless ,value
|
||||
,(if format-and-parameters
|
||||
`(error ,@format-and-parameters)
|
||||
`(error "~S is false" ',value)))
|
||||
nil))
|
||||
|
||||
|
||||
; Assert that expr returns n values. Return those values.
|
||||
(defmacro assert-n-values (n expr)
|
||||
(if *value-asserts*
|
||||
(let ((v (gensym "VALUES")))
|
||||
`(let ((,v (multiple-value-list ,expr)))
|
||||
(unless (= (length ,v) ,n)
|
||||
(error "~S returns ~D values instead of ~D" ',expr (length ,v) ',n))
|
||||
(values-list ,v)))
|
||||
expr))
|
||||
|
||||
; Assert that expr returns one value. Return that value.
|
||||
(defmacro assert-one-value (expr)
|
||||
`(assert-n-values 1 ,expr))
|
||||
|
||||
; Assert that expr returns two values. Return those values.
|
||||
(defmacro assert-two-values (expr)
|
||||
`(assert-n-values 2 ,expr))
|
||||
|
||||
; Assert that expr returns three values. Return those values.
|
||||
(defmacro assert-three-values (expr)
|
||||
`(assert-n-values 3 ,expr))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; STRUCTURED TYPES
|
||||
|
||||
(defconstant *type-asserts* t)
|
||||
|
||||
(defun tuple? (value structured-types)
|
||||
(if (endp structured-types)
|
||||
(null value)
|
||||
(and (consp value)
|
||||
(structured-type? (car value) (first structured-types))
|
||||
(tuple? (cdr value) (rest structured-types)))))
|
||||
|
||||
(defun list-of? (value structured-type)
|
||||
(or
|
||||
(null value)
|
||||
(and (consp value)
|
||||
(structured-type? (car value) structured-type)
|
||||
(list-of? (cdr value) structured-type))))
|
||||
|
||||
|
||||
; Return true if value has the given structured-type.
|
||||
; A structured-type can be a Common Lisp type or one of the forms below:
|
||||
;
|
||||
; (cons t1 t2) is the type of pairs whose car has structured-type t1 and
|
||||
; cdr has structured-type t2.
|
||||
;
|
||||
; (tuple t1 t2 ... tn) is the type of n-element lists whose first element
|
||||
; has structured-type t1, second element has structured-type t2, ...,
|
||||
; and last element has structured-type tn.
|
||||
;
|
||||
; (list t) is the type of lists all of whose elements have structured-type t.
|
||||
;
|
||||
(defun structured-type? (value structured-type)
|
||||
(cond
|
||||
((consp structured-type)
|
||||
(case (first structured-type)
|
||||
(cons (and (consp value)
|
||||
(structured-type? (car value) (second structured-type))
|
||||
(structured-type? (cdr value) (third structured-type))))
|
||||
(tuple (tuple? value (rest structured-type)))
|
||||
(list (list-of? value (second structured-type)))
|
||||
(t (typep value structured-type))))
|
||||
((null structured-type) nil)
|
||||
(t (typep value structured-type))))
|
||||
|
||||
|
||||
; Ensure that value has type given by typespec
|
||||
; (which should not be quoted). Return the value.
|
||||
(defmacro assert-type (value structured-type)
|
||||
(if *type-asserts*
|
||||
(let ((v (gensym "VALUE")))
|
||||
`(let ((,v ,value))
|
||||
(unless (structured-type? ,v ',structured-type)
|
||||
(error "~S should have type ~S" ,v ',structured-type))
|
||||
,v))
|
||||
value))
|
||||
|
||||
(deftype bool () '(member nil t))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; GENERAL UTILITIES
|
||||
|
||||
|
||||
; f must be either a function, a symbol, or a list of the form (setf <symbol>).
|
||||
; If f is a function or has a function binding, return that function; otherwise return nil.
|
||||
(defun callable (f)
|
||||
(cond
|
||||
((functionp f) f)
|
||||
((fboundp f) (fdefinition f))
|
||||
(t nil)))
|
||||
|
||||
|
||||
; Return the first character of symbol's name or nil if s's name has zero length.
|
||||
(defun first-symbol-char (symbol)
|
||||
(let ((name (symbol-name symbol)))
|
||||
(when (> (length name) 0)
|
||||
(char name 0))))
|
||||
|
||||
|
||||
(defconstant *get2-nonce* (if (boundp '*get2-nonce*) (symbol-value '*get2-nonce*) (gensym)))
|
||||
|
||||
; Perform a get except that return two values:
|
||||
; The value returned from the get or nil if the property is not present
|
||||
; t if the property is present or nil if not.
|
||||
(defun get2 (symbol property)
|
||||
(let ((value (get symbol property *get2-nonce*)))
|
||||
(if (eq value *get2-nonce*)
|
||||
(values nil nil)
|
||||
(values value t))))
|
||||
|
||||
|
||||
; Return a list of all the keys in the hash table.
|
||||
(defun hash-table-keys (hash-table)
|
||||
(let ((keys nil))
|
||||
(maphash #'(lambda (key value)
|
||||
(declare (ignore value))
|
||||
(push key keys))
|
||||
hash-table)
|
||||
keys))
|
||||
|
||||
|
||||
; Return a list of all the keys in the hash table sorted by their string representations.
|
||||
(defun sorted-hash-table-keys (hash-table)
|
||||
(with-standard-io-syntax
|
||||
(let ((*print-readably* nil)
|
||||
(*print-escape* nil))
|
||||
(sort (hash-table-keys hash-table) #'string<
|
||||
:key #'(lambda (item)
|
||||
(if (symbolp item)
|
||||
(or (get item :sort-key)
|
||||
(symbol-name item))
|
||||
(write-to-string item)))))))
|
||||
|
||||
|
||||
; Return an association list of all the entries in the hash table.
|
||||
(defun hash-table-entries (hash-table)
|
||||
(let ((entries nil))
|
||||
(maphash #'(lambda (key value)
|
||||
(push (cons key value) entries))
|
||||
hash-table)
|
||||
entries))
|
||||
|
||||
|
||||
; Return true if the two hash tables are equal, using the given equality test for testing their elements.
|
||||
(defun hash-table-= (hash-table1 hash-table2 &key (test #'eql))
|
||||
(and (= (hash-table-count hash-table1) (hash-table-count hash-table2))
|
||||
(progn
|
||||
(maphash
|
||||
#'(lambda (key1 value1)
|
||||
(multiple-value-bind (value2 present2) (gethash key1 hash-table2)
|
||||
(unless (and present2 (funcall test value1 value2))
|
||||
(return-from hash-table-= nil))))
|
||||
hash-table1)
|
||||
t)))
|
||||
|
||||
|
||||
; Given an association list ((key1 . data1) (key2 . data2) ... (keyn datan)),
|
||||
; produce another association list whose keys are sets of the keys of the original list,
|
||||
; where the data elements of each such set are equal according to the given test function.
|
||||
; The keys within each set are listed in the same order as in the original list.
|
||||
; Set X comes before set Y if X contains a key earlier in the original list than any
|
||||
; key in Y.
|
||||
(defun collect-equivalences (alist &key (test #'eql))
|
||||
(if (endp alist)
|
||||
nil
|
||||
(let* ((element (car alist))
|
||||
(key (car element))
|
||||
(data (cdr element))
|
||||
(rest (cdr alist)))
|
||||
(if (rassoc data rest :test test)
|
||||
(let ((filtered-rest nil)
|
||||
(additional-keys nil))
|
||||
(dolist (elt rest)
|
||||
(if (funcall test data (cdr elt))
|
||||
(push (car elt) additional-keys)
|
||||
(push elt filtered-rest)))
|
||||
(acons (cons key (nreverse additional-keys)) data
|
||||
(collect-equivalences (nreverse filtered-rest) :test test)))
|
||||
(acons (list key) data (collect-equivalences rest :test test))))))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; BITMAPS
|
||||
|
||||
; Treating integer m as a bitmap, call f on the number of each bit set in m.
|
||||
(defun bitmap-each-bit (f m)
|
||||
(assert-true (>= m 0))
|
||||
(dotimes (i (integer-length m))
|
||||
(when (logbitp i m)
|
||||
(funcall f i))))
|
||||
|
||||
|
||||
; Treating integer m as a bitmap, return a sorted list of disjoint, nonadjacent ranges
|
||||
; of bits set in m. Each range is a pair (x . y) and indicates that bits numbered x through
|
||||
; y, inclusive, are set in m. If m is negative, the last range will be a pair (x . :infinity).
|
||||
(defun bitmap-to-ranges (m)
|
||||
(labels
|
||||
((bitmap-to-ranges-sub (m ranges)
|
||||
(if (zerop m)
|
||||
ranges
|
||||
(let* ((hi (integer-length m))
|
||||
(m (- m (ash 1 hi)))
|
||||
(lo (integer-length m))
|
||||
(m (+ m (ash 1 lo))))
|
||||
(bitmap-to-ranges-sub m (acons lo (1- hi) ranges))))))
|
||||
(if (minusp m)
|
||||
(let* ((lo (integer-length m))
|
||||
(m (+ m (ash 1 lo))))
|
||||
(bitmap-to-ranges-sub m (list (cons lo :infinity))))
|
||||
(bitmap-to-ranges-sub m nil))))
|
||||
|
||||
|
||||
; Same as bitmap-to-ranges but abbreviate pairs (x . x) by x.
|
||||
(defun bitmap-to-abbreviated-ranges (m)
|
||||
(mapcar #'(lambda (range)
|
||||
(if (eql (car range) (cdr range))
|
||||
(car range)
|
||||
range))
|
||||
(bitmap-to-ranges m)))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; PACKAGES
|
||||
|
||||
; Call f on each external symbol defined in the package.
|
||||
(defun each-package-external-symbol (package f)
|
||||
(with-package-iterator (iter package :external)
|
||||
(loop
|
||||
(multiple-value-bind (present symbol) (iter)
|
||||
(unless present
|
||||
(return))
|
||||
(funcall f symbol)))))
|
||||
|
||||
|
||||
; Return a list of all external symbols defined in the package.
|
||||
(defun package-external-symbols (package)
|
||||
(with-package-iterator (iter package :external)
|
||||
(let ((list nil))
|
||||
(loop
|
||||
(multiple-value-bind (present symbol) (iter)
|
||||
(unless present
|
||||
(return))
|
||||
(push symbol list)))
|
||||
list)))
|
||||
|
||||
|
||||
; Return a sorted list of all external symbols defined in the package.
|
||||
(defun sorted-package-external-symbols (package)
|
||||
(sort (package-external-symbols package) #'string<))
|
||||
|
||||
|
||||
; Call f on each internal symbol defined in the package.
|
||||
(defun each-package-internal-symbol (package f)
|
||||
(with-package-iterator (iter package :internal)
|
||||
(loop
|
||||
(multiple-value-bind (present symbol) (iter)
|
||||
(unless present
|
||||
(return))
|
||||
(funcall f symbol)))))
|
||||
|
||||
|
||||
; Return a list of all internal symbols defined in the package.
|
||||
(defun package-internal-symbols (package)
|
||||
(with-package-iterator (iter package :internal)
|
||||
(let ((list nil))
|
||||
(loop
|
||||
(multiple-value-bind (present symbol) (iter)
|
||||
(unless present
|
||||
(return))
|
||||
(push symbol list)))
|
||||
list)))
|
||||
|
||||
|
||||
; Return a sorted list of all internal symbols defined in the package.
|
||||
(defun sorted-package-internal-symbols (package)
|
||||
(sort (package-internal-symbols package) #'string<))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; INTSETS
|
||||
|
||||
;;; An intset is a finite set of integers, represented as an ordered list of ranges.
|
||||
;;; Each range is a cons (low . high), both low and high being inclusive. Ranges must
|
||||
;;; be nonoverlapping, and adjacent ranges must be consolidated.
|
||||
|
||||
(defconstant *empty-intset* nil)
|
||||
|
||||
; Return true if the intset is valid.
|
||||
(defun valid-intset? (intset)
|
||||
(and (structured-type? intset '(list (cons integer integer)))
|
||||
(or (null intset)
|
||||
(let ((prev (- (caar intset) 2)))
|
||||
(dolist (range intset t)
|
||||
(let ((low (car range))
|
||||
(high (cdr range)))
|
||||
(unless (and (< prev (1- low)) (<= low high))
|
||||
(return nil))
|
||||
(setq prev high)))))))
|
||||
|
||||
|
||||
; Return an intset that is the union of the given intset and the intset
|
||||
; containg the given values.
|
||||
(defun intset-add-value (intset &rest values)
|
||||
(labels
|
||||
((add-value (intset value)
|
||||
(if (endp intset)
|
||||
(list (cons value value))
|
||||
(let* ((first-range (first intset))
|
||||
(rest (rest intset))
|
||||
(first-low (car first-range))
|
||||
(first-high (cdr first-range)))
|
||||
(cond
|
||||
((> value first-high)
|
||||
(cond
|
||||
((/= value (1+ first-high)) (cons first-range (add-value rest value)))
|
||||
((or (endp rest) (/= (caar rest) (1+ value))) (acons first-low value rest))
|
||||
(t (acons first-low (cdar rest) (rest rest)))))
|
||||
((< value first-low)
|
||||
(if (/= value (1- first-low))
|
||||
(acons value value intset)
|
||||
(acons value first-high rest)))
|
||||
(t intset))))))
|
||||
|
||||
(dolist (value values)
|
||||
(assert-true (integerp value))
|
||||
(add-value intset value))))
|
||||
|
||||
|
||||
; Return an intset that is the union of the given intset and the intset
|
||||
; containg all integers between low and high, inclusive. low <= high+1 is required.
|
||||
(defun intset-add-range (intset low high)
|
||||
(labels
|
||||
((add-range (intset low high)
|
||||
(if (endp intset)
|
||||
(list (cons low high))
|
||||
(let* ((first-range (first intset))
|
||||
(rest (rest intset))
|
||||
(first-low (car first-range))
|
||||
(first-high (cdr first-range)))
|
||||
(cond
|
||||
((> low (1+ first-high))
|
||||
(cons first-range (add-range rest low high)))
|
||||
((< high (1- first-low))
|
||||
(acons low high intset))
|
||||
((<= high first-high)
|
||||
(if (>= low first-low)
|
||||
intset
|
||||
(acons low first-high rest)))
|
||||
(t (add-range rest (min low first-low) high)))))))
|
||||
|
||||
(assert-true (and (integerp low) (integerp high) (<= low (1+ high))))
|
||||
(if (= low (1+ high))
|
||||
intset
|
||||
(add-range intset low high))))
|
||||
|
||||
|
||||
; Return an intset constructed from a list of ranges. Each range has two expressions,
|
||||
; low and high. high can be null to indicate a one-element range.
|
||||
(defun intset-from-ranges (&rest ranges)
|
||||
(if (endp ranges)
|
||||
*empty-intset*
|
||||
(progn
|
||||
(assert-true (cdr ranges))
|
||||
(intset-add-range (apply #'intset-from-ranges (cddr ranges))
|
||||
(first ranges)
|
||||
(or (second ranges) (first ranges))))))
|
||||
|
||||
|
||||
|
||||
; Return true if value is a member of the intset.
|
||||
(defun intset-member? (intset value)
|
||||
(if (endp intset)
|
||||
nil
|
||||
(let ((first-range (first intset)))
|
||||
(if (> value (cdr first-range))
|
||||
(intset-member? (rest intset) value)
|
||||
(>= value (car first-range))))))
|
||||
|
||||
|
||||
; Return the union of the two intsets.
|
||||
(defun intset-union (intset1 intset2)
|
||||
(cond
|
||||
((endp intset1) intset2)
|
||||
((endp intset2) intset1)
|
||||
(t (let* ((first-range1 (first intset1))
|
||||
(rest1 (rest intset1))
|
||||
(first-low1 (car first-range1))
|
||||
(first-high1 (cdr first-range1))
|
||||
(first-range2 (first intset2))
|
||||
(rest2 (rest intset2))
|
||||
(first-low2 (car first-range2))
|
||||
(first-high2 (cdr first-range2)))
|
||||
(cond
|
||||
((< first-high1 (1- first-low2))
|
||||
(cons first-range1 (intset-union rest1 intset2)))
|
||||
((< first-high2 (1- first-low1))
|
||||
(cons first-range2 (intset-union intset1 rest2)))
|
||||
(t (intset-union (intset-add-range intset1 first-low2 first-high2) rest2)))))))
|
||||
|
||||
|
||||
; Return the intersection of the two intsets.
|
||||
(defun intset-intersection (intset1 intset2)
|
||||
(if (or (endp intset1) (endp intset2))
|
||||
nil
|
||||
(let* ((first-range1 (first intset1))
|
||||
(rest1 (rest intset1))
|
||||
(first-low1 (car first-range1))
|
||||
(first-high1 (cdr first-range1))
|
||||
(first-range2 (first intset2))
|
||||
(rest2 (rest intset2))
|
||||
(first-low2 (car first-range2))
|
||||
(first-high2 (cdr first-range2))
|
||||
(low (max first-low1 first-low2)))
|
||||
(cond
|
||||
((< first-high1 first-high2)
|
||||
(if (<= low first-high1)
|
||||
(acons low first-high1 (intset-intersection rest1 intset2))
|
||||
(intset-intersection rest1 intset2)))
|
||||
((> first-high1 first-high2)
|
||||
(if (<= low first-high2)
|
||||
(acons low first-high2 (intset-intersection intset1 rest2))
|
||||
(intset-intersection intset1 rest2)))
|
||||
(t (acons low first-high1 (intset-intersection rest1 rest2)))))))
|
||||
|
||||
|
||||
; Return the the intset containing the elements of intset1 that are not in intset2.
|
||||
(defun intset-difference (intset1 intset2)
|
||||
(cond
|
||||
((endp intset1) nil)
|
||||
((endp intset2) intset1)
|
||||
(t (let* ((first-range1 (first intset1))
|
||||
(rest1 (rest intset1))
|
||||
(first-low1 (car first-range1))
|
||||
(first-high1 (cdr first-range1))
|
||||
(first-range2 (first intset2))
|
||||
(rest2 (rest intset2))
|
||||
(first-low2 (car first-range2))
|
||||
(first-high2 (cdr first-range2)))
|
||||
(cond
|
||||
((< first-high1 first-low2)
|
||||
(cons first-range1 (intset-difference rest1 intset2)))
|
||||
((> first-low1 first-high2)
|
||||
(intset-difference intset1 rest2))
|
||||
((< first-low1 first-low2)
|
||||
(acons first-low1 (1- first-low2) (intset-difference (acons first-low2 first-high1 rest1) intset2)))
|
||||
((> first-high1 first-high2)
|
||||
(intset-difference (acons (1+ first-high2) first-high1 rest1) rest2))
|
||||
(t (intset-difference rest1 intset2)))))))
|
||||
|
||||
|
||||
; Return true if the two intsets are equal.
|
||||
(declaim (inline intset=))
|
||||
(defun intset= (intset1 intset2)
|
||||
(equal intset1 intset2))
|
||||
|
||||
|
||||
; Return the number of elements in the intset.
|
||||
(defun intset-length (intset)
|
||||
(if (endp intset)
|
||||
0
|
||||
(+ 1 (- (cdar intset) (caar intset))
|
||||
(intset-length (rest intset)))))
|
||||
|
||||
|
||||
; Return the lowest element of the intset or nil if the intset is empty.
|
||||
(declaim (inline intset-min))
|
||||
(defun intset-min (intset)
|
||||
(caar intset))
|
||||
|
||||
|
||||
; Return the highest element of the intset or nil if the intset is empty.
|
||||
(defun intset-max (intset)
|
||||
(cdar (last intset)))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; PARTIAL ORDERS
|
||||
|
||||
(defstruct partial-order
|
||||
(next-number 0 :type integer)) ;Bit number to use for next element
|
||||
|
||||
|
||||
(defstruct (partial-order-element (:constructor make-partial-order-element (partial-order number predecessor-bitmap))
|
||||
(:copier nil)
|
||||
(:predicate partial-order-element?))
|
||||
(partial-order nil :type partial-order) ;Partial order to which this element belongs
|
||||
(number nil :type integer) ;Bit number of this element
|
||||
(predecessor-bitmap nil :type integer)) ;Bitmap of elements less than or equal to this one in the partial order
|
||||
|
||||
|
||||
; Construct a new unique element in the partial order that is greater than the
|
||||
; given predecessors. Return that element.
|
||||
(defun partial-order-add-element (partial-order &rest predecessors)
|
||||
(let* ((number (partial-order-next-number partial-order))
|
||||
(predecessor-bitmap (ash 1 number)))
|
||||
(dolist (predecessor predecessors)
|
||||
(assert-true (eq (partial-order-element-partial-order predecessor) partial-order))
|
||||
(setq predecessor-bitmap (logior predecessor-bitmap (partial-order-element-predecessor-bitmap predecessor))))
|
||||
(incf (partial-order-next-number partial-order))
|
||||
(make-partial-order-element partial-order number predecessor-bitmap)))
|
||||
|
||||
|
||||
(defmacro def-partial-order-element (partial-order name &rest predecessors)
|
||||
`(defparameter ,name (partial-order-add-element ,partial-order ,@predecessors)))
|
||||
|
||||
|
||||
; Return true if element1 is greater than or equal to element2 in this partial order.
|
||||
(defun partial-order->= (element1 element2)
|
||||
(assert-true (eq (partial-order-element-partial-order element1) (partial-order-element-partial-order element2)))
|
||||
(logbitp (partial-order-element-number element2) (partial-order-element-predecessor-bitmap element1)))
|
||||
|
||||
|
||||
; Return true if element1 is less than element2 in this partial order.
|
||||
(declaim (inline partial-order-<))
|
||||
(defun partial-order-< (element1 element2)
|
||||
(not (partial-order->= element1 element2)))
|
||||
|
||||
|
||||
;;; ------------------------------------------------------------------------------------------------------
|
||||
;;; DEPTH-FIRST SEARCH
|
||||
|
||||
; Return a depth-first-ordered list of the nodes in a directed graph.
|
||||
; The graph may contain cycles, so a general depth-first search is used.
|
||||
; start is the start node.
|
||||
; successors is a function that takes a node and returns a list of that
|
||||
; node's successors.
|
||||
; test is a function that takes two nodes and returns true if they are
|
||||
; the same node. test should be either #'eq, #'eql, or #'equal
|
||||
; because it is used as a test function in a hash table.
|
||||
(defun depth-first-search (test successors start)
|
||||
(let ((visited-nodes (make-hash-table :test test))
|
||||
(dfs-list nil))
|
||||
(labels
|
||||
((visit (node)
|
||||
(setf (gethash node visited-nodes) t)
|
||||
(dolist (successor (funcall successors node))
|
||||
(unless (gethash successor visited-nodes)
|
||||
(visit successor)))
|
||||
(push node dfs-list)))
|
||||
(visit start)
|
||||
dfs-list)))
|
||||
@@ -1,72 +0,0 @@
|
||||
A:link {color: #0000DD}
|
||||
A:visited {color: #551188}
|
||||
A:hover {color: #3333FF}
|
||||
A:active {color: #FF00FF}
|
||||
A * {text-decoration: inherit}
|
||||
|
||||
.title1 {font-family: "Times New Roman", Times, serif; font-size: 36pt; font-weight: bold; color: #000000; white-space: nowrap}
|
||||
.title2 {font-family: "Times New Roman", Times, serif; font-size: 18pt; font-weight: bold; color: #000000; white-space: nowrap}
|
||||
.top-title {color: #009900}
|
||||
.es-title {color: #999900}
|
||||
.draft-title {color: #FF0000}
|
||||
.mod-date {font-size: smaller; font-style: italic; text-align: right}
|
||||
.sub {font-size: 70%}
|
||||
.sub-num {font-size: 70%; font-style: normal}
|
||||
.syntax {margin-left: 0.5in}
|
||||
.indent {margin-left: 0.5in}
|
||||
.issue {color: #FF0000}
|
||||
|
||||
BODY {background-color: #FFFFFF; color: #000000}
|
||||
DL {margin-left: 18pt}
|
||||
DD {margin-bottom: 6pt}
|
||||
DT {font-style: italic; margin-top: 3pt}
|
||||
|
||||
.js2 {background-color: #FFFF66; color: #000033}
|
||||
.js2-hidden {}
|
||||
.es4 {background-color: #FFCCCC; color: #333300; text-decoration: line-through}
|
||||
.es4-hidden {}
|
||||
|
||||
.grammar-rule {margin-left: 18pt; margin-top: 6pt; margin-bottom: 6pt}
|
||||
.grammar-lhs {}
|
||||
.grammar-rhs {margin-left: 9pt;}
|
||||
.grammar-argument {margin-left: 18pt; margin-top: 6pt; margin-bottom: 6pt}
|
||||
.semantics {margin-left: 9pt; margin-top: 6pt; margin-bottom: 3pt}
|
||||
.semantics-next {margin-left: 27pt; margin-top: 0pt; margin-bottom: 3pt}
|
||||
.semantic-comment {margin-left: 9pt; margin-top: 12pt; margin-bottom: 0pt}
|
||||
|
||||
.symbol {font-family: Symbol}
|
||||
.unicode {font-family: "Lucida Sans Unicode", serif}
|
||||
VAR, VAR A:link, VAR A:visited {font-family: Georgia, Palatino, "Times New Roman", Times, serif; font-weight: normal; font-style: italic; color: #336600}
|
||||
A:hover VAR, VAR A:hover {color: #003300}
|
||||
A:active VAR, VAR A:active {color: #00FF00}
|
||||
CODE, PRE {font-family: "Courier New", Courier, mono; color: #0000FF}
|
||||
PRE {margin-left: 0.5in}
|
||||
A:hover CODE {color: #3333CC}
|
||||
A:active CODE {color: #6666FF}
|
||||
.control, A.control:link, A.control:visited {font-family: "Times New Roman", Times, serif; font-weight: normal; color: #000099}
|
||||
A.control:hover, A:hover .control {color: #333366}
|
||||
A.control:active, A:active .control {color: #3333FF}
|
||||
.terminal, A.terminal:link, A.terminal:visited {font-family: Georgia, Palatino, "Times New Roman", Times, serif; font-weight: bold; color: #009999}
|
||||
A.terminal:hover, A:hover .terminal {color: #336666}
|
||||
A.terminal:active, A:active .terminal {color: #00FFFF}
|
||||
.terminal-keyword {font-weight: bold}
|
||||
.nonterminal, A.nonterminal:link, A.nonterminal:visited, .nonterminal A:link, .nonterminal A:visited {font-family: Georgia, Palatino, "Times New Roman", Times, serif; font-weight: normal; font-style: italic; color: #009900}
|
||||
A.nonterminal:hover, .nonterminal A:hover, A:hover .nonterminal {color: #336633}
|
||||
A.nonterminal:active, .nonterminal A:active, A:active .nonterminal {color: #00FF00}
|
||||
.nonterminal-attribute, .nonterminal-argument {font-style: normal}
|
||||
.semantic-keyword {font-family: "Times New Roman", Times, serif; font-weight: bold}
|
||||
.type-expression, A.type-expression:link, A.type-expression:visited, .type-name, A.type-name:link, A.type-name:visited {font-family: "Times New Roman", Times, serif; color: #CC0000}
|
||||
A.type-expression:hover, A:hover .type-expression, A.type-name:hover, A:hover .type-name {color: #990000}
|
||||
A.type-expression:active, A:active .type-expression, A.type-name:active, A:active .type-name {color: #FF6666}
|
||||
.type-name {font-variant: small-caps}
|
||||
.id-name {font-family: Arial, Helvetica, sans-serif; font-variant: small-caps}
|
||||
.field-name, A.field-name:link, A.field-name:visited {font-family: Arial, Helvetica, sans-serif; color: #FF0000}
|
||||
A.field-name:hover, A:hover .field-name {color: #CC3333}
|
||||
A.field-name:active, A:active .field-name {color: #FF6666}
|
||||
.global-variable, A.global-variable:link, A.global-variable:visited {font-family: "Times New Roman", Times, serif; color: #006600}
|
||||
.local-variable, A.local-variable:link, A.local-variable:visited {font-family: "Times New Roman", Times, serif; color: #009900}
|
||||
A.global-variable:hover, A:hover .global-variable, A.local-variable:hover, A:hover .local-variable {color: #336633}
|
||||
A.global-variable:active, A:active .global-variable, A.local-variable:active, A:active .local-variable {color: #00FF00}
|
||||
.action-name, A.action-name:link, A.action-name:visited {font-family: "Zapf Chancery", "Comic Sans MS", Script, serif; color: #660066}
|
||||
A.action-name:hover, A:hover .action-name {color: #663366}
|
||||
A.action-name:active, A:active .action-name {color: #FF00FF}
|
||||
@@ -1,124 +0,0 @@
|
||||
// Most browsers don't support unicode mathematical symbols yet.
|
||||
// As a workaround, this code maps them to the Symbol font using
|
||||
// either the ISO-8859-1 or ISO-8859-1-to-MacRoman inverse mapping.
|
||||
|
||||
var mapping_Unicode = 0; // Output true unicode
|
||||
var mapping_Win = 1; // Emulate using Windows Symbol font
|
||||
var mapping_Mac = 2; // Emulate using Mac Symbol font
|
||||
|
||||
// CSS class names to use depending on the mapping
|
||||
var cssClassNames = ["", "symbol", "symbol"];
|
||||
|
||||
|
||||
var mapping;
|
||||
if (parseFloat(navigator.appVersion) >= 5)
|
||||
mapping = mapping_Unicode;
|
||||
else if (navigator.platform.indexOf("Mac") != -1)
|
||||
mapping = mapping_Mac;
|
||||
else
|
||||
mapping = mapping_Win;
|
||||
|
||||
function defMap(unicode, win, mac) {
|
||||
if (cssClassNames[mapping] == "")
|
||||
return '&#' + arguments[mapping] + ';';
|
||||
else
|
||||
return '<SPAN class="' + cssClassNames[mapping] + '">&#' + arguments[mapping] + ';</SPAN>';
|
||||
}
|
||||
|
||||
|
||||
var U_times = defMap(0x00D7, 0xB4, 0xA5);
|
||||
|
||||
var U_Alpha = defMap(0x0391, 0x41, 0x41);
|
||||
var U_Beta = defMap(0x0392, 0x42, 0x42);
|
||||
var U_Gamma = defMap(0x0393, 0x47, 0x47);
|
||||
var U_Delta = defMap(0x0394, 0x44, 0x44);
|
||||
var U_Epsilon = defMap(0x0395, 0x45, 0x45);
|
||||
var U_Zeta = defMap(0x0396, 0x5A, 0x5A);
|
||||
var U_Eta = defMap(0x0397, 0x48, 0x48);
|
||||
var U_Theta = defMap(0x0398, 0x51, 0x51);
|
||||
var U_Iota = defMap(0x0399, 0x49, 0x49);
|
||||
var U_Kappa = defMap(0x039A, 0x4B, 0x4B);
|
||||
var U_Lambda = defMap(0x039B, 0x4C, 0x4C);
|
||||
var U_Mu = defMap(0x039C, 0x4D, 0x4D);
|
||||
var U_Nu = defMap(0x039D, 0x4E, 0x4E);
|
||||
var U_Xi = defMap(0x039E, 0x58, 0x58);
|
||||
var U_Omicron = defMap(0x039F, 0x4F, 0x4F);
|
||||
var U_Pi = defMap(0x03A0, 0x50, 0x50);
|
||||
var U_Rho = defMap(0x03A1, 0x52, 0x52);
|
||||
var U_Sigma = defMap(0x03A3, 0x53, 0x53);
|
||||
var U_Tau = defMap(0x03A4, 0x54, 0x54);
|
||||
var U_Upsilon = defMap(0x03A5, 0x55, 0x55);
|
||||
var U_Phi = defMap(0x03A6, 0x46, 0x46);
|
||||
var U_Chi = defMap(0x03A7, 0x43, 0x43);
|
||||
var U_Psi = defMap(0x03A8, 0x59, 0x59);
|
||||
var U_Omega = defMap(0x03A9, 0x57, 0x57);
|
||||
|
||||
var U_alpha = defMap(0x03B1, 0x61, 0x61);
|
||||
var U_beta = defMap(0x03B2, 0x62, 0x62);
|
||||
var U_gamma = defMap(0x03B3, 0x67, 0x67);
|
||||
var U_delta = defMap(0x03B4, 0x64, 0x64);
|
||||
var U_epsilon = defMap(0x03B5, 0x65, 0x65);
|
||||
var U_zeta = defMap(0x03B6, 0x7A, 0x7A);
|
||||
var U_eta = defMap(0x03B7, 0x68, 0x68);
|
||||
var U_theta = defMap(0x03B8, 0x71, 0x71);
|
||||
var U_iota = defMap(0x03B9, 0x69, 0x69);
|
||||
var U_kappa = defMap(0x03BA, 0x6B, 0x6B);
|
||||
var U_lambda = defMap(0x03BB, 0x6C, 0x6C);
|
||||
var U_mu = defMap(0x03BC, 0x6D, 0x6D);
|
||||
var U_nu = defMap(0x03BD, 0x6E, 0x6E);
|
||||
var U_xi = defMap(0x03BE, 0x78, 0x78);
|
||||
var U_omicron = defMap(0x03BF, 0x6F, 0x6F);
|
||||
var U_pi = defMap(0x03C0, 0x70, 0x70);
|
||||
var U_rho = defMap(0x03C1, 0x72, 0x72);
|
||||
var U_sigma = defMap(0x03C3, 0x73, 0x73);
|
||||
var U_tau = defMap(0x03C4, 0x74, 0x74);
|
||||
var U_upsilon = defMap(0x03C5, 0x75, 0x75);
|
||||
var U_phi = defMap(0x03C6, 0x66, 0x66);
|
||||
var U_chi = defMap(0x03C7, 0x63, 0x63);
|
||||
var U_psi = defMap(0x03C8, 0x79, 0x79);
|
||||
var U_omega = defMap(0x03C9, 0x77, 0x77);
|
||||
|
||||
var U_bull = defMap(0x2022, 0xB7, 0x2211);
|
||||
|
||||
var U_larr = defMap(0x2190, 0xAC, 0xA8);
|
||||
var U_uarr = defMap(0x2191, 0xAD, 0x2260);
|
||||
var U_rarr = defMap(0x2192, 0xAE, 0xC6);
|
||||
var U_darr = defMap(0x2193, 0xAF, 0xD8);
|
||||
var U_harr = defMap(0x2194, 0xAB, 0xB4);
|
||||
var U_lArr = defMap(0x21D0, 0xDC, 0x2039);
|
||||
var U_uArr = defMap(0x21D1, 0xDD, 0x203A);
|
||||
var U_rArr = defMap(0x21D2, 0xDE, 0xFB01);
|
||||
var U_dArr = defMap(0x21D3, 0xDF, 0xFB02);
|
||||
var U_hArr = defMap(0x21D4, 0xDB, 0x20AC);
|
||||
|
||||
var U_forall = defMap(0x2200, 0x22, 0x22);
|
||||
var U_exist = defMap(0x2203, 0x24, 0x24);
|
||||
var U_empty = defMap(0x2205, 0xC6, 0x2206);
|
||||
var U_isin = defMap(0x2208, 0xCE, 0x0152);
|
||||
var U_notin = defMap(0x2209, 0xCF, 0x0153);
|
||||
var U_infin = defMap(0x221E, 0xA5, 0x2022);
|
||||
var U_and = defMap(0x2227, 0xD9, 0x0178);
|
||||
var U_or = defMap(0x2228, 0xDA, 0x2044);
|
||||
var U_cap = defMap(0x2229, 0xC7, 0xAB);
|
||||
var U_cup = defMap(0x222A, 0xC8, 0xBB);
|
||||
var U_cong = defMap(0x2245, 0x40, 0x40);
|
||||
var U_asymp = defMap(0x2248, 0xBB, 0xAA);
|
||||
var U_ne = defMap(0x2260, 0xB9, 0x03C0);
|
||||
var U_equiv = defMap(0x2261, 0xBA, 0x222B);
|
||||
var U_le = defMap(0x2264, 0xA3, 0xA3);
|
||||
var U_ge = defMap(0x2265, 0xB3, 0x2265);
|
||||
var U_sub = defMap(0x2282, 0xCC, 0xC3);
|
||||
var U_sup = defMap(0x2283, 0xC9, 0x2026);
|
||||
var U_nsub = defMap(0x2284, 0xCB, 0xC0);
|
||||
var U_sube = defMap(0x2286, 0xCD, 0xD5);
|
||||
var U_supe = defMap(0x2287, 0xCA, 0xA0); //Mac Navigator confuses it with nbsp
|
||||
var U_oplus = defMap(0x2295, 0xC5, 0x2248);
|
||||
var U_otimes = defMap(0x2297, 0xC4, 0x0192);
|
||||
var U_perp = defMap(0x22A5, 0x5E, 0x5E);
|
||||
|
||||
var U_lceil = defMap(0x2308, 0xE9, 0xC8);
|
||||
var U_rceil = defMap(0x2309, 0xF9, 0x02D8);
|
||||
var U_lfloor = defMap(0x230A, 0xEB, 0xCE);
|
||||
var U_rfloor = defMap(0x230B, 0xFB, 0x02DA);
|
||||
var U_lang = defMap(0x2329, 0xE1, 0xB7);
|
||||
var U_rang = defMap(0x232A, 0xF1, 0xD2);
|
||||
@@ -1,417 +0,0 @@
|
||||
#pragma warning ( disable : 4786 )
|
||||
|
||||
#include "Nodes.h"
|
||||
#include "JSILGenerator.h"
|
||||
#include "../jsc/src/cpp/parser/NodeFactory.h"
|
||||
#include "ReferenceValue.h"
|
||||
#include "ConstantEvaluator.h"
|
||||
#include "Builder.h"
|
||||
#include "GlobalObjectBuilder.h"
|
||||
|
||||
namespace esc {
|
||||
namespace v1 {
|
||||
|
||||
JavaScript::ICG::ICodeModule* JSILGenerator::emit() {
|
||||
return 0;
|
||||
}
|
||||
|
||||
// Evaluators
|
||||
|
||||
// Base node
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, Node* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
// Expression evaluators
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ThisExpressionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
/*
|
||||
* Unqualified identifiers evaluate to a ReferenceValue during semantic analysis,
|
||||
* and so this method is never called.
|
||||
*/
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, IdentifierNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, QualifiedIdentifierNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, LiteralBooleanNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, LiteralNumberNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
/*
|
||||
* Literal string
|
||||
*/
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, LiteralStringNode* node ) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, LiteralUndefinedNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, LiteralRegExpNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, UnitExpressionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, FunctionExpressionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ParenthesizedExpressionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ParenthesizedListExpressionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, LiteralObjectNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, LiteralFieldNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, LiteralArrayNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, PostfixExpressionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, NewExpressionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
/*
|
||||
* Indexed member expressions evaluate to a ReferenceValue during semantic analysis,
|
||||
* and so this method is never called.
|
||||
*/
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, IndexedMemberExpressionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ClassofExpressionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
/*
|
||||
* Member expressions evaluate to a ReferenceValue during semantic analysis,
|
||||
* and so this method is never called.
|
||||
*/
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, MemberExpressionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, CoersionExpressionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
/*
|
||||
* CallExpressionNode
|
||||
*
|
||||
* Call expressions can be generated as invocations of the function
|
||||
* object's call method, or as a direct call to a native function.
|
||||
* If constant evaluation was able to resolve the function reference
|
||||
* to a built-in native function, then call a direct call is generated.
|
||||
*
|
||||
* NOTE: this code is being generated into the start function with
|
||||
* parameters (Stack scope, ObjectValue this). These are in
|
||||
* local registers (0 and 1).
|
||||
*/
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, CallExpressionNode* node ) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* GetExpressionNode
|
||||
*
|
||||
* Get expressions are psuedo syntactic constructs, created when
|
||||
* a member expression is used in a context where a value is
|
||||
* expected. In the general case, a get expression is the same as
|
||||
* a call expression with no arguments. In specfic cases, a get
|
||||
* expression can be optimized as a direct access of a native
|
||||
* field.
|
||||
*/
|
||||
|
||||
/*
|
||||
* What do we need to compile a variable reference to a field id?
|
||||
* the name and the class that defines it. Instance variables would
|
||||
* be instance fields of the Global prototype object. The runtime
|
||||
* version of this object would have the native field that implements
|
||||
* that variable.
|
||||
*
|
||||
* get x ();
|
||||
*
|
||||
* 1 aload_1 // get the target object value
|
||||
* 2 getfield #3 <Field int _values_[]> // get the property values array
|
||||
* 5 iconst_0 // get the index of value
|
||||
* 6 iaload // load the value from values
|
||||
*/
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, GetExpressionNode* node ) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* SetExpressionNode
|
||||
*
|
||||
* Set expressions are psuedo syntactic constructs, created when
|
||||
* a member expression is used in a context where a storage location
|
||||
* is expected. In the general case, a set expression is the same as
|
||||
* a call expression with one argument (the value to be stored.) In
|
||||
* specfic cases, a get expression can be optimized as a direct access
|
||||
* of a native field.
|
||||
*
|
||||
* set x (value);
|
||||
*
|
||||
* 1 aload_1 // get the target object value
|
||||
* 2 getfield #3 <Field int values[]> // get the property values array
|
||||
* 5 iconst_0 // get the index of the value
|
||||
* 6 iconst_5 // get the value
|
||||
* 7 iastore // store the value in values
|
||||
*/
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, SetExpressionNode* node ) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, UnaryExpressionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, BinaryExpressionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ConditionalExpressionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, AssignmentExpressionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
/*
|
||||
* Generate the code for a list (e.g. argument list). The owner of this node
|
||||
* has already allocated a fixed size array. This function stuffs the list
|
||||
* values into that array.
|
||||
*/
|
||||
|
||||
int list_index;
|
||||
int list_array_register;
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ListNode* node ) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
// Statements
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, StatementListNode* node ) {
|
||||
return ObjectValue::undefinedValue;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, EmptyStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ExpressionStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, AnnotatedBlockNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, LabeledStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, IfStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, SwitchStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, CaseLabelNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, DoStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, WhileStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ForInStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ForStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, WithStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ContinueStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, BreakStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ReturnStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ThrowStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, TryStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, CatchClauseNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, FinallyClauseNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, UseStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, IncludeStatementNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
// Definitions
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ImportDefinitionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ImportBindingNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, AnnotatedDefinitionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, AttributeListNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ExportDefinitionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ExportBindingNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, VariableDefinitionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, VariableBindingNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, TypedVariableNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, FunctionDefinitionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, FunctionDeclarationNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, FunctionNameNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, FunctionSignatureNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ParameterNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, OptionalParameterNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ClassDefinitionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ClassDeclarationNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, InheritanceNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, NamespaceDefinitionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, PackageDefinitionNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
Value* JSILGenerator::evaluate( Context& cx, ProgramNode* node ) {
|
||||
throw;
|
||||
}
|
||||
|
||||
/*
|
||||
* Test driver
|
||||
*/
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Written by Jeff Dyer
|
||||
* Copyright (c) 1998-2001 by Mountain View Compiler Company
|
||||
* All rights reserved.
|
||||
*/
|
||||
@@ -1,136 +0,0 @@
|
||||
/*
|
||||
* JSILGenerator
|
||||
*/
|
||||
|
||||
#ifndef JSILGenerator_h
|
||||
#define JSILGenerator_h
|
||||
|
||||
#include <vector>
|
||||
|
||||
#include "Value.h"
|
||||
#include "Context.h"
|
||||
#include "Evaluator.h"
|
||||
#include "icodegenerator.h"
|
||||
//#include "ByteCodeFactory.h"
|
||||
//#include "ClassFileConstants.h"
|
||||
|
||||
namespace esc {
|
||||
namespace v1 {
|
||||
|
||||
class JavaScript::ICG::ICodeModule;
|
||||
|
||||
using namespace esc::v1;
|
||||
|
||||
class JSILGenerator : public Evaluator /*, private ByteCodeFactory*/ {
|
||||
|
||||
public:
|
||||
|
||||
/*
|
||||
* Test driver
|
||||
*/
|
||||
|
||||
static int main(int argc, char* argv[]);
|
||||
|
||||
/* Create a JSILGenerator object for each ICode module.
|
||||
*/
|
||||
|
||||
JSILGenerator(std::string scriptname) {
|
||||
}
|
||||
|
||||
~JSILGenerator() {
|
||||
}
|
||||
|
||||
JavaScript::ICG::ICodeModule* emit();
|
||||
|
||||
// Base node
|
||||
|
||||
Value* evaluate( Context& cx, Node* node );
|
||||
|
||||
// 3rd Edition features
|
||||
|
||||
Value* evaluate( Context& cx, IdentifierNode* node );
|
||||
Value* evaluate( Context& cx, ThisExpressionNode* node );
|
||||
Value* evaluate( Context& cx, LiteralBooleanNode* node );
|
||||
Value* evaluate( Context& cx, LiteralNumberNode* node );
|
||||
Value* evaluate( Context& cx, LiteralStringNode* node );
|
||||
Value* evaluate( Context& cx, LiteralUndefinedNode* node );
|
||||
Value* evaluate( Context& cx, LiteralRegExpNode* node );
|
||||
Value* evaluate( Context& cx, FunctionExpressionNode* node );
|
||||
Value* evaluate( Context& cx, ParenthesizedExpressionNode* node );
|
||||
Value* evaluate( Context& cx, ParenthesizedListExpressionNode* node );
|
||||
Value* evaluate( Context& cx, LiteralObjectNode* node );
|
||||
Value* evaluate( Context& cx, LiteralFieldNode* node );
|
||||
Value* evaluate( Context& cx, LiteralArrayNode* node );
|
||||
Value* evaluate( Context& cx, PostfixExpressionNode* node );
|
||||
Value* evaluate( Context& cx, NewExpressionNode* node );
|
||||
Value* evaluate( Context& cx, IndexedMemberExpressionNode* node );
|
||||
Value* evaluate( Context& cx, MemberExpressionNode* node );
|
||||
Value* evaluate( Context& cx, CallExpressionNode* node );
|
||||
Value* evaluate( Context& cx, GetExpressionNode* node );
|
||||
Value* evaluate( Context& cx, SetExpressionNode* node );
|
||||
Value* evaluate( Context& cx, UnaryExpressionNode* node );
|
||||
Value* evaluate( Context& cx, BinaryExpressionNode* node );
|
||||
Value* evaluate( Context& cx, ConditionalExpressionNode* node );
|
||||
Value* evaluate( Context& cx, AssignmentExpressionNode* node );
|
||||
Value* evaluate( Context& cx, ListNode* node );
|
||||
Value* evaluate( Context& cx, StatementListNode* node );
|
||||
Value* evaluate( Context& cx, EmptyStatementNode* node );
|
||||
Value* evaluate( Context& cx, ExpressionStatementNode* node );
|
||||
Value* evaluate( Context& cx, AnnotatedBlockNode* node );
|
||||
Value* evaluate( Context& cx, LabeledStatementNode* node );
|
||||
Value* evaluate( Context& cx, IfStatementNode* node );
|
||||
Value* evaluate( Context& cx, SwitchStatementNode* node );
|
||||
Value* evaluate( Context& cx, CaseLabelNode* node );
|
||||
Value* evaluate( Context& cx, DoStatementNode* node );
|
||||
Value* evaluate( Context& cx, WhileStatementNode* node );
|
||||
Value* evaluate( Context& cx, ForInStatementNode* node );
|
||||
Value* evaluate( Context& cx, ForStatementNode* node );
|
||||
Value* evaluate( Context& cx, WithStatementNode* node );
|
||||
Value* evaluate( Context& cx, ContinueStatementNode* node );
|
||||
Value* evaluate( Context& cx, BreakStatementNode* node );
|
||||
Value* evaluate( Context& cx, ReturnStatementNode* node );
|
||||
Value* evaluate( Context& cx, ThrowStatementNode* node );
|
||||
Value* evaluate( Context& cx, TryStatementNode* node );
|
||||
Value* evaluate( Context& cx, CatchClauseNode* node );
|
||||
Value* evaluate( Context& cx, FinallyClauseNode* node );
|
||||
Value* evaluate( Context& cx, AnnotatedDefinitionNode* node );
|
||||
Value* evaluate( Context& cx, VariableDefinitionNode* node );
|
||||
Value* evaluate( Context& cx, VariableBindingNode* node );
|
||||
Value* evaluate( Context& cx, FunctionDefinitionNode* node );
|
||||
Value* evaluate( Context& cx, FunctionDeclarationNode* node );
|
||||
Value* evaluate( Context& cx, FunctionNameNode* node );
|
||||
Value* evaluate( Context& cx, FunctionSignatureNode* node );
|
||||
Value* evaluate( Context& cx, ParameterNode* node );
|
||||
Value* evaluate( Context& cx, ProgramNode* node );
|
||||
|
||||
// 4th Edition features
|
||||
|
||||
Value* evaluate( Context& cx, QualifiedIdentifierNode* node );
|
||||
Value* evaluate( Context& cx, UnitExpressionNode* node );
|
||||
Value* evaluate( Context& cx, ClassofExpressionNode* node );
|
||||
Value* evaluate( Context& cx, CoersionExpressionNode* node );
|
||||
Value* evaluate( Context& cx, UseStatementNode* node );
|
||||
Value* evaluate( Context& cx, IncludeStatementNode* node );
|
||||
Value* evaluate( Context& cx, ImportDefinitionNode* node );
|
||||
Value* evaluate( Context& cx, ImportBindingNode* node );
|
||||
Value* evaluate( Context& cx, AttributeListNode* node );
|
||||
Value* evaluate( Context& cx, ExportDefinitionNode* node );
|
||||
Value* evaluate( Context& cx, ExportBindingNode* node );
|
||||
Value* evaluate( Context& cx, TypedVariableNode* node );
|
||||
Value* evaluate( Context& cx, OptionalParameterNode* node );
|
||||
Value* evaluate( Context& cx, ClassDefinitionNode* node );
|
||||
Value* evaluate( Context& cx, ClassDeclarationNode* node );
|
||||
Value* evaluate( Context& cx, InheritanceNode* node );
|
||||
Value* evaluate( Context& cx, NamespaceDefinitionNode* node );
|
||||
Value* evaluate( Context& cx, PackageDefinitionNode* node );
|
||||
};
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
#endif // JSILGenerator_h
|
||||
|
||||
/*
|
||||
* Copyright (c) 1998-2001 by Mountain View Compiler Company
|
||||
* All rights reserved.
|
||||
*/
|
||||
@@ -1,28 +0,0 @@
|
||||
include $(top_srcdir)/common.mk
|
||||
|
||||
noinst_LIBRARIES = libjs2.a
|
||||
|
||||
libjs2_a_DEPENDENCIES = $(LIBFDLIBM)
|
||||
|
||||
libjs2_a_SOURCES = \
|
||||
bytecodegen.cpp \
|
||||
collector.cpp \
|
||||
exception.cpp \
|
||||
formatter.cpp \
|
||||
fdlibm_ns.cpp \
|
||||
hash.cpp \
|
||||
js2runtime.cpp \
|
||||
js2execution.cpp \
|
||||
jsarray.cpp \
|
||||
jsmath.cpp \
|
||||
jsstring.cpp \
|
||||
lexer.cpp \
|
||||
mem.cpp \
|
||||
numerics.cpp \
|
||||
parser.cpp \
|
||||
reader.cpp \
|
||||
strings.cpp \
|
||||
tracer.cpp \
|
||||
token.cpp \
|
||||
utilities.cpp \
|
||||
world.cpp
|
||||
@@ -1,65 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifndef algo_h___
|
||||
#define algo_h___
|
||||
|
||||
namespace JavaScript
|
||||
{
|
||||
//
|
||||
// Algorithms
|
||||
//
|
||||
|
||||
// Assign zero to every element between first inclusive and last exclusive.
|
||||
// This is equivalent ot fill(first, last, 0) but may be more efficient.
|
||||
template<class ForwardIterator>
|
||||
inline void zero(ForwardIterator first, ForwardIterator last)
|
||||
{
|
||||
while (first != last) {
|
||||
*first = 0;
|
||||
++first;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
// Same as find(first, last, value) but may be more efficient because
|
||||
// it doesn't use a reference for value.
|
||||
template<class InputIterator, class T>
|
||||
inline InputIterator findValue(InputIterator first, InputIterator last, T value)
|
||||
{
|
||||
while (first != last && !(*first == value))
|
||||
++first;
|
||||
return first;
|
||||
}
|
||||
}
|
||||
#endif /* algo_h___ */
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,396 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifndef bytecodegen_h___
|
||||
#define bytecodegen_h___
|
||||
|
||||
#ifdef _WIN32
|
||||
// Turn off warnings about identifiers too long in browser information
|
||||
#pragma warning(disable: 4786)
|
||||
#endif
|
||||
|
||||
|
||||
#include <vector>
|
||||
#include <map>
|
||||
|
||||
#include "systemtypes.h"
|
||||
#include "strings.h"
|
||||
|
||||
#include "tracer.h"
|
||||
|
||||
namespace JavaScript {
|
||||
namespace JS2Runtime {
|
||||
|
||||
typedef enum {
|
||||
// 1st 2 bits specify what kind of 'this' exists
|
||||
NoThis = 0x00,
|
||||
Inherent = 0x01,
|
||||
Explicit = 0x02,
|
||||
ThisFlags = 0x03,
|
||||
|
||||
// bit #3 indicates presence of named arguments
|
||||
NamedArguments = 0x04,
|
||||
|
||||
// but #4 is set for the invocation of the super constructor
|
||||
// from inside a constructor
|
||||
SuperInvoke = 0x08
|
||||
|
||||
} CallFlag;
|
||||
|
||||
typedef enum {
|
||||
|
||||
LoadConstantUndefinedOp,// --> <undefined value object>
|
||||
LoadConstantTrueOp, // --> <true value object>
|
||||
LoadConstantFalseOp, // --> <false value object>
|
||||
LoadConstantNullOp, // --> <null value object>
|
||||
LoadConstantZeroOp, // --> <+0.0 value object>
|
||||
LoadConstantNumberOp, // <poolindex> --> <Number value object>
|
||||
LoadConstantStringOp, // <poolindex> --> <String value object>
|
||||
LoadThisOp, // --> <this object>
|
||||
LoadFunctionOp, // <pointer> XXX !!! XXX
|
||||
LoadTypeOp, // <pointer> XXX !!! XXX
|
||||
InvokeOp, // <argc> <thisflag> <function> <args> --> [<result>]
|
||||
GetTypeOp, // <object> --> <type of object>
|
||||
CastOp, // <object> <type> --> <object>
|
||||
DoUnaryOp, // <operation> <object> --> <result>
|
||||
DoOperatorOp, // <operation> <object> <object> --> <result>
|
||||
PushNullOp, // --> <Object(null)>
|
||||
PushIntOp, // <int> --> <Object(int)>
|
||||
PushNumOp, // <num> --> <Object(num)>
|
||||
PushStringOp, // <poolindex> --> <Object(index)>
|
||||
PushTypeOp, // <poolindex>
|
||||
ReturnOp, // <function> <args> <result> --> <result>
|
||||
ReturnVoidOp, // <function> <args> -->
|
||||
GetConstructorOp, // <type> --> <function>
|
||||
NewObjectOp, // --> <object>
|
||||
NewThisOp, // <type> -->
|
||||
NewInstanceOp, // <argc> <type> <args> --> <object>
|
||||
DeleteOp, // <index> <object> --> <boolean>
|
||||
TypeOfOp, // <object> --> <string>
|
||||
InstanceOfOp, // <object> <object> --> <boolean>
|
||||
AsOp, // <object> <type> --> <object>
|
||||
IsOp, // <object> <object> --> <boolean>
|
||||
ToBooleanOp, // <object> --> <boolean>
|
||||
JumpFalseOp, // <target> <object> -->
|
||||
JumpTrueOp, // <target> <object> -->
|
||||
JumpOp, // <target>
|
||||
TryOp, // <handler> <handler>
|
||||
JsrOp, // <target>
|
||||
RtsOp,
|
||||
WithinOp, // <object> -->
|
||||
WithoutOp, //
|
||||
ThrowOp, // <whatever> <object> --> <object>
|
||||
HandlerOp,
|
||||
LogicalXorOp, // <object> <object> <boolean> <boolean> --> <object>
|
||||
LogicalNotOp, // <object> --> <object>
|
||||
SwapOp, // <object1> <object2> --> <object2> <object1>
|
||||
DupOp, // <object> --> <object> <object>
|
||||
DupInsertOp, // <object1> <object2> --> <object2> <object1> <object2>
|
||||
DupNOp, // <N> <object> --> <object> { N times }
|
||||
DupInsertNOp, // <N> <object> {xN} <object2> --> <object2> <object> {xN} <object2>
|
||||
PopOp, // <object> -->
|
||||
// for instance members
|
||||
GetFieldOp, // <slot> <base> --> <object>
|
||||
SetFieldOp, // <slot> <base> <object> --> <object>
|
||||
// for instance methods
|
||||
GetMethodOp, // <slot> <base> --> <base> <function>
|
||||
GetMethodRefOp, // <slot> <base> --> <bound function>
|
||||
// for argumentz
|
||||
GetArgOp, // <index> --> <object>
|
||||
SetArgOp, // <index> <object> --> <object>
|
||||
// for local variables in the immediate scope
|
||||
GetLocalVarOp, // <index> --> <object>
|
||||
SetLocalVarOp, // <index> <object> --> <object>
|
||||
// for local variables in the nth closure scope
|
||||
GetClosureVarOp, // <depth>, <index> --> <object>
|
||||
SetClosureVarOp, // <depth>, <index> <object> --> <object>
|
||||
// for array elements
|
||||
GetElementOp, // <base> <index> --> <object>
|
||||
SetElementOp, // <base> <index> <object> --> <object>
|
||||
// for properties
|
||||
GetPropertyOp, // <poolindex> <base> --> <object>
|
||||
GetInvokePropertyOp, // <poolindex> <base> --> <base> <object>
|
||||
SetPropertyOp, // <poolindex> <base> <object> --> <object>
|
||||
// for all generic names
|
||||
GetNameOp, // <poolindex> --> <object>
|
||||
GetTypeOfNameOp, // <poolindex> --> <object>
|
||||
SetNameOp, // <poolindex> <object> --> <object>
|
||||
LoadGlobalObjectOp, // --> <object>
|
||||
PushScopeOp, // <pointer> XXX !!! XXX
|
||||
PopScopeOp, // <pointer> XXX !!! XXX
|
||||
NewClosureOp, // <function> --> <function>
|
||||
ClassOp, // <object> --> <type>
|
||||
JuxtaposeOp, // <attribute> <attribute> --> <attribute>
|
||||
NamedArgOp, // <object> <string> --> <named arg object>
|
||||
|
||||
OpCodeCount
|
||||
|
||||
} ByteCodeOp;
|
||||
|
||||
struct ByteCodeData {
|
||||
int8 stackImpact;
|
||||
char *opName;
|
||||
};
|
||||
extern ByteCodeData gByteCodeData[OpCodeCount];
|
||||
|
||||
typedef std::pair<uint32, size_t> PC_Position;
|
||||
|
||||
|
||||
class ByteCodeModule {
|
||||
public:
|
||||
|
||||
ByteCodeModule(ByteCodeGen *bcg);
|
||||
|
||||
#ifdef DEBUG
|
||||
void* operator new(size_t s) { void *t = STD::malloc(s); trace_alloc("ByteCodeModule", s, t); return t; }
|
||||
void operator delete(void* t) { trace_release("ByteCodeModule", t); STD::free(t); }
|
||||
#endif
|
||||
|
||||
uint32 getLong(uint32 index) const { return *((uint32 *)&mCodeBase[index]); }
|
||||
uint16 getShort(uint32 index) const { return *((uint16 *)&mCodeBase[index]); }
|
||||
int32 getOffset(uint32 index) const { return *((int32 *)&mCodeBase[index]); }
|
||||
const String *getString(uint32 index) const { return &mStringPoolContents[index]; }
|
||||
float64 getNumber(uint32 index) const { return mNumberPoolContents[index]; }
|
||||
|
||||
void setSource(const String &source, const String &sourceLocation)
|
||||
{
|
||||
mSource = source;
|
||||
mSourceLocation = sourceLocation;
|
||||
}
|
||||
|
||||
String mSource;
|
||||
String mSourceLocation;
|
||||
|
||||
uint32 mLocalsCount; // number of local vars to allocate space for
|
||||
uint32 mStackDepth; // max. depth of execution stack
|
||||
|
||||
uint8 *mCodeBase;
|
||||
uint32 mLength;
|
||||
|
||||
String *mStringPoolContents;
|
||||
float64 *mNumberPoolContents;
|
||||
|
||||
PC_Position *mCodeMap;
|
||||
uint32 mCodeMapLength;
|
||||
|
||||
size_t getPositionForPC(uint32 pc);
|
||||
|
||||
};
|
||||
Formatter& operator<<(Formatter& f, const ByteCodeModule& bcm);
|
||||
|
||||
#define BufferIncrement (32)
|
||||
|
||||
#define NotALabel ((uint32)(-1))
|
||||
|
||||
class Label {
|
||||
public:
|
||||
|
||||
typedef enum { InternalLabel, NamedLabel, BreakLabel, ContinueLabel } LabelKind;
|
||||
|
||||
Label() : mKind(InternalLabel), mHasLocation(false) { }
|
||||
Label(LabelStmtNode *lbl) : mKind(NamedLabel), mHasLocation(false), mLabelStmt(lbl) { }
|
||||
Label(LabelKind kind) : mKind(kind), mHasLocation(false) { }
|
||||
|
||||
bool matches(const StringAtom *name)
|
||||
{
|
||||
return ((mKind == NamedLabel) && (mLabelStmt->name.compare(*name) == 0));
|
||||
}
|
||||
|
||||
bool matches(LabelKind kind)
|
||||
{
|
||||
return (mKind == kind);
|
||||
}
|
||||
|
||||
void addFixup(ByteCodeGen *bcg, uint32 branchLocation);
|
||||
void setLocation(ByteCodeGen *bcg, uint32 location);
|
||||
|
||||
std::vector<uint32> mFixupList;
|
||||
|
||||
LabelKind mKind;
|
||||
bool mHasLocation;
|
||||
LabelStmtNode *mLabelStmt;
|
||||
|
||||
uint32 mLocation;
|
||||
};
|
||||
|
||||
class ByteCodeGen {
|
||||
public:
|
||||
|
||||
ByteCodeGen(Context *cx, ScopeChain *scopeChain)
|
||||
: mBuffer(new CodeBuffer),
|
||||
mScopeChain(scopeChain),
|
||||
mPC_Map(new CodeMap),
|
||||
m_cx(cx),
|
||||
mNamespaceList(NULL) ,
|
||||
mStackTop(0),
|
||||
mStackMax(0)
|
||||
{ }
|
||||
|
||||
#ifdef DEBUG
|
||||
void* operator new(size_t s) { void *t = STD::malloc(s); trace_alloc("ByteCodeGen", s, t); return t; }
|
||||
void operator delete(void* t) { trace_release("ByteCodeGen", t); STD::free(t); }
|
||||
#endif
|
||||
|
||||
ByteCodeModule *genCodeForScript(StmtNode *p);
|
||||
bool genCodeForStatement(StmtNode *p, ByteCodeGen *static_cg, uint32 finallyLabel);
|
||||
void genCodeForFunction(FunctionDefinition &f,
|
||||
size_t pos,
|
||||
JSFunction *fnc,
|
||||
bool isConstructor,
|
||||
JSType *topClass);
|
||||
ByteCodeModule *genCodeForExpression(ExprNode *p);
|
||||
|
||||
JSType *genExpr(ExprNode *p);
|
||||
Reference *genReference(ExprNode *p, Access acc);
|
||||
void genReferencePair(ExprNode *p, Reference *&readRef, Reference *&writeRef);
|
||||
|
||||
typedef std::vector<uint8> CodeBuffer;
|
||||
|
||||
typedef std::vector<PC_Position> CodeMap;
|
||||
|
||||
// this is the current code buffer
|
||||
CodeBuffer *mBuffer;
|
||||
ScopeChain *mScopeChain;
|
||||
CodeMap *mPC_Map;
|
||||
|
||||
Context *m_cx;
|
||||
|
||||
std::vector<Label> mLabelList;
|
||||
std::vector<uint32> mLabelStack;
|
||||
|
||||
NamespaceList *mNamespaceList;
|
||||
|
||||
int32 mStackTop; // keep these as signed so as to
|
||||
int32 mStackMax; // track if they go negative.
|
||||
|
||||
bool hasContent()
|
||||
{
|
||||
return (mBuffer->size() > 0);
|
||||
}
|
||||
|
||||
void addOp(uint8 op); // XXX move more outline if it helps to reduce overall .exe size
|
||||
|
||||
void addPosition(size_t pos) { mPC_Map->push_back(PC_Position(mBuffer->size(), pos)); }
|
||||
|
||||
// Add in the opcode effect as usual, but also stretch the
|
||||
// execution stack by N, as the opcode has that effect during
|
||||
// execution.
|
||||
void addOpStretchStack(uint8 op, int32 n)
|
||||
{
|
||||
addByte(op);
|
||||
mStackTop += gByteCodeData[op].stackImpact;
|
||||
if ((mStackTop + n) > mStackMax)
|
||||
mStackMax = mStackTop + n;
|
||||
ASSERT(mStackTop >= 0);
|
||||
}
|
||||
|
||||
void adjustStack(int32 n)
|
||||
{
|
||||
mStackTop += n;
|
||||
if ((mStackTop + n) > mStackMax)
|
||||
mStackMax = mStackTop + n;
|
||||
ASSERT(mStackTop >= 0);
|
||||
}
|
||||
|
||||
// Make sure there's room for n more operands on the stack
|
||||
void stretchStack(int32 n)
|
||||
{
|
||||
if ((mStackTop + n) > mStackMax)
|
||||
mStackMax = mStackTop + n;
|
||||
}
|
||||
|
||||
// these routines assume the depth is being reduced
|
||||
// i.e. they don't reset mStackMax
|
||||
void addOpAdjustDepth(uint8 op, int32 depth)
|
||||
{ addByte(op); mStackTop += depth; ASSERT(mStackTop >= 0); }
|
||||
void addOpSetDepth(uint8 op, int32 depth)
|
||||
{ addByte(op); mStackTop = depth; ASSERT(mStackTop >= 0); }
|
||||
|
||||
void addByte(uint8 v) { mBuffer->push_back(v); }
|
||||
void addShort(uint16 v) { mBuffer->push_back((uint8)(v >> 8)); mBuffer->push_back((uint8)(v)); }
|
||||
|
||||
void addPointer(void *v) { ASSERT(sizeof(void *) == sizeof(uint32)); addLong((uint32)(v)); } // XXX Pointer size dependant !!!
|
||||
|
||||
void addLong(uint32 v)
|
||||
{ mBuffer->insert(mBuffer->end(), (uint8 *)&v, (uint8 *)(&v) + sizeof(uint32)); }
|
||||
void addOffset(int32 v)
|
||||
{ mBuffer->insert(mBuffer->end(), (uint8 *)&v, (uint8 *)(&v) + sizeof(int32)); }
|
||||
void setOffset(uint32 index, int32 v)
|
||||
{ *((int32 *)(mBuffer->begin() + index)) = v; } // XXX
|
||||
|
||||
void addFixup(uint32 label)
|
||||
{
|
||||
mLabelList[label].addFixup(this, mBuffer->size());
|
||||
}
|
||||
|
||||
uint32 getLabel();
|
||||
|
||||
uint32 getLabel(Label::LabelKind kind);
|
||||
|
||||
uint32 getLabel(LabelStmtNode *lbl);
|
||||
|
||||
uint32 getTopLabel(Label::LabelKind kind, const StringAtom *name);
|
||||
|
||||
uint32 getTopLabel(Label::LabelKind kind);
|
||||
|
||||
void setLabel(uint32 label)
|
||||
{
|
||||
mLabelList[label].setLocation(this, mBuffer->size());
|
||||
}
|
||||
|
||||
uint32 currentOffset()
|
||||
{
|
||||
return mBuffer->size();
|
||||
}
|
||||
|
||||
std::vector<String> mStringPoolContents;
|
||||
typedef std::map<String, uint32, std::less<String> > StringPool;
|
||||
StringPool mStringPool;
|
||||
|
||||
std::vector<float64> mNumberPoolContents;
|
||||
typedef std::map<float64, uint32, std::less<double> > NumberPool;
|
||||
NumberPool mNumberPool;
|
||||
|
||||
|
||||
void addNumberRef(float64 f);
|
||||
|
||||
void addStringRef(const String &str);
|
||||
|
||||
|
||||
};
|
||||
|
||||
|
||||
uint32 printInstruction(Formatter &f, uint32 i, const ByteCodeModule& bcm);
|
||||
}
|
||||
}
|
||||
#endif /* bytecodegen_h___ */
|
||||
@@ -1,240 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s): Patrick Beard <beard@netscape.com>
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#include "collector.h"
|
||||
|
||||
namespace JavaScript
|
||||
{
|
||||
|
||||
Collector::Collector()
|
||||
: mObjectSpace(kObjectSpaceSize),
|
||||
mFloatSpace(kFloatSpaceSize)
|
||||
{
|
||||
}
|
||||
|
||||
Collector::~Collector()
|
||||
{
|
||||
}
|
||||
|
||||
void
|
||||
Collector::addRoot(void* root, size_type n)
|
||||
{
|
||||
mRoots.push_back(RootSegment(pointer(root), n));
|
||||
}
|
||||
|
||||
void
|
||||
Collector::removeRoot(void* root)
|
||||
{
|
||||
for (RootSegments::iterator i = mRoots.begin(), e = mRoots.end(); i != e; ++i) {
|
||||
if (i->first == root) {
|
||||
mRoots.erase(i);
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
inline Collector::size_type align(Collector::size_type n)
|
||||
{
|
||||
return (n + (kObjectAlignment - 1)) & kObjectAddressMask;
|
||||
}
|
||||
|
||||
Collector::pointer
|
||||
Collector::allocateObject(size_type n, pointer type)
|
||||
{
|
||||
size_type size = align(n + sizeof(ObjectHeader));
|
||||
pointer ptr = mObjectSpace.mAllocPtr;
|
||||
if ((ptr + size) <= mObjectSpace.mLimitPtr) {
|
||||
mObjectSpace.mAllocPtr += size;
|
||||
ObjectHeader* header = (ObjectHeader*) ptr;
|
||||
header->mSize = size;
|
||||
header->mType = type;
|
||||
return (pointer) std::memset(ptr + sizeof(ObjectHeader), 0, n);
|
||||
}
|
||||
// need to run a garbage collection to recover more space, or double space size?
|
||||
return 0;
|
||||
}
|
||||
|
||||
float64*
|
||||
Collector::allocateFloat64(float64 value)
|
||||
{
|
||||
float64* fptr = mFloatSpace.mAllocPtr;
|
||||
if (fptr < mFloatSpace.mLimitPtr) {
|
||||
mFloatSpace.mAllocPtr++;
|
||||
*fptr = value;
|
||||
return (float64*) (uint32(fptr) | kFloat64Tag);
|
||||
}
|
||||
// need to run a garbage collection to recover more space, or double space size?
|
||||
return 0;
|
||||
}
|
||||
|
||||
inline bool is_object(Collector::pointer ref)
|
||||
{
|
||||
return ((uint32(ref) & kObjectAddressMask) == uint32(ref));
|
||||
}
|
||||
|
||||
inline bool is_float64(Collector::pointer ref)
|
||||
{
|
||||
return ((uint32(ref) & kFloat64TagMask) == kFloat64Tag);
|
||||
}
|
||||
|
||||
void
|
||||
Collector::collect()
|
||||
{
|
||||
// 0. swap from/to space. we now start allocating in the new toSpace.
|
||||
Space<char>::pointer_type scanPtr = mObjectSpace.Swap();
|
||||
mFloatSpace.Swap();
|
||||
|
||||
// 1. scan all registered root segments.
|
||||
for (RootSegments::iterator i = mRoots.begin(), e = mRoots.end(); i != e; ++i) {
|
||||
RootSegment& r = *i;
|
||||
|
||||
pointer* refs = (pointer*) r.first;
|
||||
pointer* limit = (pointer*) (r.first + r.second);
|
||||
while (refs < limit) {
|
||||
pointer& ref = *refs++;
|
||||
if (ref) {
|
||||
if (is_object(ref))
|
||||
ref = copy(ref);
|
||||
else
|
||||
if (is_float64(ref))
|
||||
ref = copyFloat64(ref);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
// 2. Scan through toSpace until scanPtr meets mAllocPtr.
|
||||
while (scanPtr < mObjectSpace.mAllocPtr) {
|
||||
ObjectHeader* header = (ObjectHeader*) scanPtr;
|
||||
if (header->mType)
|
||||
header->mType = copy(header->mType);
|
||||
scanPtr += header->mSize;
|
||||
pointer* refs = (pointer*) (header + 1);
|
||||
pointer* limit = (pointer*) scanPtr;
|
||||
while (refs < limit) {
|
||||
pointer& ref = *refs++;
|
||||
if (ref) {
|
||||
if (is_object(ref))
|
||||
ref = copy(ref);
|
||||
else
|
||||
if (is_float64(ref))
|
||||
ref = copyFloat64(ref);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
Collector::pointer
|
||||
Collector::copy(pointer object)
|
||||
{
|
||||
// forwarding pointer?
|
||||
ObjectHeader* oldHeader = ((ObjectHeader*)object) - 1;
|
||||
if (oldHeader->mSize == kIsForwardingPointer)
|
||||
return oldHeader->mType;
|
||||
|
||||
// copy the old object into toSpace. copy will always succeed,
|
||||
// because we only call it from within collect. the problem
|
||||
// is when we don't recover any space... will have to be able
|
||||
// to expand the heaps.
|
||||
size_type n = oldHeader->mSize;
|
||||
ObjectHeader* newHeader = (ObjectHeader*) mObjectSpace.mAllocPtr;
|
||||
mObjectSpace.mAllocPtr += n;
|
||||
std::memcpy(newHeader, oldHeader, n);
|
||||
oldHeader->mSize = kIsForwardingPointer;
|
||||
oldHeader->mType = (pointer) (newHeader + 1);
|
||||
|
||||
return (pointer) (newHeader + 1);
|
||||
}
|
||||
|
||||
Collector::pointer
|
||||
Collector::copyFloat64(pointer object)
|
||||
{
|
||||
float64* fptr = mFloatSpace.mAllocPtr++;
|
||||
*fptr = *(float64*) (uint32(object) & kFloat64AddressMask);
|
||||
return (pointer) (uint32(fptr) | kFloat64Tag);
|
||||
}
|
||||
|
||||
#if DEBUG
|
||||
|
||||
struct ConsCell {
|
||||
float64* car;
|
||||
ConsCell* cdr;
|
||||
|
||||
void* operator new(std::size_t n, Collector& gc)
|
||||
{
|
||||
return gc.allocateObject(n);
|
||||
}
|
||||
};
|
||||
|
||||
void testCollector()
|
||||
{
|
||||
Collector gc;
|
||||
|
||||
ConsCell* head = 0;
|
||||
gc.addRoot(&head, sizeof(ConsCell*));
|
||||
|
||||
const uint32 kCellCount = 100;
|
||||
|
||||
ConsCell* cell;
|
||||
ConsCell** link = &head;
|
||||
|
||||
for (uint32 i = 0; i < kCellCount; ++i) {
|
||||
*link = cell = new (gc) ConsCell;
|
||||
ASSERT(cell);
|
||||
cell->car = gc.allocateFloat64(i);
|
||||
ASSERT(cell->car);
|
||||
link = &cell->cdr;
|
||||
}
|
||||
|
||||
// circularly link the list.
|
||||
*link = head;
|
||||
|
||||
// run a garbage collection.
|
||||
gc.collect();
|
||||
|
||||
// walk the list again to verify that it is intact.
|
||||
link = &head;
|
||||
for (uint32 i = 0; i < kCellCount; i++) {
|
||||
cell = *link;
|
||||
ASSERT(cell->car);
|
||||
float64 value = gc.getFloat64(cell->car);
|
||||
ASSERT(value == (float64)i);
|
||||
link = &cell->cdr;
|
||||
}
|
||||
|
||||
// make sure list is still circularly linked.
|
||||
ASSERT(*link == head);
|
||||
}
|
||||
|
||||
#endif // DEBUG
|
||||
|
||||
}
|
||||
@@ -1,156 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s): Patrick Beard <beard@netscape.com>
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifndef collector_h___
|
||||
#define collector_h___
|
||||
|
||||
#include "mem.h"
|
||||
#include <deque>
|
||||
#include <utility>
|
||||
|
||||
namespace JavaScript
|
||||
{
|
||||
using std::deque;
|
||||
using std::pair;
|
||||
|
||||
// tuneable parameters of the collector.
|
||||
enum {
|
||||
kLogObjectAlignment = 3,
|
||||
kObjectAlignment = (1 << kLogObjectAlignment),
|
||||
kObjectAddressMask = (-1 << kLogObjectAlignment),
|
||||
|
||||
kFloat64Tag = 0x2,
|
||||
kFloat64TagMask = ~(-1 << 2),
|
||||
kFloat64AddressMask = (-1 << 2),
|
||||
|
||||
kIsForwardingPointer = 0x1,
|
||||
|
||||
kObjectSpaceSize = 1024 * 1024,
|
||||
kFloatSpaceSize = kObjectSpaceSize / sizeof(float64)
|
||||
};
|
||||
|
||||
// collector entry points.
|
||||
class Collector {
|
||||
public:
|
||||
typedef size_t size_type;
|
||||
typedef ptrdiff_t difference_type;
|
||||
typedef char *pointer;
|
||||
typedef const char *const_pointer;
|
||||
|
||||
struct ObjectHeader {
|
||||
size_type mSize;
|
||||
pointer mType;
|
||||
};
|
||||
|
||||
Collector();
|
||||
~Collector();
|
||||
|
||||
void addRoot(void* root, size_type n);
|
||||
void removeRoot(void* root);
|
||||
|
||||
pointer allocateObject(size_type n, pointer type = 0);
|
||||
float64* allocateFloat64(float64 value = 0.0);
|
||||
|
||||
void collect();
|
||||
|
||||
pointer getType(pointer object)
|
||||
{
|
||||
return ((ObjectHeader*)object)[-1].mType;
|
||||
}
|
||||
|
||||
size_type getSize(pointer object)
|
||||
{
|
||||
return ((ObjectHeader*)object)[-1].mSize;
|
||||
}
|
||||
|
||||
float64 getFloat64(float64* fptr)
|
||||
{
|
||||
return *(float64*)(uint32(fptr) & kFloat64AddressMask);
|
||||
}
|
||||
|
||||
private:
|
||||
template <typename T> struct Space {
|
||||
typedef T value_type;
|
||||
typedef T *pointer_type;
|
||||
size_type mSize;
|
||||
pointer_type mFromPtr;
|
||||
pointer_type mToPtr;
|
||||
pointer_type mAllocPtr;
|
||||
pointer_type mLimitPtr;
|
||||
|
||||
Space(size_type n)
|
||||
: mSize(n), mFromPtr(0), mToPtr(0),
|
||||
mAllocPtr(0), mLimitPtr(0)
|
||||
{
|
||||
mFromPtr = new value_type[n];
|
||||
mToPtr = new value_type[n];
|
||||
mAllocPtr = mToPtr;
|
||||
mLimitPtr = mToPtr + n;
|
||||
}
|
||||
|
||||
~Space()
|
||||
{
|
||||
delete[] mFromPtr;
|
||||
delete[] mToPtr;
|
||||
}
|
||||
|
||||
pointer_type Swap()
|
||||
{
|
||||
pointer_type newToPtr = mFromPtr;
|
||||
pointer_type newFromPtr = mToPtr;
|
||||
mToPtr = newToPtr;
|
||||
mAllocPtr = newToPtr;
|
||||
mLimitPtr = newToPtr + mSize;
|
||||
mFromPtr = newFromPtr;
|
||||
pointer_type scanPtr = newToPtr;
|
||||
return scanPtr;
|
||||
}
|
||||
};
|
||||
Space<char> mObjectSpace;
|
||||
Space<float64> mFloatSpace;
|
||||
|
||||
typedef pair<pointer, size_type> RootSegment;
|
||||
typedef deque<RootSegment> RootSegments;
|
||||
RootSegments mRoots;
|
||||
|
||||
pointer copy(pointer object);
|
||||
pointer copyFloat64(pointer object);
|
||||
|
||||
Collector(const Collector&); // No copy constructor
|
||||
void operator=(const Collector&); // No assignment operator
|
||||
};
|
||||
|
||||
void testCollector();
|
||||
}
|
||||
|
||||
#endif // collector_h___
|
||||
@@ -1,191 +0,0 @@
|
||||
/* -*- Mode: C; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is Mozilla Communicator client code, released
|
||||
* March 31, 1998.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifndef cpucfg_h
|
||||
#define cpucfg_h
|
||||
|
||||
#define JS_HAVE_LONG_LONG
|
||||
|
||||
#ifdef XP_MAC
|
||||
#undef IS_LITTLE_ENDIAN
|
||||
#define IS_BIG_ENDIAN 1
|
||||
|
||||
#define JS_BYTES_PER_BYTE 1L
|
||||
#define JS_BYTES_PER_SHORT 2L
|
||||
#define JS_BYTES_PER_INT 4L
|
||||
#define JS_BYTES_PER_INT64 8L
|
||||
#define JS_BYTES_PER_LONG 4L
|
||||
#define JS_BYTES_PER_FLOAT 4L
|
||||
#define JS_BYTES_PER_DOUBLE 8L
|
||||
#define JS_BYTES_PER_WORD 4L
|
||||
#define JS_BYTES_PER_DWORD 8L
|
||||
|
||||
#define JS_BITS_PER_BYTE 8L
|
||||
#define JS_BITS_PER_SHORT 16L
|
||||
#define JS_BITS_PER_INT 32L
|
||||
#define JS_BITS_PER_INT64 64L
|
||||
#define JS_BITS_PER_LONG 32L
|
||||
#define JS_BITS_PER_FLOAT 32L
|
||||
#define JS_BITS_PER_DOUBLE 64L
|
||||
#define JS_BITS_PER_WORD 32L
|
||||
|
||||
#define JS_BITS_PER_BYTE_LOG2 3L
|
||||
#define JS_BITS_PER_SHORT_LOG2 4L
|
||||
#define JS_BITS_PER_INT_LOG2 5L
|
||||
#define JS_BITS_PER_INT64_LOG2 6L
|
||||
#define JS_BITS_PER_LONG_LOG2 5L
|
||||
#define JS_BITS_PER_FLOAT_LOG2 5L
|
||||
#define JS_BITS_PER_DOUBLE_LOG2 6L
|
||||
#define JS_BITS_PER_WORD_LOG2 5L
|
||||
|
||||
#define JS_ALIGN_OF_SHORT 2L
|
||||
#define JS_ALIGN_OF_INT 4L
|
||||
#define JS_ALIGN_OF_LONG 4L
|
||||
#define JS_ALIGN_OF_INT64 2L
|
||||
#define JS_ALIGN_OF_FLOAT 4L
|
||||
#define JS_ALIGN_OF_DOUBLE 4L
|
||||
#define JS_ALIGN_OF_POINTER 4L
|
||||
#define JS_ALIGN_OF_WORD 4L
|
||||
|
||||
#define JS_BYTES_PER_WORD_LOG2 2L
|
||||
#define JS_BYTES_PER_DWORD_LOG2 3L
|
||||
#define PR_WORDS_PER_DWORD_LOG2 1L
|
||||
|
||||
#elif defined(XP_PC)
|
||||
|
||||
#ifdef _WIN32
|
||||
#define IS_LITTLE_ENDIAN 1
|
||||
#undef IS_BIG_ENDIAN
|
||||
|
||||
#define JS_BYTES_PER_BYTE 1L
|
||||
#define JS_BYTES_PER_SHORT 2L
|
||||
#define JS_BYTES_PER_INT 4L
|
||||
#define JS_BYTES_PER_INT64 8L
|
||||
#define JS_BYTES_PER_LONG 4L
|
||||
#define JS_BYTES_PER_FLOAT 4L
|
||||
#define JS_BYTES_PER_DOUBLE 8L
|
||||
#define JS_BYTES_PER_WORD 4L
|
||||
#define JS_BYTES_PER_DWORD 8L
|
||||
|
||||
#define JS_BITS_PER_BYTE 8L
|
||||
#define JS_BITS_PER_SHORT 16L
|
||||
#define JS_BITS_PER_INT 32L
|
||||
#define JS_BITS_PER_INT64 64L
|
||||
#define JS_BITS_PER_LONG 32L
|
||||
#define JS_BITS_PER_FLOAT 32L
|
||||
#define JS_BITS_PER_DOUBLE 64L
|
||||
#define JS_BITS_PER_WORD 32L
|
||||
|
||||
#define JS_BITS_PER_BYTE_LOG2 3L
|
||||
#define JS_BITS_PER_SHORT_LOG2 4L
|
||||
#define JS_BITS_PER_INT_LOG2 5L
|
||||
#define JS_BITS_PER_INT64_LOG2 6L
|
||||
#define JS_BITS_PER_LONG_LOG2 5L
|
||||
#define JS_BITS_PER_FLOAT_LOG2 5L
|
||||
#define JS_BITS_PER_DOUBLE_LOG2 6L
|
||||
#define JS_BITS_PER_WORD_LOG2 5L
|
||||
|
||||
#define JS_ALIGN_OF_SHORT 2L
|
||||
#define JS_ALIGN_OF_INT 4L
|
||||
#define JS_ALIGN_OF_LONG 4L
|
||||
#define JS_ALIGN_OF_INT64 8L
|
||||
#define JS_ALIGN_OF_FLOAT 4L
|
||||
#define JS_ALIGN_OF_DOUBLE 4L
|
||||
#define JS_ALIGN_OF_POINTER 4L
|
||||
#define JS_ALIGN_OF_WORD 4L
|
||||
|
||||
#define JS_BYTES_PER_WORD_LOG2 2L
|
||||
#define JS_BYTES_PER_DWORD_LOG2 3L
|
||||
#define PR_WORDS_PER_DWORD_LOG2 1L
|
||||
#endif /* _WIN32 */
|
||||
|
||||
#if defined(_WINDOWS) && !defined(_WIN32) /* WIN16 */
|
||||
#define IS_LITTLE_ENDIAN 1
|
||||
#undef IS_BIG_ENDIAN
|
||||
|
||||
#define JS_BYTES_PER_BYTE 1L
|
||||
#define JS_BYTES_PER_SHORT 2L
|
||||
#define JS_BYTES_PER_INT 2L
|
||||
#define JS_BYTES_PER_INT64 8L
|
||||
#define JS_BYTES_PER_LONG 4L
|
||||
#define JS_BYTES_PER_FLOAT 4L
|
||||
#define JS_BYTES_PER_DOUBLE 8L
|
||||
#define JS_BYTES_PER_WORD 4L
|
||||
#define JS_BYTES_PER_DWORD 8L
|
||||
|
||||
#define JS_BITS_PER_BYTE 8L
|
||||
#define JS_BITS_PER_SHORT 16L
|
||||
#define JS_BITS_PER_INT 16L
|
||||
#define JS_BITS_PER_INT64 64L
|
||||
#define JS_BITS_PER_LONG 32L
|
||||
#define JS_BITS_PER_FLOAT 32L
|
||||
#define JS_BITS_PER_DOUBLE 64L
|
||||
#define JS_BITS_PER_WORD 32L
|
||||
|
||||
#define JS_BITS_PER_BYTE_LOG2 3L
|
||||
#define JS_BITS_PER_SHORT_LOG2 4L
|
||||
#define JS_BITS_PER_INT_LOG2 4L
|
||||
#define JS_BITS_PER_INT64_LOG2 6L
|
||||
#define JS_BITS_PER_LONG_LOG2 5L
|
||||
#define JS_BITS_PER_FLOAT_LOG2 5L
|
||||
#define JS_BITS_PER_DOUBLE_LOG2 6L
|
||||
#define JS_BITS_PER_WORD_LOG2 5L
|
||||
|
||||
#define JS_ALIGN_OF_SHORT 2L
|
||||
#define JS_ALIGN_OF_INT 2L
|
||||
#define JS_ALIGN_OF_LONG 2L
|
||||
#define JS_ALIGN_OF_INT64 2L
|
||||
#define JS_ALIGN_OF_FLOAT 2L
|
||||
#define JS_ALIGN_OF_DOUBLE 2L
|
||||
#define JS_ALIGN_OF_POINTER 2L
|
||||
#define JS_ALIGN_OF_WORD 2L
|
||||
|
||||
#define JS_BYTES_PER_WORD_LOG2 2L
|
||||
#define JS_BYTES_PER_DWORD_LOG2 3L
|
||||
#define PR_WORDS_PER_DWORD_LOG2 1L
|
||||
#endif /* defined(_WINDOWS) && !defined(_WIN32) */
|
||||
|
||||
#elif defined(XP_UNIX) || defined(XP_BEOS)
|
||||
|
||||
#error "This file is supposed to be auto-generated on UNIX platforms, but the"
|
||||
#error "static version for Mac and Windows platforms is being used."
|
||||
#error "Something's probably wrong with paths/headers/dependencies/Makefiles."
|
||||
|
||||
#else
|
||||
|
||||
#error "Must define one of XP_MAC, XP_PC, or XP_UNIX"
|
||||
|
||||
#endif
|
||||
|
||||
#endif
|
||||
@@ -1,472 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifdef _WIN32
|
||||
// Turn off warnings about identifiers too long in browser information
|
||||
#pragma warning(disable: 4786)
|
||||
#endif
|
||||
|
||||
#include "world.h"
|
||||
#include "utilities.h"
|
||||
#include "debugger.h"
|
||||
|
||||
#include <string>
|
||||
#include <ctype.h>
|
||||
#include <assert.h>
|
||||
|
||||
namespace JavaScript {
|
||||
namespace Debugger {
|
||||
|
||||
using namespace Interpreter;
|
||||
|
||||
/* keep in sync with list in debugger.h */
|
||||
static const char *shell_cmds[][3] = {
|
||||
{"assemble", "", 0},
|
||||
{"ambiguous", "", "Test command for ambiguous command detection"},
|
||||
{"ambiguous2", "", "Test command for ambiguous command detection"},
|
||||
{"continue", "", "Continue execution until complete."},
|
||||
{"dissassemble", "[start_pc] [end_pc]", "Dissassemble entire module, or subset of module."},
|
||||
{"exit", "", 0},
|
||||
{"help", "", "Display this message."},
|
||||
{"istep", "", "Execute the current opcode and stop."},
|
||||
{"let", "", "Set a debugger environment variable."},
|
||||
{"print", "", 0},
|
||||
{"register", "", "(nyi) Show the value of a single register or all registers, or set the value of a single register."},
|
||||
{"step", "", "Execute the current JS statement and stop."},
|
||||
{0, 0} /* sentry */
|
||||
};
|
||||
|
||||
enum ShellVariable {
|
||||
TRACE_SOURCE,
|
||||
TRACE_ICODE,
|
||||
VARIABLE_COUNT
|
||||
};
|
||||
|
||||
static const char *shell_vars[][3] = {
|
||||
{"tracesource", "", "(bool) Show JS source while executing."},
|
||||
{"traceicode", " ", "(bool) Show opcodes while executing."},
|
||||
{0, 0} /* sentry */
|
||||
};
|
||||
|
||||
/* return true if str2 starts with/is str1
|
||||
* XXX ignore case */
|
||||
static bool
|
||||
startsWith (const String &str1, const String &str2)
|
||||
{
|
||||
uint n;
|
||||
size_t m = str1.size();
|
||||
|
||||
if (m > str2.size())
|
||||
return false;
|
||||
|
||||
for (n = 0; n < m; ++n)
|
||||
if (str1[n] != str2[n])
|
||||
return false;
|
||||
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
/**
|
||||
* locate the best match for |partial| in the command list |list|.
|
||||
* if no matches are found, return |length|, if multiple matches are found,
|
||||
* return |length| plus the number of ambiguous matches
|
||||
*/
|
||||
static uint32
|
||||
matchElement (const String &partial, const char *list[][3], size_t length)
|
||||
{
|
||||
uint32 ambig_matches = 0;
|
||||
uint32 match = length;
|
||||
|
||||
for (uint32 i = 0; i < length ; ++i)
|
||||
{
|
||||
String possibleMatch (widenCString(list[i][0]));
|
||||
if (startsWith(partial, possibleMatch))
|
||||
{
|
||||
if (partial.size() == possibleMatch.size())
|
||||
{
|
||||
/* exact match */
|
||||
ambig_matches = 0;
|
||||
return i;
|
||||
}
|
||||
else if (match == COMMAND_COUNT) /* no match yet */
|
||||
match = i;
|
||||
else
|
||||
++ambig_matches; /* something already matched,
|
||||
* ambiguous command */
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
if (ambig_matches == 0)
|
||||
return match;
|
||||
else
|
||||
return length + ambig_matches;
|
||||
|
||||
}
|
||||
|
||||
static void
|
||||
showHelp(Formatter &out)
|
||||
{
|
||||
int i;
|
||||
|
||||
out << "JavaScript 2.0 Debugger Help...\n\n";
|
||||
|
||||
for (i = 0; shell_cmds[i][0] != 0; i++)
|
||||
{
|
||||
out << "Command : " << shell_cmds[i][0] << " " <<
|
||||
shell_cmds[i][1] << "\n";
|
||||
|
||||
if (shell_cmds[i][2])
|
||||
out << "Help : " << shell_cmds[i][2] << "\n";
|
||||
else
|
||||
out << "Help : (probably) Not Implemented.\n";
|
||||
}
|
||||
}
|
||||
|
||||
static uint32
|
||||
getClosestSourcePosForPC (Context *cx, InstructionIterator pc)
|
||||
{
|
||||
ICodeModule *iCode = cx->getICode();
|
||||
|
||||
if (iCode->mInstructionMap->begin() == iCode->mInstructionMap->end())
|
||||
return NotABanana;
|
||||
/*NOT_REACHED ("Instruction map is empty, waah.");*/
|
||||
|
||||
InstructionMap::iterator pos_iter =
|
||||
iCode->mInstructionMap->upper_bound (static_cast<uint32>(pc - iCode->its_iCode->begin()));
|
||||
if (pos_iter != iCode->mInstructionMap->begin())
|
||||
--pos_iter;
|
||||
|
||||
return pos_iter->second;
|
||||
}
|
||||
|
||||
void
|
||||
Shell::showSourceAtPC (Context *cx, InstructionIterator pc)
|
||||
{
|
||||
if (!mResolveFileCallback)
|
||||
{
|
||||
mErr << "Source not available (Debugger was improperly initialized.)\n";
|
||||
return;
|
||||
}
|
||||
|
||||
ICodeModule *iCode = cx->getICode();
|
||||
|
||||
String fn = iCode->getFileName();
|
||||
const Reader *reader = mResolveFileCallback(fn);
|
||||
if (!reader)
|
||||
{
|
||||
mErr << "Source not available.\n";
|
||||
return;
|
||||
}
|
||||
|
||||
uint32 pos = getClosestSourcePosForPC(cx, pc);
|
||||
if (pos == NotABanana)
|
||||
{
|
||||
mErr << "Map is empty, cannot display source.\n";
|
||||
return;
|
||||
}
|
||||
|
||||
uint32 lineNum = reader->posToLineNum (pos);
|
||||
const char16 *lineBegin, *lineEnd;
|
||||
|
||||
uint32 lineStartPos = reader->getLine (lineNum, lineBegin, lineEnd);
|
||||
String sourceLine (lineBegin, lineEnd);
|
||||
|
||||
mOut << fn << ":" << lineNum << " " << sourceLine << "\n";
|
||||
|
||||
uint padding = fn.length() + (uint32)(lineNum / 10) + 3;
|
||||
uint i;
|
||||
|
||||
for (i = 0; i < padding; i++)
|
||||
mOut << " ";
|
||||
|
||||
padding = (pos - lineStartPos);
|
||||
for (i = 0; i < padding; i++)
|
||||
mOut << ".";
|
||||
|
||||
mOut << "^\n";
|
||||
|
||||
}
|
||||
|
||||
void
|
||||
Shell::showOpAtPC(Context* cx, InstructionIterator pc)
|
||||
{
|
||||
ICodeModule *iCode = cx->getICode();
|
||||
|
||||
if ((pc < iCode->its_iCode->begin()) ||
|
||||
(pc >= iCode->its_iCode->end()))
|
||||
{
|
||||
mErr << "PC Out Of Range.";
|
||||
return;
|
||||
}
|
||||
|
||||
JSValues ®isters = cx->getRegisters();
|
||||
|
||||
printFormat(mOut, "trace [%02u:%04u]: ",
|
||||
iCode->mID, (pc - iCode->its_iCode->begin()));
|
||||
Instruction* i = *pc;
|
||||
stdOut << *i;
|
||||
if (i->op() != BRANCH && i->count() > 0) {
|
||||
mOut << " [";
|
||||
i->printOperands(stdOut, registers);
|
||||
mOut << "]\n";
|
||||
} else {
|
||||
mOut << '\n';
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
Shell::listen(Context* cx, Context::Event event)
|
||||
{
|
||||
InstructionIterator pc = cx->getPC();
|
||||
|
||||
if (mTraceSource)
|
||||
showSourceAtPC (cx, pc);
|
||||
if (mTraceICode)
|
||||
showOpAtPC (cx, pc);
|
||||
|
||||
if (!(mStopMask & event))
|
||||
return;
|
||||
|
||||
if ((mLastCommand == STEP) && (mLastICodeID == cx->getICode()->mID) &&
|
||||
(mLastSourcePos == getClosestSourcePosForPC (cx, cx->getPC())))
|
||||
/* we're in source-step mode, and the source position hasn't
|
||||
* changed yet */
|
||||
return;
|
||||
|
||||
if (!mTraceSource && !mTraceICode)
|
||||
showSourceAtPC (cx, pc);
|
||||
|
||||
static String lastLine(widenCString("help\n"));
|
||||
String line;
|
||||
LineReader reader(mIn);
|
||||
|
||||
do {
|
||||
stdOut << "jsd";
|
||||
if (mLastCommand != COMMAND_COUNT)
|
||||
stdOut << " (" << shell_cmds[mLastCommand][0] << ") ";
|
||||
stdOut << "> ";
|
||||
|
||||
reader.readLine(line);
|
||||
|
||||
if (line[0] == uni::lf)
|
||||
line = lastLine;
|
||||
else
|
||||
lastLine = line;
|
||||
|
||||
} while (doCommand(cx, line));
|
||||
}
|
||||
|
||||
|
||||
/**
|
||||
* lex and execute the debugger command in |source|, return true if the
|
||||
* command does not require the script being debugged to continue (eg, ask
|
||||
* for more debugger input.)
|
||||
*/
|
||||
bool
|
||||
Shell::doCommand (Interpreter::Context *cx, const String &source)
|
||||
{
|
||||
Lexer lex (mWorld, source, widenCString("debugger console"), 0);
|
||||
const String *cmd;
|
||||
uint32 match;
|
||||
bool rv = true;
|
||||
|
||||
const Token &t = lex.get(true);
|
||||
|
||||
if (t.hasKind(Token::identifier))
|
||||
cmd = &(t.getIdentifier());
|
||||
else
|
||||
{
|
||||
mErr << "you idiot.\n";
|
||||
return true;
|
||||
}
|
||||
|
||||
match = matchElement (*cmd, shell_cmds, (size_t)COMMAND_COUNT);
|
||||
|
||||
if (match <= (uint32)COMMAND_COUNT)
|
||||
{
|
||||
switch ((ShellCommand)match)
|
||||
{
|
||||
case COMMAND_COUNT:
|
||||
mErr << "Unknown command '" << *cmd << "'.\n";
|
||||
break;
|
||||
|
||||
case AMBIGUOUS:
|
||||
case AMBIGUOUS2:
|
||||
mErr << "I pity the foogoo.\n";
|
||||
break;
|
||||
|
||||
case CONTINUE:
|
||||
mStopMask &= (Context::EV_ALL ^ Context::EV_STEP);
|
||||
rv = false;
|
||||
break;
|
||||
|
||||
case DISSASSEMBLE:
|
||||
mOut << *cx->getICode();
|
||||
break;
|
||||
|
||||
case HELP:
|
||||
showHelp (mOut);
|
||||
break;
|
||||
|
||||
case PRINT:
|
||||
doPrint (cx, lex);
|
||||
break;
|
||||
|
||||
case STEP:
|
||||
mStopMask |= Context::EV_STEP;
|
||||
rv = false;
|
||||
break;
|
||||
|
||||
case LET:
|
||||
doSetVariable (lex);
|
||||
break;
|
||||
|
||||
default:
|
||||
mErr << "Input '" << *cmd << "' matched unimplemented " <<
|
||||
"command '" << shell_cmds[match][0] << "'.\n";
|
||||
break;
|
||||
|
||||
}
|
||||
|
||||
mLastSourcePos = getClosestSourcePosForPC (cx, cx->getPC());
|
||||
mLastICodeID = cx->getICode()->mID;
|
||||
mLastCommand = (ShellCommand)match;
|
||||
|
||||
} else
|
||||
mErr << "Ambiguous command '" << *cmd << "', " <<
|
||||
(match - (uint32)COMMAND_COUNT + 1) << " similar commands.\n";
|
||||
|
||||
return rv;
|
||||
}
|
||||
|
||||
void
|
||||
Shell::doSetVariable (Lexer &lex)
|
||||
{
|
||||
uint32 match;
|
||||
const String *varname;
|
||||
const Token *t = &(lex.get(true));
|
||||
|
||||
if (t->hasKind(Token::identifier))
|
||||
varname = &(t->getIdentifier());
|
||||
else
|
||||
{
|
||||
mErr << "invalid variable name.\n";
|
||||
return;
|
||||
}
|
||||
|
||||
match = matchElement (*varname, shell_vars, (size_t)VARIABLE_COUNT);
|
||||
|
||||
if (match <= (uint32)VARIABLE_COUNT)
|
||||
switch ((ShellVariable)match)
|
||||
{
|
||||
case VARIABLE_COUNT:
|
||||
mErr << "Unknown variable '" << *varname << "'.\n";
|
||||
break;
|
||||
|
||||
case TRACE_SOURCE:
|
||||
t = &(lex.get(true));
|
||||
if (t->hasKind(Token::assignment))
|
||||
t = &(lex.get(true)); /* optional = */
|
||||
|
||||
if (t->hasKind(Token::True))
|
||||
mTraceSource = true;
|
||||
else if (t->hasKind(Token::False))
|
||||
mTraceSource = false;
|
||||
else
|
||||
goto badval;
|
||||
break;
|
||||
|
||||
case TRACE_ICODE:
|
||||
t = &(lex.get(true));
|
||||
if (t->hasKind(Token::assignment))
|
||||
t = &(lex.get(true)); /* optional = */
|
||||
|
||||
if (t->hasKind(Token::True))
|
||||
mTraceICode = true;
|
||||
else if (t->hasKind(Token::False))
|
||||
mTraceICode = false;
|
||||
else
|
||||
goto badval;
|
||||
break;
|
||||
|
||||
default:
|
||||
mErr << "Variable '" << *varname <<
|
||||
"' matched unimplemented variable '" <<
|
||||
shell_vars[match][0] << "'.\n";
|
||||
}
|
||||
else
|
||||
mErr << "Ambiguous variable '" << *varname << "', " <<
|
||||
(match - (uint32)COMMAND_COUNT + 1) << " similar variables.\n";
|
||||
|
||||
return;
|
||||
|
||||
badval:
|
||||
mErr << "Invalid value for variable '" <<
|
||||
shell_vars[(ShellVariable)match][0] << "'\n";
|
||||
|
||||
}
|
||||
|
||||
void
|
||||
Shell::doPrint (Context *, Lexer &lex)
|
||||
{
|
||||
const Token *t = &(lex.get(true));
|
||||
|
||||
if (!(t->hasKind(Token::identifier)))
|
||||
{
|
||||
mErr << "Invalid register name.\n";
|
||||
return;
|
||||
}
|
||||
|
||||
/*
|
||||
const StringAtom *name = &(t->getIdentifier());
|
||||
|
||||
VariableMap::iterator i = ((cx->getICode())->itsVariables)->find(*name);
|
||||
// if (i)
|
||||
mOut << (*i).first << " = " << (*i).second << "\n";
|
||||
// else
|
||||
// mOut << "No " << *name << " defined.\n";
|
||||
|
||||
*/
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
} /* namespace Debugger */
|
||||
} /* namespace JavaScript */
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -1,163 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
/* this is all vapor, don't take it to serious yet */
|
||||
|
||||
#ifndef debugger_h
|
||||
#define debugger_h
|
||||
|
||||
#include "utilities.h"
|
||||
#include "interpreter.h"
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
namespace JavaScript {
|
||||
namespace Debugger {
|
||||
|
||||
using namespace Interpreter;
|
||||
|
||||
class Shell;
|
||||
|
||||
typedef const Reader *ResolveFileCallback (const String &fileName);
|
||||
typedef bool DebuggerCommandCallback (Shell &debugger, const Lexer &lex);
|
||||
|
||||
class Breakpoint {
|
||||
public:
|
||||
/* representation of a breakpoint */
|
||||
void set();
|
||||
void clear();
|
||||
bool getState();
|
||||
InstructionIterator getPC();
|
||||
};
|
||||
|
||||
struct DebuggerCommand
|
||||
{
|
||||
DebuggerCommand(String aName, String aParamDesc, String aShortHelp,
|
||||
String aLongHelp = widenCString("No more help available."),
|
||||
DebuggerCommandCallback *aCommandFunction = 0)
|
||||
: mName(aName), mParamDesc(aParamDesc), mShortHelp(aShortHelp),
|
||||
mLongHelp(aLongHelp), mCommandFunction(aCommandFunction) {}
|
||||
|
||||
String mName;
|
||||
String mParamDesc;
|
||||
String mShortHelp;
|
||||
String mLongHelp;
|
||||
DebuggerCommandCallback *mCommandFunction;
|
||||
};
|
||||
|
||||
/* keep in sync with list in debugger.cpp */
|
||||
enum ShellCommand {
|
||||
ASSEMBLE,
|
||||
AMBIGUOUS,
|
||||
AMBIGUOUS2,
|
||||
CONTINUE,
|
||||
DISSASSEMBLE,
|
||||
EXIT,
|
||||
HELP,
|
||||
ISTEP,
|
||||
LET,
|
||||
PRINT,
|
||||
REGISTER,
|
||||
STEP,
|
||||
COMMAND_COUNT
|
||||
};
|
||||
|
||||
class Shell : public Context::Listener {
|
||||
public:
|
||||
Shell (World &aWorld, FILE *aIn, Formatter &aOut, Formatter &aErr,
|
||||
ResolveFileCallback *aCallback = 0) :
|
||||
mWorld(aWorld), mIn(aIn), mOut(aOut), mErr(aErr),
|
||||
mResolveFileCallback(aCallback), mStopMask(Context::EV_DEBUG),
|
||||
mTraceSource(false), mTraceICode(false), mLastSourcePos(0),
|
||||
mLastICodeID(NotABanana), mLastCommand(COMMAND_COUNT)
|
||||
{
|
||||
}
|
||||
|
||||
~Shell ()
|
||||
{
|
||||
}
|
||||
|
||||
ResolveFileCallback
|
||||
*setResolveFileCallback (ResolveFileCallback *aCallback)
|
||||
{
|
||||
ResolveFileCallback *rv = mResolveFileCallback;
|
||||
mResolveFileCallback = aCallback;
|
||||
return rv;
|
||||
}
|
||||
|
||||
void listen(Context *context, Context::Event event);
|
||||
|
||||
/**
|
||||
* install on a context
|
||||
*/
|
||||
bool attachToContext (Context *aContext)
|
||||
{
|
||||
aContext->addListener (this);
|
||||
return true;
|
||||
}
|
||||
|
||||
/**
|
||||
* detach an icdebugger from a context
|
||||
*/
|
||||
bool detachFromContext (Context *aContext)
|
||||
{
|
||||
aContext->removeListener (this);
|
||||
return true;
|
||||
}
|
||||
|
||||
FILE *getIStream() { return mIn; }
|
||||
Formatter &getOStream() { return mOut; }
|
||||
Formatter &getEStream() { return mErr; }
|
||||
|
||||
private:
|
||||
bool doCommand (Context *cx, const String &aSource);
|
||||
void doSetVariable (Lexer &lex);
|
||||
void doPrint (Context *cx, Lexer &lex);
|
||||
|
||||
void showOpAtPC(Context* cx, InstructionIterator pc);
|
||||
void showSourceAtPC(Context* cx, InstructionIterator pc);
|
||||
|
||||
World &mWorld;
|
||||
FILE *mIn;
|
||||
Formatter &mOut, &mErr;
|
||||
ResolveFileCallback *mResolveFileCallback;
|
||||
uint32 mStopMask;
|
||||
bool mTraceSource, mTraceICode;
|
||||
uint32 mLastSourcePos, mLastICodeID;
|
||||
ShellCommand mLastCommand;
|
||||
};
|
||||
|
||||
} /* namespace Debugger */
|
||||
} /* namespace JavaScript */
|
||||
|
||||
#endif /* debugger_h */
|
||||
@@ -1,740 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifndef ds_h___
|
||||
#define ds_h___
|
||||
|
||||
#include <memory>
|
||||
|
||||
#include "utilities.h"
|
||||
|
||||
namespace JavaScript
|
||||
{
|
||||
|
||||
//
|
||||
// Save-Restore Pattern
|
||||
//
|
||||
|
||||
// Use the definition
|
||||
// SaveRestore<T> temp(var)
|
||||
// to save the current value of var at the time of the definition into a temporary temp
|
||||
// and restore var to the saved value at the end of temp's scope, regardless of whether
|
||||
// temp goes out of scope due to normal execution or due to a thrown exception.
|
||||
template<typename T> class SaveRestore {
|
||||
const T savedValue;
|
||||
T &var;
|
||||
|
||||
public:
|
||||
SaveRestore(T &t): savedValue(t), var(t) {}
|
||||
~SaveRestore() {var = savedValue;}
|
||||
};
|
||||
|
||||
|
||||
//
|
||||
// Doubly Linked Lists
|
||||
//
|
||||
|
||||
// A ListQueue provides insert and delete operations on a doubly-linked list of
|
||||
// objects threaded through fields named 'next' and 'prev'. The type parameter
|
||||
// E must be a class derived from ListQueueEntry.
|
||||
// The ListQueue does not own its elements. They must be deleted explicitly if
|
||||
// needed.
|
||||
struct ListQueueEntry {
|
||||
ListQueueEntry *next; // Next entry in linked list
|
||||
ListQueueEntry *prev; // Previous entry in linked list
|
||||
|
||||
#ifdef DEBUG
|
||||
ListQueueEntry(): next(0), prev(0) {}
|
||||
#endif
|
||||
};
|
||||
|
||||
template <class E>
|
||||
struct ListQueue: private ListQueueEntry {
|
||||
|
||||
ListQueue() {next = this; prev = this;}
|
||||
|
||||
// Return true if the ListQueue is nonempty.
|
||||
operator bool() const {return next != static_cast<const ListQueueEntry *>(this);}
|
||||
|
||||
// Return true if the ListQueue is empty.
|
||||
bool operator !() const {return next == static_cast<const ListQueueEntry *>(this);}
|
||||
|
||||
E &front() const {ASSERT(operator bool()); return *static_cast<E *>(next);}
|
||||
E &back() const {ASSERT(operator bool()); return *static_cast<E *>(prev);}
|
||||
|
||||
void push_front(E &elt) {
|
||||
ASSERT(!elt.next && !elt.prev);
|
||||
elt.next = next; elt.prev = this; next->prev = &elt; next = &elt;
|
||||
}
|
||||
|
||||
void push_back(E &elt) {
|
||||
ASSERT(!elt.next && !elt.prev);
|
||||
elt.next = this; elt.prev = prev; prev->next = &elt; prev = &elt;
|
||||
}
|
||||
|
||||
E &pop_front() {
|
||||
ASSERT(operator bool());
|
||||
E *elt = static_cast<E *>(next); next = elt->next; next->prev = this;
|
||||
DEBUG_ONLY(elt->next = 0; elt->prev = 0;) return *elt;
|
||||
}
|
||||
|
||||
E &pop_back() {
|
||||
ASSERT(operator bool());
|
||||
E *elt = static_cast<E *>(prev); prev = elt->prev; prev->next = this;
|
||||
DEBUG_ONLY(elt->next = 0; elt->prev = 0;);
|
||||
return *elt;
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
//
|
||||
// Growable Arrays
|
||||
//
|
||||
|
||||
// A Buffer initially points to inline storage of initialSize elements of type T.
|
||||
// The Buffer can be expanded via the expand method to increase its size by
|
||||
// allocating storage from the heap.
|
||||
template <typename T, size_t initialSize> class Buffer {
|
||||
public:
|
||||
T *buffer; // Pointer to the current buffer
|
||||
size_t size; // Current size of the buffer
|
||||
private:
|
||||
T initialBuffer[initialSize]; // Initial buffer
|
||||
public:
|
||||
Buffer(): buffer(initialBuffer), size(initialSize) {}
|
||||
~Buffer() {if (buffer != initialBuffer) delete[] buffer;}
|
||||
|
||||
void expand(size_t newSize);
|
||||
};
|
||||
|
||||
|
||||
// Expand the buffer to size newSize, which must be greater than the current
|
||||
// size. The buffer's contents are not preserved.
|
||||
template <typename T, size_t initialSize>
|
||||
inline void Buffer<T, initialSize>::expand(size_t newSize) {
|
||||
ASSERT(newSize > size);
|
||||
if (buffer != initialBuffer) {
|
||||
delete[] buffer;
|
||||
buffer = 0; // For exception safety if the allocation below fails.
|
||||
}
|
||||
buffer = new T[newSize];
|
||||
size = newSize;
|
||||
}
|
||||
|
||||
|
||||
// See ArrayBuffer below.
|
||||
template <typename T> class RawArrayBuffer {
|
||||
T *const cache; // Pointer to a fixed-size cache for holding the buffer if it's small enough
|
||||
protected:
|
||||
T *buffer; // Pointer to the current buffer
|
||||
size_t length; // Logical size of the buffer
|
||||
size_t bufferSize; // Physical size of the buffer
|
||||
#ifdef DEBUG
|
||||
size_t maxReservedSize; // Maximum size reserved so far
|
||||
#endif
|
||||
|
||||
public:
|
||||
RawArrayBuffer(T *cache, size_t cacheSize) :
|
||||
cache(cache), buffer(cache), length(0), bufferSize(cacheSize) {
|
||||
DEBUG_ONLY(maxReservedSize = 0);
|
||||
}
|
||||
private:
|
||||
RawArrayBuffer(const RawArrayBuffer&); // No copy constructor
|
||||
void operator=(const RawArrayBuffer&); // No assignment operator
|
||||
public:
|
||||
~RawArrayBuffer() {if (buffer != cache) delete[] buffer;}
|
||||
|
||||
private:
|
||||
void enlarge(size_t newLength);
|
||||
public:
|
||||
// Methods that do not expand the buffer cannot throw exceptions.
|
||||
size_t size() const {return length;}
|
||||
operator bool() const {return length != 0;}
|
||||
bool operator !() const {return length == 0;}
|
||||
|
||||
T &front() {ASSERT(length); return *buffer;}
|
||||
const T &front() const {ASSERT(length); return *buffer;}
|
||||
T &back() {ASSERT(length); return buffer[length-1];}
|
||||
const T &back() const {ASSERT(length); return buffer[length-1];}
|
||||
T *contents() const {return buffer;}
|
||||
|
||||
void reserve(size_t nElts);
|
||||
T *reserve_back(size_t nElts = 1);
|
||||
T *advance_back(size_t nElts = 1);
|
||||
T *reserve_advance_back(size_t nElts = 1);
|
||||
|
||||
void fast_push_back(const T &elt);
|
||||
void push_back(const T &elt);
|
||||
void append(const T *elts, size_t nElts);
|
||||
void append(const T *begin, const T *end) {ASSERT(end >= begin); append(begin, toSize_t(end - begin));}
|
||||
|
||||
T &pop_back() {ASSERT(length); return buffer[--length];}
|
||||
};
|
||||
|
||||
|
||||
// Enlarge the buffer so that it can hold at least newLength elements.
|
||||
// May throw an exception, in which case the buffer is left unchanged.
|
||||
template <typename T>
|
||||
void RawArrayBuffer<T>::enlarge(size_t newLength) {
|
||||
size_t newBufferSize = bufferSize * 2;
|
||||
if (newBufferSize < newLength)
|
||||
newBufferSize = newLength;
|
||||
|
||||
auto_ptr<T> newBuffer(new T[newBufferSize]);
|
||||
T *oldBuffer = buffer;
|
||||
std::copy(oldBuffer, oldBuffer + length, newBuffer.get());
|
||||
buffer = newBuffer.release();
|
||||
if (oldBuffer != cache)
|
||||
delete[] oldBuffer;
|
||||
bufferSize = newBufferSize;
|
||||
}
|
||||
|
||||
// Ensure that there is room to hold nElts elements in the buffer, without
|
||||
// expanding the buffer's logical length.
|
||||
// May throw an exception, in which case the buffer is left unchanged.
|
||||
template <typename T>
|
||||
inline void RawArrayBuffer<T>::reserve(size_t nElts) {
|
||||
if (bufferSize < nElts)
|
||||
enlarge(nElts);
|
||||
#ifdef DEBUG
|
||||
if (maxReservedSize < nElts)
|
||||
maxReservedSize = nElts;
|
||||
#endif
|
||||
}
|
||||
|
||||
// Ensure that there is room to hold nElts more elements in the buffer, without
|
||||
// expanding the buffer's logical length. Return a pointer to the first element
|
||||
// just past the logical length.
|
||||
// May throw an exception, in which case the buffer is left unchanged.
|
||||
template <typename T>
|
||||
inline T *RawArrayBuffer<T>::reserve_back(size_t nElts) {
|
||||
reserve(length + nElts);
|
||||
return buffer[length];
|
||||
}
|
||||
|
||||
// Advance the logical length by nElts, assuming that the memory has previously
|
||||
// been reserved.
|
||||
// Return a pointer to the first new element.
|
||||
template <typename T>
|
||||
inline T *RawArrayBuffer<T>::advance_back(size_t nElts) {
|
||||
ASSERT(length + nElts <= maxReservedSize);
|
||||
T *p = buffer + length;
|
||||
length += nElts;
|
||||
return p;
|
||||
}
|
||||
|
||||
// Combine the effects of reserve_back and advance_back.
|
||||
template <typename T>
|
||||
inline T *RawArrayBuffer<T>::reserve_advance_back(size_t nElts) {
|
||||
reserve(length + nElts);
|
||||
T *p = buffer + length;
|
||||
length += nElts;
|
||||
return p;
|
||||
}
|
||||
|
||||
// Same as push_back but assumes that the memory has previously been reserved.
|
||||
// May throw an exception if copying elt throws one, in which case the buffer is
|
||||
// left unchanged.
|
||||
template <typename T>
|
||||
inline void RawArrayBuffer<T>::fast_push_back(const T &elt) {
|
||||
ASSERT(length < maxReservedSize);
|
||||
buffer[length] = elt;
|
||||
++length;
|
||||
}
|
||||
|
||||
// Append elt to the back of the buffer.
|
||||
// May throw an exception, in which case the buffer is left unchanged.
|
||||
template <typename T>
|
||||
inline void RawArrayBuffer<T>::push_back(const T &elt) {
|
||||
*reserve_back() = elt;
|
||||
++length;
|
||||
}
|
||||
|
||||
// Append nElts elements elts to the back of the array buffer.
|
||||
// May throw an exception, in which case the buffer is left unchanged.
|
||||
template <typename T>
|
||||
void RawArrayBuffer<T>::append(const T *elts, size_t nElts) {
|
||||
size_t newLength = length + nElts;
|
||||
if (newLength > bufferSize)
|
||||
enlarge(newLength);
|
||||
std::copy(elts, elts + nElts, buffer + length);
|
||||
length = newLength;
|
||||
}
|
||||
|
||||
|
||||
// An ArrayBuffer represents an array of elements of type T. The ArrayBuffer
|
||||
// contains storage for a fixed size array of cacheSize elements; if this size
|
||||
// is exceeded, the ArrayBuffer allocates the array from the heap. Elements can
|
||||
// be appended to the back of the array using append. An ArrayBuffer can also
|
||||
// act as a stack: elements can be pushed and popped from the back.
|
||||
//
|
||||
// All ArrayBuffer operations are atomic with respect to exceptions -- either
|
||||
// they succeed or they do not affect the ArrayBuffer's existing elements and
|
||||
// length. If T has a constructor, it must have a constructor with no arguments;
|
||||
// that constructor is called at the time memory for the ArrayBuffer is
|
||||
// allocated, just like when allocating a regular C++ array.
|
||||
template <typename T, size_t cacheSize>
|
||||
class ArrayBuffer: public RawArrayBuffer<T> {
|
||||
T cacheArray[cacheSize];
|
||||
public:
|
||||
ArrayBuffer(): RawArrayBuffer<T>(cacheArray, cacheSize) {}
|
||||
};
|
||||
|
||||
|
||||
//
|
||||
// Bit Sets
|
||||
//
|
||||
|
||||
template<size_t size> class BitSet {
|
||||
STATIC_CONST(size_t, nWords = (size+31)>>5);
|
||||
STATIC_CONST(uint32, lastWordMask = (2u<<((size-1)&31)) - 1);
|
||||
|
||||
uint32 words[nWords]; // Bitmap; the first word contains bits 0(LSB)...31(MSB), the second contains bits 32...63, etc.
|
||||
|
||||
public:
|
||||
void clear() {zero(words, words+nWords);}
|
||||
BitSet() {clear();}
|
||||
|
||||
// Construct a BitSet out of an array of alternating low (inclusive)
|
||||
// and high (exclusive) ends of ranges of set bits.
|
||||
// The array is terminated by a 0,0 range.
|
||||
template<typename In> explicit BitSet(In a) {
|
||||
clear();
|
||||
size_t low, high;
|
||||
while (low = *a++, (high = *a++) != 0) setRange(low, high);
|
||||
}
|
||||
|
||||
bool operator[](size_t i) const {ASSERT(i < size); return static_cast<bool>(words[i>>5]>>(i&31) & 1);}
|
||||
bool none() const;
|
||||
bool operator==(const BitSet &s) const;
|
||||
bool operator!=(const BitSet &s) const;
|
||||
|
||||
void set(size_t i) {ASSERT(i < size); words[i>>5] |= 1u<<(i&31);}
|
||||
void reset(size_t i) {ASSERT(i < size); words[i>>5] &= ~(1u<<(i&31));}
|
||||
void flip(size_t i) {ASSERT(i < size); words[i>>5] ^= 1u<<(i&31);}
|
||||
void setRange(size_t low, size_t high);
|
||||
void resetRange(size_t low, size_t high);
|
||||
void flipRange(size_t low, size_t high);
|
||||
};
|
||||
|
||||
|
||||
// Return true if all bits are clear.
|
||||
template<size_t size>
|
||||
inline bool BitSet<size>::none() const {
|
||||
if (nWords == 1)
|
||||
return !words[0];
|
||||
else {
|
||||
const uint32 *w = words;
|
||||
while (w != words + nWords)
|
||||
if (*w++)
|
||||
return false;
|
||||
return true;
|
||||
}
|
||||
}
|
||||
|
||||
// Return true if the BitSets are equal.
|
||||
template<size_t size>
|
||||
inline bool BitSet<size>::operator==(const BitSet &s) const {
|
||||
if (nWords == 1)
|
||||
return words[0] == s.words[0];
|
||||
else
|
||||
return std::equal(words, s.words);
|
||||
}
|
||||
|
||||
// Return true if the BitSets are not equal.
|
||||
template<size_t size>
|
||||
inline bool BitSet<size>::operator!=(const BitSet &s) const {
|
||||
return !operator==(s);
|
||||
}
|
||||
|
||||
// Set all bits between low inclusive and high exclusive.
|
||||
template<size_t size>
|
||||
void BitSet<size>::setRange(size_t low, size_t high) {
|
||||
ASSERT(low <= high && high <= size);
|
||||
if (low != high)
|
||||
if (nWords == 1)
|
||||
words[0] |= (2u<<(high-1)) - (1u<<low);
|
||||
else {
|
||||
--high;
|
||||
uint32 *w = words + (low>>5);
|
||||
uint32 *wHigh = words + (high>>5);
|
||||
uint32 l = 1u << (low&31);
|
||||
uint32 h = 2u << (high&31);
|
||||
if (w == wHigh)
|
||||
*w |= h - l;
|
||||
else {
|
||||
*w++ |= -l;
|
||||
while (w != wHigh)
|
||||
*w++ = static_cast<uint32>(-1);
|
||||
*w |= h - 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
// Clear all bits between low inclusive and high exclusive.
|
||||
template<size_t size>
|
||||
void BitSet<size>::resetRange(size_t low, size_t high) {
|
||||
ASSERT(low <= high && high <= size);
|
||||
if (low != high)
|
||||
if (nWords == 1)
|
||||
words[0] &= (1u<<low) - 1 - (2u<<(high-1));
|
||||
else {
|
||||
--high;
|
||||
uint32 *w = words + (low>>5);
|
||||
uint32 *wHigh = words + (high>>5);
|
||||
uint32 l = 1u << (low&31);
|
||||
uint32 h = 2u << (high&31);
|
||||
if (w == wHigh)
|
||||
*w &= l - 1 - h;
|
||||
else {
|
||||
*w++ &= l - 1;
|
||||
while (w != wHigh)
|
||||
*w++ = 0;
|
||||
*w &= -h;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
// Invert all bits between low inclusive and high exclusive.
|
||||
template<size_t size>
|
||||
void BitSet<size>::flipRange(size_t low, size_t high) {
|
||||
ASSERT(low <= high && high <= size);
|
||||
if (low != high)
|
||||
if (nWords == 1)
|
||||
words[0] ^= (2u<<(high-1)) - (1u<<low);
|
||||
else {
|
||||
--high;
|
||||
uint32 *w = words + (low>>5);
|
||||
uint32 *wHigh = words + (high>>5);
|
||||
uint32 l = 1u << (low&31);
|
||||
uint32 h = 2u << (high&31);
|
||||
if (w == wHigh)
|
||||
*w ^= h - l;
|
||||
else {
|
||||
*w++ ^= -l;
|
||||
while (w != wHigh)
|
||||
*w++ ^= static_cast<uint32>(-1);
|
||||
*w ^= h - 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
//
|
||||
// Array Queues
|
||||
//
|
||||
|
||||
// See ArrayQueue below.
|
||||
template <typename T> class RawArrayQueue {
|
||||
T *const cache; // Pointer to a fixed-size cache for holding the buffer if it's small enough
|
||||
protected:
|
||||
T *buffer; // Pointer to the current buffer
|
||||
T *bufferEnd; // Pointer to the end of the buffer
|
||||
T *f; // Front end of the circular buffer, used for reading elements; buffer <= f < bufferEnd
|
||||
T *b; // Back end of the circular buffer, used for writing elements; buffer < b <= bufferEnd
|
||||
size_t length; // Number of elements used in the circular buffer
|
||||
size_t bufferSize; // Physical size of the buffer
|
||||
#ifdef DEBUG
|
||||
size_t maxReservedSize; // Maximum size reserved so far
|
||||
#endif
|
||||
|
||||
public:
|
||||
RawArrayQueue(T *cache, size_t cacheSize):
|
||||
cache(cache), buffer(cache), bufferEnd(cache + cacheSize),
|
||||
f(cache), b(cache), length(0), bufferSize(cacheSize)
|
||||
{DEBUG_ONLY(maxReservedSize = 0);}
|
||||
private:
|
||||
RawArrayQueue(const RawArrayQueue&); // No copy constructor
|
||||
void operator=(const RawArrayQueue&); // No assignment operator
|
||||
public:
|
||||
~RawArrayQueue() {if (buffer != cache) delete[] buffer;}
|
||||
|
||||
private:
|
||||
void enlarge(size_t newLength);
|
||||
public:
|
||||
|
||||
// Methods that do not expand the buffer cannot throw exceptions.
|
||||
size_t size() const {return length;}
|
||||
operator bool() const {return length != 0;}
|
||||
bool operator !() const {return length == 0;}
|
||||
|
||||
T &front() {ASSERT(length); return *f;}
|
||||
const T &front() const {ASSERT(length); return *f;}
|
||||
T &back() {ASSERT(length); return b[-1];}
|
||||
const T &back() const {ASSERT(length); return b[-1];}
|
||||
|
||||
T &pop_front() {
|
||||
ASSERT(length);
|
||||
--length;
|
||||
T &elt = *f++;
|
||||
if (f == bufferEnd)
|
||||
f = buffer;
|
||||
return elt;
|
||||
}
|
||||
|
||||
size_t pop_front(size_t nElts, T *&begin, T *&end);
|
||||
|
||||
T &pop_back() {
|
||||
ASSERT(length);
|
||||
--length;
|
||||
T &elt = *--b;
|
||||
if (b == buffer)
|
||||
b = bufferEnd;
|
||||
return elt;
|
||||
}
|
||||
|
||||
void reserve_back();
|
||||
void reserve_back(size_t nElts);
|
||||
T *advance_back();
|
||||
T *advance_back(size_t nElts, size_t &nEltsAdvanced);
|
||||
|
||||
void fast_push_back(const T &elt);
|
||||
void push_back(const T &elt);
|
||||
|
||||
// Same as append but assumes that memory has previously been reserved.
|
||||
// Does not throw exceptions. T::operator= must not throw exceptions.
|
||||
template <class InputIter>
|
||||
void fast_append(InputIter begin, InputIter end) {
|
||||
size_t nElts = toSize_t(std::distance(begin, end));
|
||||
ASSERT(length + nElts <= maxReservedSize);
|
||||
while (nElts) {
|
||||
size_t nEltsAdvanced;
|
||||
T *dst = advance_back(nElts, nEltsAdvanced);
|
||||
nElts -= nEltsAdvanced;
|
||||
while (nEltsAdvanced--) {
|
||||
*dst = *begin; ++dst; ++begin;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
// Append elements from begin to end to the back of the queue.
|
||||
// T::operator= must not throw exceptions.
|
||||
// reserve_back may throw an exception, in which case the queue is left
|
||||
// unchanged.
|
||||
template <class InputIter> void append(InputIter begin, InputIter end) {
|
||||
size_t nElts = toSize_t(std::distance(begin, end));
|
||||
reserve_back(nElts);
|
||||
while (nElts) {
|
||||
size_t nEltsAdvanced;
|
||||
T *dst = advance_back(nElts, nEltsAdvanced);
|
||||
nElts -= nEltsAdvanced;
|
||||
while (nEltsAdvanced--) {
|
||||
*dst = *begin; ++dst; ++begin;
|
||||
}
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
// Pop between one and nElts elements from the front of the queue. Set begin
|
||||
// and end to an array of the first n elements, where n is the return value.
|
||||
// The popped elements may be accessed until the next non-const operation.
|
||||
// Does not throw exceptions.
|
||||
template <typename T>
|
||||
size_t RawArrayQueue<T>::pop_front(size_t nElts, T *&begin, T *&end) {
|
||||
ASSERT(nElts <= length);
|
||||
begin = f;
|
||||
size_t eltsToEnd = toSize_t(bufferEnd - f);
|
||||
if (nElts < eltsToEnd) {
|
||||
length -= nElts;
|
||||
f += nElts;
|
||||
end = f;
|
||||
return nElts;
|
||||
} else {
|
||||
length -= eltsToEnd;
|
||||
end = bufferEnd;
|
||||
f = buffer;
|
||||
return eltsToEnd;
|
||||
}
|
||||
}
|
||||
|
||||
// Enlarge the buffer so that it can hold at least newLength elements.
|
||||
// May throw an exception, in which case the queue is left unchanged.
|
||||
template <typename T>
|
||||
void RawArrayQueue<T>::enlarge(size_t newLength) {
|
||||
size_t newBufferSize = bufferSize * 2;
|
||||
if (newBufferSize < newLength)
|
||||
newBufferSize = newLength;
|
||||
|
||||
auto_ptr<T> newBuffer(new T[newBufferSize]);
|
||||
T *oldBuffer = buffer;
|
||||
size_t eltsToEnd = toSize_t(bufferEnd - f);
|
||||
if (eltsToEnd <= length)
|
||||
std::copy(f, f + eltsToEnd, newBuffer.get());
|
||||
else {
|
||||
std::copy(f, bufferEnd, newBuffer.get());
|
||||
std::copy(oldBuffer, b, newBuffer.get() + eltsToEnd);
|
||||
}
|
||||
buffer = newBuffer.release();
|
||||
f = buffer;
|
||||
b = buffer + length;
|
||||
if (oldBuffer != cache)
|
||||
delete[] oldBuffer;
|
||||
bufferSize = newBufferSize;
|
||||
}
|
||||
|
||||
// Ensure that there is room to hold one more element at the back of the queue,
|
||||
// without expanding the queue's logical length.
|
||||
// May throw an exception, in which case the queue is left unchanged.
|
||||
template <typename T>
|
||||
inline void RawArrayQueue<T>::reserve_back() {
|
||||
if (length == bufferSize)
|
||||
enlarge(length + 1);
|
||||
#ifdef DEBUG
|
||||
if (maxReservedSize <= length)
|
||||
maxReservedSize = length + 1;
|
||||
#endif
|
||||
}
|
||||
|
||||
// Ensure that there is room to hold nElts more elements at the back of the
|
||||
// queue, without expanding the queue's logical length.
|
||||
// May throw an exception, in which case the queue is left unchanged.
|
||||
template <typename T>
|
||||
inline void RawArrayQueue<T>::reserve_back(size_t nElts) {
|
||||
nElts += length;
|
||||
if (bufferSize < nElts)
|
||||
enlarge(nElts);
|
||||
#ifdef DEBUG
|
||||
if (maxReservedSize < nElts)
|
||||
maxReservedSize = nElts;
|
||||
#endif
|
||||
}
|
||||
|
||||
// Advance the back of the queue by one element, assuming that the memory has
|
||||
// previously been reserved.
|
||||
// Return a pointer to that new element.
|
||||
// Does not throw exceptions.
|
||||
template <typename T>
|
||||
inline T *RawArrayQueue<T>::advance_back() {
|
||||
ASSERT(length < maxReservedSize);
|
||||
++length;
|
||||
if (b == bufferEnd)
|
||||
b = buffer;
|
||||
return b++;
|
||||
}
|
||||
|
||||
// Advance the back of the queue by between one and nElts elements and return a
|
||||
// pointer to them, assuming that the memory has previously been reserved.
|
||||
// nEltsAdvanced gets the actual number of elements advanced.
|
||||
// Does not throw exceptions.
|
||||
template <typename T>
|
||||
T *RawArrayQueue<T>::advance_back(size_t nElts, size_t &nEltsAdvanced) {
|
||||
size_t newLength = length + nElts;
|
||||
ASSERT(newLength <= maxReservedSize);
|
||||
if (nElts) {
|
||||
T *b2 = b;
|
||||
if (b2 == bufferEnd)
|
||||
b2 = buffer;
|
||||
|
||||
size_t room = toSize_t(bufferEnd - b2);
|
||||
if (nElts > room) {
|
||||
nElts = room;
|
||||
newLength = length + nElts;
|
||||
}
|
||||
length = newLength;
|
||||
nEltsAdvanced = nElts;
|
||||
b = b2 + nElts;
|
||||
return b2;
|
||||
} else {
|
||||
nEltsAdvanced = 0;
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
// Same as push_back but assumes that the memory has previously been reserved.
|
||||
// May throw an exception if copying elt throws one, in which case the queue is
|
||||
// left unchanged.
|
||||
template <typename T>
|
||||
inline void RawArrayQueue<T>::fast_push_back(const T &elt) {
|
||||
ASSERT(length < maxReservedSize);
|
||||
T *b2 = b;
|
||||
if (b2 == bufferEnd)
|
||||
b2 = buffer;
|
||||
*b2 = elt;
|
||||
b = b2 + 1;
|
||||
++length;
|
||||
}
|
||||
|
||||
// Append elt to the back of the queue.
|
||||
// May throw an exception, in which case the queue is left unchanged.
|
||||
template <typename T>
|
||||
inline void RawArrayQueue<T>::push_back(const T &elt) {
|
||||
reserve_back();
|
||||
T *b2 = b == bufferEnd ? buffer : b;
|
||||
*b2 = elt;
|
||||
b = b2 + 1;
|
||||
++length;
|
||||
}
|
||||
|
||||
|
||||
// An ArrayQueue represents an array of elements of type T that can be written
|
||||
// at its back end and read at its front or back end. In addition, arrays of
|
||||
// multiple elements may be written at the back end or read at the front end.
|
||||
// The ArrayQueue contains storage for a fixed size array of cacheSize elements;
|
||||
// if this size is exceeded, the ArrayQueue allocates the array from the heap.
|
||||
template <typename T, size_t cacheSize>
|
||||
class ArrayQueue: public RawArrayQueue<T> {
|
||||
T cacheArray[cacheSize];
|
||||
public:
|
||||
ArrayQueue(): RawArrayQueue<T>(cacheArray, cacheSize) {}
|
||||
};
|
||||
|
||||
|
||||
//
|
||||
// Array auto_ptr's
|
||||
//
|
||||
|
||||
// An ArrayAutoPtr holds a pointer to an array initialized by new T[x].
|
||||
// A regular auto_ptr cannot be used here because it deletes its pointer using
|
||||
// delete rather than delete[].
|
||||
// An appropriate operator[] is also provided.
|
||||
template <typename T> class ArrayAutoPtr {
|
||||
T *ptr;
|
||||
|
||||
public:
|
||||
explicit ArrayAutoPtr(T *p = 0): ptr(p) {}
|
||||
ArrayAutoPtr(ArrayAutoPtr &a): ptr(a.ptr) {a.ptr = 0;}
|
||||
ArrayAutoPtr &operator=(ArrayAutoPtr &a) {reset(a.release());}
|
||||
~ArrayAutoPtr() {delete[] ptr;}
|
||||
|
||||
T &operator*() const {return *ptr;}
|
||||
T &operator->() const {return *ptr;}
|
||||
template<class N> T &operator[](N i) const {return ptr[i];}
|
||||
T *get() const {return ptr;}
|
||||
T *release() {T *p = ptr; ptr = 0; return p;}
|
||||
void reset(T *p = 0) {delete[] ptr; ptr = p;}
|
||||
};
|
||||
|
||||
typedef ArrayAutoPtr<char> CharAutoPtr;
|
||||
}
|
||||
#endif /* ds_h___ */
|
||||
@@ -1,85 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#include <cstdio>
|
||||
#include "exception.h"
|
||||
|
||||
namespace JS = JavaScript;
|
||||
|
||||
|
||||
//
|
||||
// Exceptions
|
||||
//
|
||||
|
||||
static const char *const kindStrings[] = {
|
||||
"Syntax error", // syntaxError
|
||||
"Stack overflow", // stackOverflow
|
||||
"Internal error", // diabetes
|
||||
"Runtime error", // runtimeError
|
||||
"Reference error", // referenceError
|
||||
"Range error", // burnt the beans
|
||||
"Type error", // Yype error
|
||||
"Uncaught exception error", // uncaught exception error
|
||||
"Semantic error", // semantic error
|
||||
};
|
||||
|
||||
// Return a null-terminated string describing the exception's kind.
|
||||
const char *JS::Exception::kindString() const
|
||||
{
|
||||
return kindStrings[kind];
|
||||
}
|
||||
|
||||
|
||||
// Return the full error message.
|
||||
JS::String JS::Exception::fullMessage() const
|
||||
{
|
||||
String m(widenCString("In "));
|
||||
m += sourceFile;
|
||||
if (lineNum) {
|
||||
char b[32];
|
||||
sprintf(b, ", line %d:\n", lineNum);
|
||||
m += b;
|
||||
m += sourceLine;
|
||||
m += '\n';
|
||||
String sourceLine2(sourceLine);
|
||||
insertChars(sourceLine2, charNum, "[ERROR]");
|
||||
m += sourceLine2;
|
||||
m += '\n';
|
||||
} else
|
||||
m += ":\n";
|
||||
m += kindString();
|
||||
m += ": ";
|
||||
m += message;
|
||||
m += '\n';
|
||||
return m;
|
||||
}
|
||||
@@ -1,95 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifndef exception_h___
|
||||
#define exception_h___
|
||||
|
||||
#include "strings.h"
|
||||
|
||||
namespace JavaScript
|
||||
{
|
||||
|
||||
//
|
||||
// Exceptions
|
||||
//
|
||||
|
||||
// A JavaScript exception (other than out-of-memory, for which we use the
|
||||
// standard C++ exception bad_alloc).
|
||||
struct Exception {
|
||||
enum Kind {
|
||||
syntaxError,
|
||||
stackOverflow,
|
||||
internalError,
|
||||
runtimeError,
|
||||
referenceError,
|
||||
rangeError,
|
||||
typeError,
|
||||
uncaughtError,
|
||||
semanticError
|
||||
};
|
||||
|
||||
Kind kind; // The exception's kind
|
||||
String message; // The detailed message
|
||||
String sourceFile; // A description of the source code that caused the error
|
||||
uint32 lineNum; // Number of line that caused the error
|
||||
size_t charNum; // Character offset within the line that caused the error
|
||||
size_t pos; // Offset within the input of the error
|
||||
String sourceLine; // The text of the source line
|
||||
|
||||
Exception (Kind kind, const char *message):
|
||||
kind(kind), message(widenCString(message)), lineNum(0), charNum(0) {}
|
||||
|
||||
Exception (Kind kind, const String &message):
|
||||
kind(kind), message(message), lineNum(0), charNum(0) {}
|
||||
|
||||
Exception(Kind kind, const String &message, const String &sourceFile, uint32 lineNum, size_t charNum,
|
||||
size_t pos, const String &sourceLine):
|
||||
kind(kind), message(message), sourceFile(sourceFile), lineNum(lineNum), charNum(charNum), pos(pos),
|
||||
sourceLine(sourceLine) {}
|
||||
|
||||
Exception(Kind kind, const String &message, const String &sourceFile, uint32 lineNum, size_t charNum,
|
||||
size_t pos, const char16 *sourceLineBegin, const char16 *sourceLineEnd):
|
||||
kind(kind), message(message), sourceFile(sourceFile), lineNum(lineNum), charNum(charNum), pos(pos),
|
||||
sourceLine(sourceLineBegin, sourceLineEnd) {}
|
||||
|
||||
bool hasKind(Kind k) const {return kind == k;}
|
||||
const char *kindString() const;
|
||||
String fullMessage() const;
|
||||
};
|
||||
|
||||
|
||||
// Throw a stackOverflow exception if the execution stack has gotten too large.
|
||||
inline void checkStackSize() {}
|
||||
}
|
||||
|
||||
#endif /* exception_h___ */
|
||||
@@ -1,66 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
namespace JavaScript {
|
||||
|
||||
const char* exception_types[] = {
|
||||
"Unknown",
|
||||
"Lexer",
|
||||
"Parser",
|
||||
"Runtime",
|
||||
0
|
||||
};
|
||||
|
||||
const char* exception_msgs[] = {
|
||||
"Expected boolean value",
|
||||
"Expected double value",
|
||||
"Expected int32 value",
|
||||
"Expected uint32 value",
|
||||
"Expected register value",
|
||||
"Expected argument list value",
|
||||
"Expected colon",
|
||||
"Expected close parenthesis",
|
||||
"Expected binary operator",
|
||||
"Expected string",
|
||||
"Expected label",
|
||||
"Expected comma",
|
||||
"Expected newline",
|
||||
"Expected identifier",
|
||||
"Duplicate label",
|
||||
"Unknown icode",
|
||||
"Unknown binary operator",
|
||||
"Unterminated string literal",
|
||||
0
|
||||
};
|
||||
|
||||
}
|
||||
@@ -1,2 +0,0 @@
|
||||
|
||||
// this file intentionally left blank
|
||||
@@ -1,140 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
* Roger Lawrence <rogerl@netscape.com>
|
||||
* Patrick Beard <beard@netscape.com>
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#include <math.h>
|
||||
|
||||
#if defined(_WIN32) && !defined(__MWERKS__)
|
||||
#define __STDC__
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Use math routines in fdlibm.
|
||||
*/
|
||||
|
||||
#undef __P
|
||||
#ifdef __STDC__
|
||||
#define __P(p) p
|
||||
#else
|
||||
#define __P(p) ()
|
||||
#endif
|
||||
|
||||
#if defined _WIN32 || defined SUNOS4
|
||||
|
||||
// these are functions we trust the local implementation
|
||||
// to provide, so we just inline them into calls to the
|
||||
// standard library.
|
||||
namespace fd {
|
||||
inline double floor(double x) { return ::floor(x); }
|
||||
inline double acos(double x) { return ::acos(x); }
|
||||
inline double asin(double x) { return ::asin(x); }
|
||||
inline double atan(double x) { return ::atan(x); }
|
||||
inline double cos(double x) { return ::cos(x); }
|
||||
inline double sin(double x) { return ::sin(x); }
|
||||
inline double tan(double x) { return ::tan(x); }
|
||||
inline double exp(double x) { return ::exp(x); }
|
||||
inline double log(double x) { return ::log(x); }
|
||||
inline double sqrt(double x) { return ::sqrt(x); }
|
||||
inline double ceil(double x) { return ::ceil(x); }
|
||||
inline double fabs(double x) { return ::fabs(x); }
|
||||
inline double fmod(double x, double y) { return ::fmod(x, y); }
|
||||
}
|
||||
|
||||
// these one we get from the fdlibm library
|
||||
namespace fd {
|
||||
extern "C" {
|
||||
double fd_atan2 __P((double, double));
|
||||
double fd_copysign __P((double, double));
|
||||
double fd_pow __P((double, double));
|
||||
}
|
||||
inline double atan2(double x, double y) { return fd_atan2(x, y); }
|
||||
inline double copysign(double x, double y) { return fd_copysign(x, y); }
|
||||
inline double pow(double x, double y) { return fd_pow(x, y); }
|
||||
}
|
||||
|
||||
|
||||
#elif defined(linux)
|
||||
|
||||
namespace fd {
|
||||
inline double atan(double x) { return ::atan(x); }
|
||||
inline double atan2(double x, double y) { return ::atan2(x, y); }
|
||||
inline double ceil(double x) { return ::ceil(x); }
|
||||
inline double cos(double x) { return ::cos(x); }
|
||||
inline double fabs(double x) { return ::fabs(x); }
|
||||
inline double floor(double x) { return ::floor(x); }
|
||||
inline double fmod(double x, double y) { return ::fmod(x, y); }
|
||||
inline double sin(double x) { return ::sin(x); }
|
||||
inline double sqrt(double x) { return ::sqrt(x); }
|
||||
inline double tan(double x) { return ::tan(x); }
|
||||
inline double copysign(double x, double y) { return ::copysign(x, y); }
|
||||
}
|
||||
|
||||
namespace fd {
|
||||
extern "C" {
|
||||
double fd_asin __P((double));
|
||||
double fd_acos __P((double));
|
||||
double fd_exp __P((double));
|
||||
double fd_log __P((double));
|
||||
double fd_pow __P((double, double));
|
||||
}
|
||||
inline double asin(double x) { return fd_asin(x); }
|
||||
inline double acos(double x) { return fd_acos(x); }
|
||||
inline double exp(double x) { return fd_exp(x); }
|
||||
inline double log(double x) { return fd_log(x); }
|
||||
inline double pow(double x, double y) { return fd_pow(x, y); }
|
||||
}
|
||||
|
||||
#elif defined(macintosh)
|
||||
|
||||
// the macintosh MSL provides acceptable implementations for all of these.
|
||||
namespace fd {
|
||||
inline double atan(double x) { return ::atan(x); }
|
||||
inline double atan2(double x, double y) { return ::atan2(x, y); }
|
||||
inline double ceil(double x) { return ::ceil(x); }
|
||||
inline double cos(double x) { return ::cos(x); }
|
||||
inline double fabs(double x) { return ::fabs(x); }
|
||||
inline double floor(double x) { return ::floor(x); }
|
||||
inline double fmod(double x, double y) { return ::fmod(x, y); }
|
||||
inline double sin(double x) { return ::sin(x); }
|
||||
inline double sqrt(double x) { return ::sqrt(x); }
|
||||
inline double tan(double x) { return ::tan(x); }
|
||||
inline double copysign(double x, double y) { return ::copysign(x, y); }
|
||||
inline double asin(double x) { return ::asin(x); }
|
||||
inline double acos(double x) { return ::acos(x); }
|
||||
inline double exp(double x) { return ::exp(x); }
|
||||
inline double log(double x) { return ::log(x); }
|
||||
inline double pow(double x, double y) { return ::pow(x, y); }
|
||||
}
|
||||
|
||||
#endif
|
||||
@@ -1,880 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#include "algo.h"
|
||||
#include "formatter.h"
|
||||
|
||||
namespace JS = JavaScript;
|
||||
|
||||
|
||||
static const char controlCharNames[6] = {'b', 't', 'n', 'v', 'f', 'r'};
|
||||
|
||||
// Print the characters from begin to end, escaping them as necessary to make
|
||||
// the resulting string be readable if placed between two quotes specified by
|
||||
// quote (which should be either '\'' or '"').
|
||||
void JS::escapeString(Formatter &f, const char16 *begin, const char16 *end, char16 quote)
|
||||
{
|
||||
ASSERT(begin <= end);
|
||||
|
||||
const char16 *chunk = begin;
|
||||
while (begin != end) {
|
||||
char16 ch = *begin++;
|
||||
CharInfo ci(ch);
|
||||
if (char16Value(ch) < 0x20 || isLineBreak(ci) || isFormat(ci) || ch == '\\' || ch == quote) {
|
||||
if (begin-1 != chunk)
|
||||
printString(f, chunk, begin-1);
|
||||
chunk = begin;
|
||||
|
||||
f << '\\';
|
||||
switch (ch) {
|
||||
case 0x0008:
|
||||
case 0x0009:
|
||||
case 0x000A:
|
||||
case 0x000B:
|
||||
case 0x000C:
|
||||
case 0x000D:
|
||||
f << controlCharNames[ch - 0x0008];
|
||||
break;
|
||||
|
||||
case '\'':
|
||||
case '"':
|
||||
case '\\':
|
||||
f << ch;
|
||||
break;
|
||||
|
||||
case 0x0000:
|
||||
if (begin == end || char16Value(*begin) < '0' || char16Value(*begin) > '9') {
|
||||
f << '0';
|
||||
break;
|
||||
}
|
||||
default:
|
||||
if (char16Value(ch) <= 0xFF) {
|
||||
f << 'x';
|
||||
printHex(f, static_cast<uint32>(char16Value(ch)), 2);
|
||||
} else {
|
||||
f << 'u';
|
||||
printHex(f, static_cast<uint32>(char16Value(ch)), 4);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if (begin != chunk)
|
||||
printString(f, chunk, begin);
|
||||
}
|
||||
|
||||
|
||||
// Print s as a quoted string using the given quotes (which should be
|
||||
// either '\'' or '"').
|
||||
void JS::quoteString(Formatter &f, const String &s, char16 quote)
|
||||
{
|
||||
f << quote;
|
||||
const char16 *begin = s.data();
|
||||
escapeString(f, begin, begin + s.size(), quote);
|
||||
f << quote;
|
||||
}
|
||||
|
||||
|
||||
#ifdef XP_MAC_MPW
|
||||
// Macintosh MPW replacements for the ANSI routines. These translate LF's to
|
||||
// CR's because the MPW libraries supplied by Metrowerks don't do that for some
|
||||
// reason.
|
||||
static void translateLFtoCR(char *begin, char *end)
|
||||
{
|
||||
while (begin != end) {
|
||||
if (*begin == '\n')
|
||||
*begin = '\r';
|
||||
++begin;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
size_t JS::printChars(FILE *file, const char *begin, const char *end)
|
||||
{
|
||||
ASSERT(end >= begin);
|
||||
size_t n = toSize_t(end - begin);
|
||||
size_t extra = 0;
|
||||
char buffer[1024];
|
||||
|
||||
while (n > sizeof buffer) {
|
||||
std::memcpy(buffer, begin, sizeof buffer);
|
||||
translateLFtoCR(buffer, buffer + sizeof buffer);
|
||||
extra += fwrite(buffer, 1, sizeof buffer, file);
|
||||
n -= sizeof buffer;
|
||||
begin += sizeof buffer;
|
||||
}
|
||||
std::memcpy(buffer, begin, n);
|
||||
translateLFtoCR(buffer, buffer + n);
|
||||
return extra + fwrite(buffer, 1, n, file);
|
||||
}
|
||||
|
||||
|
||||
int std::fputc(int c, FILE *file)
|
||||
{
|
||||
char buffer = static_cast<char>(c);
|
||||
if (buffer == '\n')
|
||||
buffer = '\r';
|
||||
return static_cast<int>(fwrite(&buffer, 1, 1, file));
|
||||
}
|
||||
|
||||
|
||||
int std::fputs(const char *s, FILE *file)
|
||||
{
|
||||
return static_cast<int>(printChars(file, s, s + strlen(s)));
|
||||
}
|
||||
|
||||
|
||||
int std::fprintf(FILE* file, const char *format, ...)
|
||||
{
|
||||
Buffer<char, 1024> b;
|
||||
|
||||
while (true) {
|
||||
va_list args;
|
||||
va_start(args, format);
|
||||
int n = vsnprintf(b.buffer, b.size, format, args);
|
||||
va_end(args);
|
||||
if (n >= 0 && n < b.size) {
|
||||
translateLFtoCR(b.buffer, b.buffer + n);
|
||||
return static_cast<int>(fwrite(b.buffer, 1, toSize_t(n), file));
|
||||
}
|
||||
b.expand(b.size*2);
|
||||
}
|
||||
}
|
||||
#endif // XP_MAC_MPW
|
||||
|
||||
|
||||
// Write ch.
|
||||
void JS::Formatter::printChar8(char ch)
|
||||
{
|
||||
printStr8(&ch, &ch + 1);
|
||||
}
|
||||
|
||||
|
||||
// Write ch.
|
||||
void JS::Formatter::printChar16(char16 ch)
|
||||
{
|
||||
printStr16(&ch, &ch + 1);
|
||||
}
|
||||
|
||||
|
||||
// Write the null-terminated string str.
|
||||
void JS::Formatter::printZStr8(const char *str)
|
||||
{
|
||||
printStr8(str, str + strlen(str));
|
||||
}
|
||||
|
||||
|
||||
// Write the String s.
|
||||
void JS::Formatter::printString16(const String &s)
|
||||
{
|
||||
const char16 *begin = s.data();
|
||||
printStr16(begin, begin + s.size());
|
||||
}
|
||||
|
||||
|
||||
// Write the printf format using the supplied args.
|
||||
void JS::Formatter::printVFormat8(const char *format, va_list args)
|
||||
{
|
||||
Buffer<char, 1024> b;
|
||||
|
||||
while (true) {
|
||||
int n = vsnprintf(b.buffer, b.size, format, args);
|
||||
if (n >= 0 && static_cast<uint>(n) < b.size) {
|
||||
printStr8(b.buffer, b.buffer + n);
|
||||
return;
|
||||
}
|
||||
b.expand(b.size*2);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
// Write either "true" or "false".
|
||||
JS::Formatter &JS::Formatter::operator<<(bool b)
|
||||
{
|
||||
printZStr8(b ? "true" : "false");
|
||||
return *this;
|
||||
}
|
||||
|
||||
|
||||
// Write the printf format using the supplied args.
|
||||
void JS::printFormat(Formatter &f, const char *format, ...)
|
||||
{
|
||||
va_list args;
|
||||
va_start(args, format);
|
||||
f.printVFormat8(format, args);
|
||||
va_end(args);
|
||||
}
|
||||
|
||||
|
||||
static const int printCharBufferSize = 64;
|
||||
|
||||
// Print ch count times.
|
||||
void JS::printChar(Formatter &f, char ch, int count)
|
||||
{
|
||||
char str[printCharBufferSize];
|
||||
|
||||
while (count > 0) {
|
||||
int c = count;
|
||||
if (c > printCharBufferSize)
|
||||
c = printCharBufferSize;
|
||||
count -= c;
|
||||
STD::memset(str, ch, toSize_t(c));
|
||||
printString(f, str, str+c);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
// Print ch count times.
|
||||
void JS::printChar(Formatter &f, char16 ch, int count)
|
||||
{
|
||||
char16 str[printCharBufferSize];
|
||||
|
||||
while (count > 0) {
|
||||
int c = count;
|
||||
if (c > printCharBufferSize)
|
||||
c = printCharBufferSize;
|
||||
count -= c;
|
||||
char16 *strEnd = str + c;
|
||||
std::fill(str, strEnd, ch);
|
||||
printString(f, str, strEnd);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
// Print i using the given formatting string, padding on the left with pad
|
||||
// characters to use at least nDigits characters.
|
||||
void JS::printNum(Formatter &f, uint32 i, int nDigits, char pad, const char *format)
|
||||
{
|
||||
char str[20];
|
||||
int n = sprintf(str, format, i);
|
||||
if (n < nDigits)
|
||||
printChar(f, pad, nDigits - n);
|
||||
printString(f, str, str+n);
|
||||
}
|
||||
|
||||
|
||||
// Print p as a pointer.
|
||||
void JS::printPtr(Formatter &f, void *p)
|
||||
{
|
||||
char str[20];
|
||||
int n = sprintf(str, "%p", p);
|
||||
printString(f, str, str+n);
|
||||
}
|
||||
|
||||
|
||||
// printf formats for printing non-ASCII characters on an ASCII stream
|
||||
#ifdef XP_MAC
|
||||
static const char unprintableFormat[] = "\xC7%.4X\xC8"; // Use angle quotes
|
||||
#elif defined _WIN32
|
||||
static const char unprintableFormat[] = "\xAB%.4X\xBB"; // Use angle quotes
|
||||
#else
|
||||
static const char unprintableFormat[] = "<%.4X>";
|
||||
#endif
|
||||
|
||||
|
||||
static const uint16 defaultFilterRanges[] = {
|
||||
0x00, 0x09, // Filter all control characters except \t and \n
|
||||
0x0B, 0x20,
|
||||
0x7F, 0x100, // Filter all non-ASCII characters
|
||||
0, 0
|
||||
};
|
||||
|
||||
JS::BitSet<256> JS::AsciiFileFormatter::defaultFilter(defaultFilterRanges);
|
||||
|
||||
|
||||
// Construct an AsciiFileFormatter using the given file and filter f.
|
||||
// If f is nil, use the default filter.
|
||||
JS::AsciiFileFormatter::AsciiFileFormatter(FILE *file, BitSet<256> *f): file(file)
|
||||
#ifndef _WIN32 // Microsoft Visual C++ 6.0 bug
|
||||
, filter(f ? *f : defaultFilter)
|
||||
#endif
|
||||
{
|
||||
#ifdef _WIN32 // Microsoft Visual C++ 6.0 bug
|
||||
if (f)
|
||||
filter = *f;
|
||||
else
|
||||
filter = defaultFilter;
|
||||
#endif
|
||||
filterEmpty = filter.none();
|
||||
}
|
||||
|
||||
|
||||
// Write ch, escaping non-ASCII characters.
|
||||
void JS::AsciiFileFormatter::printChar8(char ch)
|
||||
{
|
||||
if (filterChar(ch))
|
||||
fprintf(file, unprintableFormat, static_cast<uchar>(ch));
|
||||
else
|
||||
fputc(ch, file);
|
||||
}
|
||||
|
||||
|
||||
// Write ch, escaping non-ASCII characters.
|
||||
void JS::AsciiFileFormatter::printChar16(char16 ch)
|
||||
{
|
||||
if (filterChar(ch))
|
||||
fprintf(file, unprintableFormat, char16Value(ch));
|
||||
else
|
||||
fputc(static_cast<char>(ch), file);
|
||||
}
|
||||
|
||||
|
||||
// Write the null-terminated string str, escaping non-ASCII characters.
|
||||
void JS::AsciiFileFormatter::printZStr8(const char *str)
|
||||
{
|
||||
if (filterEmpty)
|
||||
fputs(str, file);
|
||||
else
|
||||
printStr8(str, str + strlen(str));
|
||||
}
|
||||
|
||||
|
||||
// Write the string between strBegin and strEnd, escaping non-ASCII characters.
|
||||
void JS::AsciiFileFormatter::printStr8(const char *strBegin, const char *strEnd)
|
||||
{
|
||||
if (filterEmpty)
|
||||
printChars(file, strBegin, strEnd);
|
||||
else {
|
||||
ASSERT(strEnd >= strBegin);
|
||||
const char *p = strBegin;
|
||||
while (strBegin != strEnd) {
|
||||
char ch = *strBegin;
|
||||
if (filterChar(ch)) {
|
||||
if (p != strBegin) {
|
||||
printChars(file, p, strBegin);
|
||||
p = strBegin;
|
||||
}
|
||||
fprintf(file, unprintableFormat, static_cast<uchar>(ch));
|
||||
}
|
||||
++strBegin;
|
||||
}
|
||||
if (p != strBegin)
|
||||
printChars(file, p, strBegin);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
// Write the string between strBegin and strEnd, escaping non-ASCII characters.
|
||||
void JS::AsciiFileFormatter::printStr16(const char16 *strBegin, const char16 *strEnd)
|
||||
{
|
||||
char buffer[512];
|
||||
|
||||
ASSERT(strEnd >= strBegin);
|
||||
char *q = buffer;
|
||||
while (strBegin != strEnd) {
|
||||
char16 ch = *strBegin++;
|
||||
if (filterChar(ch)) {
|
||||
if (q != buffer) {
|
||||
printChars(file, buffer, q);
|
||||
q = buffer;
|
||||
}
|
||||
fprintf(file, unprintableFormat, char16Value(ch));
|
||||
} else {
|
||||
*q++ = static_cast<char>(ch);
|
||||
if (q == buffer + sizeof buffer) {
|
||||
printChars(file, buffer, buffer + sizeof buffer);
|
||||
q = buffer;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (q != buffer)
|
||||
printChars(file, buffer, q);
|
||||
}
|
||||
|
||||
|
||||
JS::AsciiFileFormatter JS::stdOut(stdout);
|
||||
JS::AsciiFileFormatter JS::stdErr(stderr);
|
||||
|
||||
|
||||
// Write ch.
|
||||
void JS::StringFormatter::printChar8(char ch)
|
||||
{
|
||||
s += ch;
|
||||
}
|
||||
|
||||
|
||||
// Write ch.
|
||||
void JS::StringFormatter::printChar16(char16 ch)
|
||||
{
|
||||
s += ch;
|
||||
}
|
||||
|
||||
|
||||
// Write the null-terminated string str.
|
||||
void JS::StringFormatter::printZStr8(const char *str)
|
||||
{
|
||||
s += str;
|
||||
}
|
||||
|
||||
|
||||
// Write the string between strBegin and strEnd.
|
||||
void JS::StringFormatter::printStr8(const char *strBegin, const char *strEnd)
|
||||
{
|
||||
appendChars(s, strBegin, strEnd);
|
||||
}
|
||||
|
||||
|
||||
// Write the string between strBegin and strEnd.
|
||||
void JS::StringFormatter::printStr16(const char16 *strBegin, const char16 *strEnd)
|
||||
{
|
||||
s.append(strBegin, strEnd);
|
||||
}
|
||||
|
||||
|
||||
// Write the String str.
|
||||
void JS::StringFormatter::printString16(const String &str)
|
||||
{
|
||||
s += str;
|
||||
}
|
||||
|
||||
|
||||
|
||||
//
|
||||
// Formatted Output
|
||||
//
|
||||
|
||||
// See "Prettyprinting" by Derek Oppen in ACM Transactions on Programming
|
||||
// Languages and Systems 2:4, October 1980, pages 477-482 for the algorithm.
|
||||
|
||||
// The default line width for pretty printing
|
||||
uint32 JS::PrettyPrinter::defaultLineWidth = 20;
|
||||
|
||||
|
||||
// Create a PrettyPrinter that outputs to Formatter f. The PrettyPrinter
|
||||
// breaks lines at optional breaks so as to try not to exceed lines of width
|
||||
// lineWidth, although it may not always be able to do so. Formatter f should
|
||||
// be at the beginning of a line. Call end before destroying the Formatter;
|
||||
// otherwise the last line may not be output to f.
|
||||
JS::PrettyPrinter::PrettyPrinter(Formatter &f, uint32 lineWidth):
|
||||
lineWidth(min(lineWidth, static_cast<uint32>(unlimitedLineWidth))),
|
||||
outputFormatter(f),
|
||||
outputPos(0),
|
||||
lineNum(0),
|
||||
lastBreak(0),
|
||||
margin(0),
|
||||
nNestedBlocks(0),
|
||||
leftSerialPos(0),
|
||||
rightSerialPos(0),
|
||||
itemPool(20)
|
||||
{
|
||||
#ifdef DEBUG
|
||||
topRegion = 0;
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
// Destroy the PrettyPrinter. Because it's a very bad idea for a destructor to
|
||||
// throw exceptions, this destructor does not flush any buffered output. Call
|
||||
// end just before destroying the PrettyPrinter to do that.
|
||||
JS::PrettyPrinter::~PrettyPrinter()
|
||||
{
|
||||
ASSERT(!topRegion && !nNestedBlocks);
|
||||
}
|
||||
|
||||
|
||||
// Output either a line break (if sameLine is false) or length spaces (if
|
||||
// sameLine is true). Also advance leftSerialPos by length.
|
||||
//
|
||||
// If this method throws an exception, it is guaranteed to already have updated
|
||||
// all of the PrettyPrinter state; all that might be missing would be some
|
||||
// output to outputFormatter.
|
||||
void JS::PrettyPrinter::outputBreak(bool sameLine, uint32 length)
|
||||
{
|
||||
leftSerialPos += length;
|
||||
|
||||
if (sameLine) {
|
||||
outputPos += length;
|
||||
// Exceptions may be thrown below.
|
||||
printChar(outputFormatter, ' ', static_cast<int>(length));
|
||||
} else {
|
||||
lastBreak = ++lineNum;
|
||||
outputPos = margin;
|
||||
// Exceptions may be thrown below.
|
||||
outputFormatter << '\n';
|
||||
printChar(outputFormatter, ' ', static_cast<int>(margin));
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
// Check to see whether (rightSerialPos+rightOffset)-leftSerialPos has gotten so large that we may pop items
|
||||
// off the left end of activeItems because their totalLengths are known to be larger than the
|
||||
// amount of space left on the current line.
|
||||
// Return true if there are any items left on activeItems.
|
||||
//
|
||||
// If this method throws an exception, it leaves the PrettyPrinter in a consistent state, having
|
||||
// atomically popped off one or more items from the left end of activeItems.
|
||||
bool JS::PrettyPrinter::reduceLeftActiveItems(uint32 rightOffset)
|
||||
{
|
||||
uint32 newRightSerialPos = rightSerialPos + rightOffset;
|
||||
while (activeItems) {
|
||||
Item *leftItem = &activeItems.front();
|
||||
if (itemStack && leftItem == itemStack.front()) {
|
||||
if (outputPos + newRightSerialPos - leftSerialPos > lineWidth) {
|
||||
itemStack.pop_front();
|
||||
leftItem->lengthKnown = true;
|
||||
leftItem->totalLength = infiniteLength;
|
||||
} else if (leftItem->lengthKnown)
|
||||
itemStack.pop_front();
|
||||
}
|
||||
|
||||
if (!leftItem->lengthKnown)
|
||||
return true;
|
||||
|
||||
activeItems.pop_front();
|
||||
try {
|
||||
uint32 length = leftItem->length;
|
||||
switch (leftItem->kind) {
|
||||
case Item::text:
|
||||
{
|
||||
outputPos += length;
|
||||
leftSerialPos += length;
|
||||
// Exceptions may be thrown below.
|
||||
char16 *textBegin;
|
||||
char16 *textEnd;
|
||||
do {
|
||||
length -= itemText.pop_front(length, textBegin, textEnd);
|
||||
printString(outputFormatter, textBegin, textEnd);
|
||||
} while (length);
|
||||
}
|
||||
break;
|
||||
|
||||
case Item::blockBegin:
|
||||
case Item::indentBlockBegin:
|
||||
{
|
||||
BlockInfo *b = savedBlocks.advance_back();
|
||||
b->margin = margin;
|
||||
b->lastBreak = lastBreak;
|
||||
b->fits = outputPos + leftItem->totalLength <= lineWidth;
|
||||
if (leftItem->hasKind(Item::blockBegin))
|
||||
margin = outputPos;
|
||||
else
|
||||
margin += length;
|
||||
}
|
||||
break;
|
||||
|
||||
case Item::blockEnd:
|
||||
{
|
||||
BlockInfo &b = savedBlocks.pop_back();
|
||||
margin = b.margin;
|
||||
lastBreak = b.lastBreak;
|
||||
}
|
||||
break;
|
||||
|
||||
case Item::indent:
|
||||
margin += length;
|
||||
ASSERT(static_cast<int32>(margin) >= 0);
|
||||
break;
|
||||
|
||||
case Item::linearBreak:
|
||||
// Exceptions may be thrown below, but only after updating the PrettyPrinter.
|
||||
outputBreak(savedBlocks.back().fits, length);
|
||||
break;
|
||||
|
||||
case Item::fillBreak:
|
||||
// Exceptions may be thrown below, but only after updating the PrettyPrinter.
|
||||
outputBreak(lastBreak == lineNum && outputPos + leftItem->totalLength <= lineWidth, length);
|
||||
break;
|
||||
}
|
||||
} catch (...) {
|
||||
itemPool.destroy(leftItem);
|
||||
throw;
|
||||
}
|
||||
itemPool.destroy(leftItem);
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
// A break or end of input is about to be processed. Check whether there are
|
||||
// any complete blocks or clumps on the itemStack whose lengths we can now
|
||||
// compute; if so, compute these and pop them off the itemStack.
|
||||
// The current rightSerialPos must be the beginning of the break or end of input.
|
||||
//
|
||||
// This method can't throw exceptions.
|
||||
void JS::PrettyPrinter::reduceRightActiveItems()
|
||||
{
|
||||
uint32 nUnmatchedBlockEnds = 0;
|
||||
while (itemStack) {
|
||||
Item *rightItem = itemStack.pop_back();
|
||||
switch (rightItem->kind) {
|
||||
case Item::blockBegin:
|
||||
case Item::indentBlockBegin:
|
||||
if (!nUnmatchedBlockEnds) {
|
||||
itemStack.fast_push_back(rightItem);
|
||||
return;
|
||||
}
|
||||
rightItem->computeTotalLength(rightSerialPos);
|
||||
--nUnmatchedBlockEnds;
|
||||
break;
|
||||
|
||||
case Item::blockEnd:
|
||||
++nUnmatchedBlockEnds;
|
||||
break;
|
||||
|
||||
case Item::linearBreak:
|
||||
case Item::fillBreak:
|
||||
rightItem->computeTotalLength(rightSerialPos);
|
||||
if (!nUnmatchedBlockEnds)
|
||||
// There can be at most one consecutive break posted on the itemStack.
|
||||
return;
|
||||
break;
|
||||
|
||||
default:
|
||||
ASSERT(false); // Other kinds can't be pushed onto the itemStack.
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
// Indent the beginning of every new line after this one by offset until the
|
||||
// corresponding endIndent call. Return an Item to pass to endIndent that will
|
||||
// end this indentation. This method may throw an exception, in which case the
|
||||
// PrettyPrinter is left unchanged.
|
||||
JS::PrettyPrinter::Item &JS::PrettyPrinter::beginIndent(int32 offset)
|
||||
{
|
||||
Item *unindent = new(itemPool) Item(Item::indent, static_cast<uint32>(-offset));
|
||||
if (activeItems) {
|
||||
try {
|
||||
activeItems.push_back(*new(itemPool) Item(Item::indent, static_cast<uint32>(offset)));
|
||||
} catch (...) {
|
||||
itemPool.destroy(unindent);
|
||||
throw;
|
||||
}
|
||||
} else {
|
||||
margin += offset;
|
||||
ASSERT(static_cast<int32>(margin) >= 0);
|
||||
}
|
||||
return *unindent;
|
||||
}
|
||||
|
||||
|
||||
// End an indent began by beginIndent. i should be the result of a beginIndent.
|
||||
// This method can't throw exceptions (it's called by the Indent destructor).
|
||||
void JS::PrettyPrinter::endIndent(Item &i)
|
||||
{
|
||||
if (activeItems)
|
||||
activeItems.push_back(i);
|
||||
else {
|
||||
margin += i.length;
|
||||
ASSERT(static_cast<int32>(margin) >= 0);
|
||||
itemPool.destroy(&i);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
// Begin a logical block. If kind is Item::indentBlockBegin, offset is the
|
||||
// indent to use for the second and subsequent lines of this block.
|
||||
// Return an Item to pass to endBlock that will end this block.
|
||||
// This method may throw an exception, in which case the PrettyPrinter is left
|
||||
// unchanged.
|
||||
JS::PrettyPrinter::Item &JS::PrettyPrinter::beginBlock(Item::Kind kind, int32 offset)
|
||||
{
|
||||
uint32 newNNestedBlocks = nNestedBlocks + 1;
|
||||
savedBlocks.reserve(newNNestedBlocks);
|
||||
itemStack.reserve_back(1 + newNNestedBlocks);
|
||||
Item *endItem = new(itemPool) Item(Item::blockEnd);
|
||||
Item *beginItem;
|
||||
try {
|
||||
beginItem = new(itemPool) Item(kind, static_cast<uint32>(offset), rightSerialPos);
|
||||
} catch (...) {
|
||||
itemPool.destroy(endItem);
|
||||
throw;
|
||||
}
|
||||
// No state modifications before this point.
|
||||
// No exceptions after this point.
|
||||
activeItems.push_back(*beginItem);
|
||||
itemStack.fast_push_back(beginItem);
|
||||
nNestedBlocks = newNNestedBlocks;
|
||||
return *endItem;
|
||||
}
|
||||
|
||||
|
||||
// End a logical block began by beginBlock. i should be the result of a
|
||||
// beginBlock.
|
||||
// This method can't throw exceptions (it's called by the Block destructor).
|
||||
void JS::PrettyPrinter::endBlock(Item &i)
|
||||
{
|
||||
activeItems.push_back(i);
|
||||
itemStack.fast_push_back(&i);
|
||||
--nNestedBlocks;
|
||||
}
|
||||
|
||||
|
||||
// Write a conditional line break. This kind of a line break can only be
|
||||
// emitted inside a block.
|
||||
// A linear line break starts a new line if the containing block cannot be put
|
||||
// all one one line; otherwise the line break is replaced by nSpaces spaces.
|
||||
// Typically a block contains several linear breaks; either they all start new
|
||||
// lines or none of them do.
|
||||
// Moreover, if a block directly contains a required break then linear breaks
|
||||
// become required breaks.
|
||||
//
|
||||
// A fill line break starts a new line if either the preceding clump or the
|
||||
// following clump cannot be placed entirely on one line or if the following
|
||||
// clump would not fit on the current line. A clump is a consecutive sequence
|
||||
// of strings and nested blocks delimited by either a break or the beginning or
|
||||
// end of the currently enclosing block.
|
||||
//
|
||||
// If this method throws an exception, it leaves the PrettyPrinter in a
|
||||
// consistent state.
|
||||
void JS::PrettyPrinter::conditionalBreak(uint32 nSpaces, Item::Kind kind)
|
||||
{
|
||||
ASSERT(nSpaces <= unlimitedLineWidth && nNestedBlocks);
|
||||
reduceRightActiveItems();
|
||||
itemStack.reserve_back(1 + nNestedBlocks);
|
||||
// Begin of exception-atomic stack update. Only new(itemPool) can throw
|
||||
// an exception here, in which case nothing is updated.
|
||||
Item *i = new(itemPool) Item(kind, nSpaces, rightSerialPos);
|
||||
activeItems.push_back(*i);
|
||||
itemStack.fast_push_back(i);
|
||||
rightSerialPos += nSpaces;
|
||||
// End of exception-atomic stack update.
|
||||
reduceLeftActiveItems(0);
|
||||
}
|
||||
|
||||
|
||||
// Write the string between strBegin and strEnd. Any embedded newlines ('\n'
|
||||
// only) become required line breaks.
|
||||
//
|
||||
// If this method throws an exception, it may have partially formatted the
|
||||
// string but leaves the PrettyPrinter in a consistent state.
|
||||
void JS::PrettyPrinter::printStr8(const char *strBegin, const char *strEnd)
|
||||
{
|
||||
while (strBegin != strEnd) {
|
||||
const char *sectionEnd = findValue(strBegin, strEnd, '\n');
|
||||
uint32 sectionLength = static_cast<uint32>(sectionEnd - strBegin);
|
||||
if (sectionLength) {
|
||||
if (reduceLeftActiveItems(sectionLength)) {
|
||||
itemText.reserve_back(sectionLength);
|
||||
Item &backItem = activeItems.back();
|
||||
// Begin of exception-atomic update. Only new(itemPool) can throw an exception here,
|
||||
// in which case nothing is updated.
|
||||
if (backItem.hasKind(Item::text))
|
||||
backItem.length += sectionLength;
|
||||
else
|
||||
activeItems.push_back(*new(itemPool) Item(Item::text, sectionLength));
|
||||
rightSerialPos += sectionLength;
|
||||
itemText.fast_append(reinterpret_cast<const uchar *>(strBegin), reinterpret_cast<const uchar *>(sectionEnd));
|
||||
// End of exception-atomic update.
|
||||
} else {
|
||||
ASSERT(!itemStack && !activeItems && !itemText && leftSerialPos == rightSerialPos);
|
||||
outputPos += sectionLength;
|
||||
printString(outputFormatter, strBegin, sectionEnd);
|
||||
}
|
||||
strBegin = sectionEnd;
|
||||
if (strBegin == strEnd)
|
||||
break;
|
||||
}
|
||||
requiredBreak();
|
||||
++strBegin;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
// Write the string between strBegin and strEnd. Any embedded newlines ('\n'
|
||||
// only) become required line breaks.
|
||||
//
|
||||
// If this method throws an exception, it may have partially formatted the
|
||||
// string but leaves the PrettyPrinter in a consistent state.
|
||||
void JS::PrettyPrinter::printStr16(const char16 *strBegin, const char16 *strEnd)
|
||||
{
|
||||
while (strBegin != strEnd) {
|
||||
const char16 *sectionEnd = findValue(strBegin, strEnd, uni::lf);
|
||||
uint32 sectionLength = static_cast<uint32>(sectionEnd - strBegin);
|
||||
if (sectionLength) {
|
||||
if (reduceLeftActiveItems(sectionLength)) {
|
||||
itemText.reserve_back(sectionLength);
|
||||
Item &backItem = activeItems.back();
|
||||
// Begin of exception-atomic update. Only new(itemPool) can throw an exception here,
|
||||
// in which case nothing is updated.
|
||||
if (backItem.hasKind(Item::text))
|
||||
backItem.length += sectionLength;
|
||||
else
|
||||
activeItems.push_back(*new(itemPool) Item(Item::text, sectionLength));
|
||||
rightSerialPos += sectionLength;
|
||||
itemText.fast_append(strBegin, sectionEnd);
|
||||
// End of exception-atomic update.
|
||||
} else {
|
||||
ASSERT(!itemStack && !activeItems && !itemText && leftSerialPos == rightSerialPos);
|
||||
outputPos += sectionLength;
|
||||
printString(outputFormatter, strBegin, sectionEnd);
|
||||
}
|
||||
strBegin = sectionEnd;
|
||||
if (strBegin == strEnd)
|
||||
break;
|
||||
}
|
||||
requiredBreak();
|
||||
++strBegin;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
// Write a required line break.
|
||||
//
|
||||
// If this method throws an exception, it may have emitted partial output but
|
||||
// leaves the PrettyPrinter in a consistent state.
|
||||
void JS::PrettyPrinter::requiredBreak()
|
||||
{
|
||||
reduceRightActiveItems();
|
||||
reduceLeftActiveItems(infiniteLength);
|
||||
ASSERT(!itemStack && !activeItems && !itemText && leftSerialPos == rightSerialPos);
|
||||
outputBreak(false, 0);
|
||||
}
|
||||
|
||||
|
||||
// If required is true, write a required line break; otherwise write a linear
|
||||
// line break of the given width.
|
||||
//
|
||||
// If this method throws an exception, it may have emitted partial output but
|
||||
// leaves the PrettyPrinter in a consistent state.
|
||||
void JS::PrettyPrinter::linearBreak(uint32 nSpaces, bool required)
|
||||
{
|
||||
if (required)
|
||||
requiredBreak();
|
||||
else
|
||||
linearBreak(nSpaces);
|
||||
}
|
||||
|
||||
|
||||
// Flush any saved output in the PrettyPrinter to the output. Call this just
|
||||
// before destroying the PrettyPrinter. All Indent and Block objects must have
|
||||
// been exited already.
|
||||
//
|
||||
// If this method throws an exception, it may have emitted partial output but
|
||||
// leaves the PrettyPrinter in a consistent state.
|
||||
void JS::PrettyPrinter::end()
|
||||
{
|
||||
ASSERT(!topRegion);
|
||||
reduceRightActiveItems();
|
||||
reduceLeftActiveItems(infiniteLength);
|
||||
ASSERT(!savedBlocks && !itemStack && !activeItems && !itemText && rightSerialPos == leftSerialPos && !margin);
|
||||
}
|
||||
@@ -1,320 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifndef formatter_h___
|
||||
#define formatter_h___
|
||||
|
||||
#include <cstdio>
|
||||
#include <cstdarg>
|
||||
|
||||
#include "systemtypes.h"
|
||||
#include "utilities.h"
|
||||
#include "stlcfg.h"
|
||||
#include "ds.h"
|
||||
#include "strings.h"
|
||||
|
||||
namespace JavaScript
|
||||
{
|
||||
//
|
||||
// Output
|
||||
//
|
||||
|
||||
// Print the characters between begin and end to the given file. These
|
||||
// characters may include nulls.
|
||||
size_t printChars(FILE *file, const char *begin, const char *end);
|
||||
|
||||
#ifndef XP_MAC_MPW
|
||||
inline size_t printChars(FILE *file, const char *begin, const char *end) {
|
||||
ASSERT(end >= begin);
|
||||
return STD::fwrite(begin, 1, toSize_t(end - begin), file);
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
// A Formatter is an abstract base class representing a simplified output stream.
|
||||
// One can print text to a Formatter by using << and the various global
|
||||
// print... methods below. Formatters accept both char and char16 text and
|
||||
// convert as appropriate to their actual stream.
|
||||
class Formatter {
|
||||
protected:
|
||||
virtual void printChar8(char ch);
|
||||
virtual void printChar16(char16 ch);
|
||||
virtual void printZStr8(const char *str);
|
||||
virtual void printStr8(const char *strBegin, const char *strEnd) = 0;
|
||||
virtual void printStr16(const char16 *strBegin, const char16 *strEnd) = 0;
|
||||
virtual void printString16(const String &s);
|
||||
virtual void printVFormat8(const char *format, va_list args);
|
||||
public:
|
||||
|
||||
#ifdef __GNUC__ // Workaround for gcc pedantry. No one should be calling delete on a raw Formatter.
|
||||
virtual ~Formatter() {}
|
||||
#endif
|
||||
|
||||
Formatter &operator<<(char ch) {printChar8(ch); return *this;}
|
||||
Formatter &operator<<(char16 ch) {printChar16(ch); return *this;}
|
||||
Formatter &operator<<(const char *str) {printZStr8(str); return *this;}
|
||||
Formatter &operator<<(const String &s) {printString16(s); return *this;}
|
||||
Formatter &operator<<(bool b);
|
||||
Formatter &operator<<(uint8 i) {printFormat(*this, "%u", i); return *this;}
|
||||
Formatter &operator<<(uint32 i) {printFormat(*this, "%u", i); return *this;}
|
||||
Formatter &operator<<(int32 i) {printFormat(*this, "%d", i); return *this;}
|
||||
|
||||
#ifndef _WIN32
|
||||
// Cause compile-time undefined YOU_TRIED_TO_PRINT_A_RAW_POINTER identifier errors for accidental printing of pointers.
|
||||
// The error occurs at the place where you try to instantiate this template; the compiler may or may not tell you where it is.
|
||||
template<class T> Formatter &operator<<(const T *s) {YOU_TRIED_TO_PRINT_A_RAW_POINTER(s); return *this;}
|
||||
#endif
|
||||
|
||||
friend void printString(Formatter &f, const char *strBegin, const char *strEnd) {f.printStr8(strBegin, strEnd);}
|
||||
friend void printString(Formatter &f, const char16 *strBegin, const char16 *strEnd) {f.printStr16(strBegin, strEnd);}
|
||||
friend void printFormat(Formatter &f, const char *format, ...);
|
||||
};
|
||||
|
||||
void printNum(Formatter &f, uint32 i, int nDigits, char pad, const char *format);
|
||||
void printChar(Formatter &f, char ch, int count);
|
||||
void printChar(Formatter &f, char16 ch, int count);
|
||||
inline void printDec(Formatter &f, int32 i, int nDigits = 0, char pad = ' ') {printNum(f, (uint32)i, nDigits, pad, "%i");}
|
||||
inline void printDec(Formatter &f, uint32 i, int nDigits = 0, char pad = ' ') {printNum(f, i, nDigits, pad, "%u");}
|
||||
inline void printHex(Formatter &f, int32 i, int nDigits = 0, char pad = '0') {printNum(f, (uint32)i, nDigits, pad, "%X");}
|
||||
inline void printHex(Formatter &f, uint32 i, int nDigits = 0, char pad = '0') {printNum(f, i, nDigits, pad, "%X");}
|
||||
void printPtr(Formatter &f, void *p);
|
||||
|
||||
|
||||
// An AsciiFileFormatter is a Formatter that prints to a standard ASCII
|
||||
// file or stream. Characters with Unicode values of 256 or higher are
|
||||
// converted to escape sequences. Selected lower characters can also be
|
||||
// converted to escape sequences; these are specified by set bits in the
|
||||
// BitSet passed to the constructor.
|
||||
class AsciiFileFormatter: public Formatter {
|
||||
FILE *file;
|
||||
BitSet<256> filter; // Set of first 256 characters that are to be converted to escape sequences
|
||||
bool filterEmpty; // True if filter passes all 256 characters
|
||||
public:
|
||||
static BitSet<256> defaultFilter; // Default value of filter when not given in the constructor
|
||||
|
||||
explicit AsciiFileFormatter(FILE *file, BitSet<256> *filter = 0);
|
||||
|
||||
private:
|
||||
bool filterChar(char ch) {return filter[static_cast<uchar>(ch)];}
|
||||
bool filterChar(char16 ch) {
|
||||
return char16Value(ch) >= 0x100 || filter[char16Value(ch)];
|
||||
}
|
||||
|
||||
protected:
|
||||
void printChar8(char ch);
|
||||
void printChar16(char16 ch);
|
||||
void printZStr8(const char *str);
|
||||
void printStr8(const char *strBegin, const char *strEnd);
|
||||
void printStr16(const char16 *strBegin, const char16 *strEnd);
|
||||
};
|
||||
|
||||
extern AsciiFileFormatter stdOut;
|
||||
extern AsciiFileFormatter stdErr;
|
||||
|
||||
|
||||
// A StringFormatter is a Formatter that prints to a String.
|
||||
class StringFormatter: public Formatter {
|
||||
String s;
|
||||
|
||||
public:
|
||||
const String& getString() { return s; }
|
||||
void clear() {JavaScript::clear(s);}
|
||||
protected:
|
||||
void printChar8(char ch);
|
||||
void printChar16(char16 ch);
|
||||
void printZStr8(const char *str);
|
||||
void printStr8(const char *strBegin, const char *strEnd);
|
||||
void printStr16(const char16 *strBegin, const char16 *strEnd);
|
||||
void printString16(const String &str);
|
||||
};
|
||||
|
||||
|
||||
//
|
||||
// Formatted Output
|
||||
//
|
||||
|
||||
class PrettyPrinter: public Formatter {
|
||||
public:
|
||||
STATIC_CONST(uint32, unlimitedLineWidth = 0x7FFFFFFF);
|
||||
class Region;
|
||||
class Indent;
|
||||
class Block;
|
||||
|
||||
private:
|
||||
STATIC_CONST(uint32, infiniteLength = 0x80000000);
|
||||
const uint32 lineWidth; // Current maximum desired line width
|
||||
|
||||
struct BlockInfo {
|
||||
uint32 margin; // Saved margin before this block's beginning
|
||||
uint32 lastBreak; // Saved lastBreak before this block's beginning
|
||||
bool fits; // True if this entire block fits on one line
|
||||
};
|
||||
|
||||
// Variables for the back end that prints to the destination
|
||||
Formatter &outputFormatter; // Destination formatter on which the result should be printed
|
||||
uint32 outputPos; // Number of characters printed on current output line
|
||||
uint32 lineNum; // Serial number of current line
|
||||
uint32 lastBreak; // Number of line just after the last break that occurred in this block
|
||||
uint32 margin; // Current left margin in spaces
|
||||
ArrayBuffer<BlockInfo, 20> savedBlocks; // Stack of saved information about partially printed blocks
|
||||
|
||||
// Variables for the front end that calculates block sizes
|
||||
struct Item: ListQueueEntry {
|
||||
enum Kind {text, blockBegin, indentBlockBegin, blockEnd, indent, linearBreak, fillBreak};
|
||||
|
||||
const Kind kind; // The kind of this text sequence
|
||||
bool lengthKnown; // True if totalLength is known; always true for text, blockEnd, and indent Items
|
||||
uint32 length; // Length of this text sequence, number of spaces for this break, or delta for indent or indentBlockBegin
|
||||
uint32 totalLength; // Total length of this block (for blockBegin) or length of this break plus following clump (for breaks);
|
||||
// If lengthKnown is false, this is the serialPos of this Item instead of a length
|
||||
bool hasKind(Kind k) const {return kind == k;}
|
||||
|
||||
explicit Item(Kind kind): kind(kind), lengthKnown(true) {}
|
||||
Item(Kind kind, uint32 length): kind(kind), lengthKnown(true), length(length) {}
|
||||
Item(Kind kind, uint32 length, uint32 beginSerialPos):
|
||||
kind(kind), lengthKnown(false), length(length), totalLength(beginSerialPos) {}
|
||||
|
||||
void computeTotalLength(uint32 endSerialPos) {
|
||||
ASSERT(!lengthKnown);
|
||||
lengthKnown = true;
|
||||
totalLength = endSerialPos - totalLength;
|
||||
}
|
||||
|
||||
};
|
||||
|
||||
#ifdef DEBUG
|
||||
Region *topRegion; // Most deeply nested Region
|
||||
#endif
|
||||
uint32 nNestedBlocks; // Number of nested Blocks
|
||||
|
||||
uint32 leftSerialPos; // The difference rightSerialPos-
|
||||
uint32 rightSerialPos; // leftSerialPos is always the number of characters that would be output by
|
||||
// printing activeItems if they all fit on one line; only the difference
|
||||
// matters -- the absolute values are irrelevant and may wrap around 2^32.
|
||||
|
||||
ArrayQueue<Item *, 20> itemStack; // Stack of enclosing nested Items whose lengths have not yet been determined;
|
||||
// itemStack always has room for at least nNestedBlocks extra entries so that end Items
|
||||
// may be added without throwing an exception.
|
||||
Pool<Item> itemPool; // Pool from which to allocate activeItems
|
||||
ListQueue<Item> activeItems; // Queue of items left to be printed
|
||||
ArrayQueue<char16, 256> itemText; // Text of text items in activeItems, in the same order as in activeItems
|
||||
|
||||
public:
|
||||
static uint32 defaultLineWidth; // Default for lineWidth if not given to the constructor
|
||||
|
||||
explicit PrettyPrinter(Formatter &f, uint32 lineWidth = defaultLineWidth);
|
||||
private:
|
||||
PrettyPrinter(const PrettyPrinter&); // No copy constructor
|
||||
void operator=(const PrettyPrinter&); // No assignment operator
|
||||
public:
|
||||
virtual ~PrettyPrinter();
|
||||
|
||||
private:
|
||||
void outputBreak(bool sameLine, uint32 nSpaces);
|
||||
bool reduceLeftActiveItems(uint32 rightOffset);
|
||||
void reduceRightActiveItems();
|
||||
|
||||
Item &beginIndent(int32 offset);
|
||||
void endIndent(Item &i);
|
||||
|
||||
Item &beginBlock(Item::Kind kind, int32 offset);
|
||||
void endBlock(Item &i);
|
||||
|
||||
void conditionalBreak(uint32 nSpaces, Item::Kind kind);
|
||||
|
||||
protected:
|
||||
void printStr8(const char *strBegin, const char *strEnd);
|
||||
void printStr16(const char16 *strBegin, const char16 *strEnd);
|
||||
public:
|
||||
|
||||
void requiredBreak();
|
||||
void linearBreak(uint32 nSpaces) {conditionalBreak(nSpaces, Item::linearBreak);}
|
||||
void linearBreak(uint32 nSpaces, bool required);
|
||||
void fillBreak(uint32 nSpaces) {conditionalBreak(nSpaces, Item::fillBreak);}
|
||||
|
||||
void end();
|
||||
|
||||
friend class Region;
|
||||
friend class Indent;
|
||||
friend class Block;
|
||||
|
||||
class Region {
|
||||
#ifdef DEBUG
|
||||
Region *next; // Link to next most deeply nested Region
|
||||
#endif
|
||||
protected:
|
||||
PrettyPrinter &pp;
|
||||
|
||||
Region(PrettyPrinter &pp): pp(pp) {DEBUG_ONLY(next = pp.topRegion; pp.topRegion = this;);}
|
||||
private:
|
||||
Region(const Region&); // No copy constructor
|
||||
void operator=(const Region&); // No assignment operator
|
||||
protected:
|
||||
#ifdef DEBUG
|
||||
~Region() {pp.topRegion = next;}
|
||||
#endif
|
||||
};
|
||||
|
||||
// Use an Indent object to temporarily indent a PrettyPrinter by the
|
||||
// offset given to the Indent's constructor. The PrettyPrinter's margin
|
||||
// is set back to its original value when the Indent object is destroyed.
|
||||
// Using an Indent object is exception-safe; no matter how control
|
||||
// leaves an Indent scope, the indent is undone.
|
||||
// Scopes of Indent and Block objects must be properly nested.
|
||||
class Indent: public Region {
|
||||
Item &endItem; // The Item returned by beginIndent
|
||||
public:
|
||||
Indent(PrettyPrinter &pp, int32 offset): Region(pp), endItem(pp.beginIndent(offset)) {}
|
||||
~Indent() {pp.endIndent(endItem);}
|
||||
};
|
||||
|
||||
// Use a Block object to temporarily enter a PrettyPrinter block. If an
|
||||
// offset is provided, line breaks inside the block are indented by that
|
||||
// offset relative to the existing indent; otherwise, line breaks inside
|
||||
// the block are indented to the current output position. The block
|
||||
// lasts until the Block object is destroyed.
|
||||
// Scopes of Indent and Block objects must be properly nested.
|
||||
class Block: public Region {
|
||||
Item &endItem; // The Item returned by beginBlock
|
||||
public:
|
||||
explicit Block(PrettyPrinter &pp): Region(pp), endItem(pp.beginBlock(Item::blockBegin, 0)) {}
|
||||
Block(PrettyPrinter &pp, int32 offset): Region(pp), endItem(pp.beginBlock(Item::indentBlockBegin, offset)) {}
|
||||
~Block() {pp.endBlock(endItem);}
|
||||
};
|
||||
};
|
||||
|
||||
|
||||
void escapeString(Formatter &f, const char16 *begin, const char16 *end, char16 quote);
|
||||
void quoteString(Formatter &f, const String &s, char16 quote);
|
||||
}
|
||||
#endif /* formatter_h___ */
|
||||
@@ -1,151 +0,0 @@
|
||||
// -*- Mode: C++; tab-width: 4; indent-tabs-mode: t; c-basic-offset: 4 -*-
|
||||
//
|
||||
// The contents of this file are subject to the Netscape Public
|
||||
// License Version 1.1 (the "License"); you may not use this file
|
||||
// except in compliance with the License. You may obtain a copy of
|
||||
// the License at http://www.mozilla.org/NPL/
|
||||
//
|
||||
// Software distributed under the License is distributed on an "AS
|
||||
// IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
// implied. See the License for the specific language governing
|
||||
// rights and limitations under the License.
|
||||
//
|
||||
// The Original Code is the JavaScript 2 Prototype.
|
||||
//
|
||||
// The Initial Developer of the Original Code is Netscape
|
||||
// Communications Corporation. Portions created by Netscape are
|
||||
// Copyright (C) 2000 Netscape Communications Corporation. All
|
||||
// Rights Reserved.
|
||||
|
||||
#include <iostream>
|
||||
#include <string>
|
||||
#include <vector>
|
||||
#include <algorithm>
|
||||
|
||||
#include "stlcfg.h"
|
||||
#include "gc_allocator.h"
|
||||
#include "gc_container.h"
|
||||
|
||||
/*
|
||||
namespace JavaScript {
|
||||
|
||||
template <class T>
|
||||
typename gc_allocator<T>::pointer
|
||||
gc_allocator<T>::allocate(gc_allocator<T>::size_type n, const void*)
|
||||
{
|
||||
return static_cast<pointer>(GC_malloc(n*sizeof(T)));
|
||||
}
|
||||
|
||||
template <class T>
|
||||
void gc_allocator<T>::deallocate(gc_allocator<T>::pointer ptr, gc_allocator<T>::size_type)
|
||||
{
|
||||
// this can really be a NO-OP with the GC.
|
||||
// ::GC_free(static_cast<void*>(ptr));
|
||||
}
|
||||
|
||||
}
|
||||
*/
|
||||
|
||||
// test driver for standalone GC development.
|
||||
|
||||
namespace JS = JavaScript;
|
||||
|
||||
template <class T>
|
||||
void* operator new(std::size_t, const JS::gc_allocator<T>& alloc)
|
||||
{
|
||||
return alloc.allocate(1);
|
||||
}
|
||||
|
||||
/**
|
||||
* Define a C++ class that is garbage collectable, and wants to have its destructor
|
||||
* called when it is finalized.
|
||||
*/
|
||||
class A {
|
||||
public:
|
||||
typedef JS::gc_traits_finalizable<A> traits;
|
||||
typedef JS::gc_allocator<A, traits> allocator;
|
||||
friend struct traits;
|
||||
|
||||
static int instances;
|
||||
|
||||
void* operator new(std::size_t)
|
||||
{
|
||||
return allocator::allocate(1);
|
||||
}
|
||||
|
||||
A()
|
||||
{
|
||||
++instances;
|
||||
std::cout << "A::A() here." << std::endl;
|
||||
}
|
||||
|
||||
protected:
|
||||
~A()
|
||||
{
|
||||
--instances;
|
||||
std::cout << "A::~A() here." << std::endl;
|
||||
}
|
||||
|
||||
private:
|
||||
// void operator delete(void*) {}
|
||||
};
|
||||
|
||||
int A::instances = 0;
|
||||
|
||||
int main(int /* argc */, char* /* argv[] */)
|
||||
{
|
||||
using namespace std;
|
||||
using namespace JS;
|
||||
|
||||
cout << "testing the GC allocator." << endl;
|
||||
|
||||
#ifdef XP_MAC
|
||||
// allocate a string, using the GC, and owned by an auto_ptr, that knows how to correctly destroy the string.
|
||||
typedef gc_container<char>::string char_string;
|
||||
typedef gc_allocator<char_string> char_string_alloc;
|
||||
auto_ptr<char_string, char_string_alloc> ptr(new(char_string_alloc()) char_string("This is a garbage collectable string."));
|
||||
const char_string& str = *ptr;
|
||||
cout << str << endl;
|
||||
#endif
|
||||
|
||||
// question, how can we partially evaluate a template?
|
||||
// can we say, typedef template <class T> vector<typename T>.
|
||||
// typedef vector<int, gc_allocator<int> > int_vector;
|
||||
typedef gc_container<int>::vector int_vector;
|
||||
|
||||
// generate 1000 random values.
|
||||
int_vector values;
|
||||
for (int i = 0; i < 1000; ++i) {
|
||||
int value = rand() % 32767;
|
||||
values.push_back(value);
|
||||
// allocate a random amount of garbage.
|
||||
if (!GC_malloc(toSize_t(value)))
|
||||
cerr << "GC_malloc failed." << endl;
|
||||
// allocate an object that has a finalizer to call its destructor.
|
||||
A* a = new A();
|
||||
}
|
||||
|
||||
// run a collection.
|
||||
// gc_allocator<void>::collect();
|
||||
GC_gcollect();
|
||||
|
||||
// print out instance count.
|
||||
cout << "A::instances = " << A::instances << endl;
|
||||
|
||||
// sort the values.
|
||||
sort(values.begin(), values.end());
|
||||
|
||||
// print the values.
|
||||
int_vector::iterator iter = values.begin(), last = values.end();
|
||||
cout << *iter++;
|
||||
while (iter < last)
|
||||
cout << ' ' << *iter++;
|
||||
cout << endl;
|
||||
|
||||
#ifdef XP_MAC
|
||||
// finally, print the string again.
|
||||
cout << str << endl;
|
||||
#endif
|
||||
|
||||
return 0;
|
||||
}
|
||||
@@ -1,214 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifndef gc_allocator_h
|
||||
#define gc_allocator_h
|
||||
|
||||
#include <memory>
|
||||
|
||||
// Microsoft VC6 bug: standard identifiers should be in std namespace
|
||||
#ifndef _WIN32
|
||||
using std::size_t;
|
||||
using std::ptrdiff_t;
|
||||
#endif
|
||||
|
||||
namespace JavaScript {
|
||||
extern "C" {
|
||||
void* GC_malloc(size_t bytes);
|
||||
void* GC_malloc_atomic(size_t bytes);
|
||||
void GC_free(void* ptr);
|
||||
void GC_gcollect(void);
|
||||
|
||||
typedef void (*GC_finalization_proc) (void* obj, void* client_data);
|
||||
void GC_register_finalizer(void* obj, GC_finalization_proc proc,
|
||||
void* client_data,
|
||||
GC_finalization_proc *old_proc,
|
||||
void* *old_client_data);
|
||||
}
|
||||
|
||||
#if 0 && !defined(XP_MAC)
|
||||
// for platforms where GC doesn't exist yet.
|
||||
inline void* GC_malloc(size_t bytes) { return ::operator new(bytes); }
|
||||
inline void* GC_malloc_atomic(size_t bytes) { return ::operator new(bytes); }
|
||||
inline void GC_free(void* ptr) { operator delete(ptr); }
|
||||
inline void GC_gcollect() {}
|
||||
inline void GC_register_finalizer(void* obj, GC_finalization_proc proc,
|
||||
void* client_data,
|
||||
GC_finalization_proc *old_proc,
|
||||
void* *old_client_data) {}
|
||||
#endif
|
||||
|
||||
/**
|
||||
* General case: memory for type must be allocated as a conservatively
|
||||
* scanned block of memory.
|
||||
*/
|
||||
template <class T> struct gc_traits {
|
||||
static T* allocate(size_t n) {
|
||||
return static_cast<T*>(GC_malloc(n * sizeof(T)));
|
||||
}
|
||||
};
|
||||
|
||||
/**
|
||||
* Specializations for blocks of atomic types: the macro define_atomic_type(_type)
|
||||
* specializes gc_traits<T> for types that need not be scanned by the
|
||||
* GC. Implementors are free to define other types as atomic, if they are
|
||||
* guaranteed not to contain pointers.
|
||||
*/
|
||||
#define define_atomic_type(_type) \
|
||||
template <> struct gc_traits<_type> { \
|
||||
static _type* allocate(size_t n) \
|
||||
{ \
|
||||
return static_cast<_type*>(GC_malloc_atomic(n * sizeof(_type))); \
|
||||
} \
|
||||
};
|
||||
|
||||
define_atomic_type(char)
|
||||
define_atomic_type(unsigned char)
|
||||
define_atomic_type(short)
|
||||
define_atomic_type(unsigned short)
|
||||
define_atomic_type(int)
|
||||
define_atomic_type(unsigned int)
|
||||
define_atomic_type(long)
|
||||
define_atomic_type(unsigned long)
|
||||
define_atomic_type(float)
|
||||
define_atomic_type(double)
|
||||
|
||||
#undef define_atomic_type
|
||||
|
||||
/**
|
||||
* Traits for classes that need to have their destructor called
|
||||
* when reclaimed by the garbage collector.
|
||||
*/
|
||||
template <class T> struct gc_traits_finalizable {
|
||||
static void finalizer(void* obj, void* client_data)
|
||||
{
|
||||
T* t = static_cast<T*>(obj);
|
||||
size_t n = reinterpret_cast<size_t>(client_data);
|
||||
for (size_t i = 0; i < n; ++i)
|
||||
t[i].~T();
|
||||
}
|
||||
|
||||
static T* allocate(size_t n)
|
||||
{
|
||||
T* t = gc_traits<T>::allocate(n);
|
||||
GC_finalization_proc old_proc; void* old_client_data;
|
||||
GC_register_finalizer(t, &finalizer, reinterpret_cast<void*>(n),
|
||||
&old_proc, &old_client_data);
|
||||
return t;
|
||||
}
|
||||
};
|
||||
|
||||
/**
|
||||
* An allocator that can be used to allocate objects in the garbage
|
||||
* collected heap.
|
||||
*/
|
||||
template <class T, class traits = gc_traits<T> > class gc_allocator {
|
||||
public:
|
||||
typedef T value_type;
|
||||
typedef size_t size_type;
|
||||
typedef ptrdiff_t difference_type;
|
||||
typedef T *pointer;
|
||||
typedef const T *const_pointer;
|
||||
typedef T &reference;
|
||||
typedef const T &const_reference;
|
||||
|
||||
gc_allocator() {}
|
||||
template<typename U, typename UTraits>
|
||||
gc_allocator(const gc_allocator<U, UTraits>&) {}
|
||||
// ~gc_allocator() {}
|
||||
|
||||
static pointer address(reference r) { return &r; }
|
||||
static const_pointer address(const_reference r) { return &r; }
|
||||
|
||||
static pointer allocate(size_type n, const void* /* hint */ = 0) {
|
||||
return traits::allocate(n);
|
||||
}
|
||||
static void deallocate(pointer, size_type) {}
|
||||
|
||||
static void construct(pointer p, const T &val) { new(p) T(val);}
|
||||
static void destroy(pointer p) { p->~T(); }
|
||||
|
||||
#if defined(__GNUC__) || defined(_WIN32)
|
||||
static size_type max_size() { return size_type(-1) / sizeof(T); }
|
||||
#else
|
||||
static size_type max_size() {
|
||||
return std::numeric_limits<size_type>::max() / sizeof(T);
|
||||
}
|
||||
#endif
|
||||
|
||||
template<class U> struct rebind { typedef gc_allocator<U> other; };
|
||||
|
||||
#ifdef _WIN32
|
||||
// raw byte allocator used on some platforms (grrr).
|
||||
typedef char _Char[1];
|
||||
static char* _Charalloc(size_type n) {
|
||||
return (char*) rebind<_Char>::other::allocate(n);
|
||||
}
|
||||
|
||||
/**
|
||||
* funky operator required for calling basic_string<T> constructor
|
||||
* (grrr).
|
||||
*/
|
||||
template<typename U, typename UTraits>
|
||||
int operator==(const gc_allocator<U, UTraits>&) { return 0; }
|
||||
#endif
|
||||
|
||||
// void* deallocate used on some platforms (grrr).
|
||||
static void deallocate(void*, size_type) {}
|
||||
|
||||
static void collect() { GC_gcollect(); }
|
||||
};
|
||||
|
||||
/**
|
||||
* Generic base class for objects allocated using a gc_allocator. How they
|
||||
* are allocated can be controlled by specializing gc_traits for the
|
||||
* specific class.
|
||||
*/
|
||||
template <typename T> class gc_object {
|
||||
public:
|
||||
void* operator new(size_t) { return gc_allocator<T>::allocate(1, 0); }
|
||||
void operator delete(void* /* ptr */) {}
|
||||
};
|
||||
|
||||
/**
|
||||
* Simpler base class for classes that have no need to specialize allocation
|
||||
* behavior.
|
||||
*/
|
||||
class gc_base {
|
||||
public:
|
||||
void* operator new(size_t n) { return GC_malloc(n); }
|
||||
void operator delete(void*) {}
|
||||
};
|
||||
}
|
||||
|
||||
#endif /* gc_allocator_h */
|
||||
@@ -1,85 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifndef gc_container_h
|
||||
#define gc_container_h
|
||||
|
||||
#include "gc_allocator.h"
|
||||
|
||||
#include <list>
|
||||
#include <vector>
|
||||
#include <string>
|
||||
|
||||
#define LIST std::list
|
||||
#define VECTOR std::vector
|
||||
|
||||
#if defined(__GNUC__)
|
||||
// grr, what kind of standard is this?
|
||||
#define STRING basic_string
|
||||
#define CHAR_TRAITS string_char_traits
|
||||
#else
|
||||
#define STRING std::basic_string
|
||||
#define CHAR_TRAITS std::char_traits
|
||||
#endif
|
||||
|
||||
namespace JavaScript {
|
||||
/**
|
||||
* Rebind some of the basic container types to use a GC_allocator.
|
||||
* What I really want is something more general, something like:
|
||||
* template <typename Container, typename T> class gc_rebind {
|
||||
* typedef typename Container<T, gc_allocator<T> > other;
|
||||
* };
|
||||
* But I can't figure out how to do that with C++ templates.
|
||||
*/
|
||||
template <class T> struct gc_container {
|
||||
typedef typename LIST<T, gc_allocator<T> > list;
|
||||
typedef typename VECTOR<T, gc_allocator<T> > vector;
|
||||
typedef typename STRING<T, CHAR_TRAITS<T>, gc_allocator<T> > string;
|
||||
};
|
||||
|
||||
/**
|
||||
* But, it's pretty easy to do with macros:
|
||||
*/
|
||||
#define GC_CONTAINER(container, type) container<T, gc_allocator<T> >
|
||||
|
||||
/*
|
||||
// this gives an "unimplemented C++ feature" error using CWPro5.
|
||||
// maybe someday.
|
||||
template <template<class, class> typename Container, typename T>
|
||||
struct gc_rebind {
|
||||
typedef typename Container<T, gc_allocator<T> > container;
|
||||
};
|
||||
*/
|
||||
}
|
||||
|
||||
#endif /* gc_container_h */
|
||||
@@ -1,185 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#include "hash.h"
|
||||
#include <new>
|
||||
|
||||
namespace JS = JavaScript;
|
||||
|
||||
|
||||
//
|
||||
// Hash Codes
|
||||
//
|
||||
|
||||
|
||||
// General-purpose null-terminated C string hash function
|
||||
JS::HashNumber JS::hashString(const char *s)
|
||||
{
|
||||
HashNumber h = 0;
|
||||
uchar ch;
|
||||
|
||||
while ((ch = (uchar)*s++) != 0)
|
||||
h = (h >> 28) ^ (h << 4) ^ ch;
|
||||
return h;
|
||||
}
|
||||
|
||||
// General-purpose String hash function
|
||||
JS::HashNumber JS::hashString(const String &s)
|
||||
{
|
||||
HashNumber h = 0;
|
||||
String::const_iterator p = s.begin();
|
||||
String::size_type n = s.size();
|
||||
|
||||
if (n < 16)
|
||||
// Hash every character in a short string.
|
||||
while (n--)
|
||||
h = (h >> 28) ^ (h << 4) ^ *p++;
|
||||
else
|
||||
// Sample a la java.lang.String.hash().
|
||||
for (String::size_type m = n / 8; n >= m; p += m, n -= m)
|
||||
h = (h >> 28) ^ (h << 4) ^ *p;
|
||||
return h;
|
||||
}
|
||||
|
||||
|
||||
//
|
||||
// Hash Tables
|
||||
//
|
||||
|
||||
const uint minLgNBuckets = 4;
|
||||
|
||||
JS::GenericHashTableIterator::GenericHashTableIterator(GenericHashTable &ht):
|
||||
ht(ht), entry(0), nextBucket(ht.buckets)
|
||||
{
|
||||
DEBUG_ONLY(++ht.nReferences);
|
||||
operator++();
|
||||
}
|
||||
|
||||
|
||||
|
||||
JS::GenericHashTableIterator &JS::GenericHashTableIterator::operator++()
|
||||
{
|
||||
GenericHashEntry *e = entry;
|
||||
|
||||
if (e) {
|
||||
backpointer = &e->next;
|
||||
e = e->next;
|
||||
}
|
||||
if (!e) {
|
||||
GenericHashEntry **const bucketsEnd = ht.bucketsEnd;
|
||||
GenericHashEntry **bucket = nextBucket;
|
||||
|
||||
while (bucket != bucketsEnd) {
|
||||
e = *bucket++;
|
||||
if (e) {
|
||||
backpointer = bucket-1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
nextBucket = bucket;
|
||||
}
|
||||
entry = e;
|
||||
return *this;
|
||||
}
|
||||
|
||||
|
||||
JS::GenericHashTable::GenericHashTable(uint32 nEntriesDefault):
|
||||
nEntries(0)
|
||||
{
|
||||
DEBUG_ONLY(nReferences = 0);
|
||||
|
||||
uint lgNBuckets = ceilingLog2(nEntriesDefault);
|
||||
if (lgNBuckets < minLgNBuckets)
|
||||
lgNBuckets = minLgNBuckets;
|
||||
defaultLgNBuckets = lgNBuckets;
|
||||
|
||||
recomputeMinMaxNEntries(lgNBuckets);
|
||||
uint32 nBuckets = JS_BIT(lgNBuckets);
|
||||
buckets = new GenericHashEntry*[nBuckets];
|
||||
// No exceptions after this point unless buckets is deleted.
|
||||
|
||||
bucketsEnd = buckets + nBuckets;
|
||||
zero(buckets, bucketsEnd);
|
||||
}
|
||||
|
||||
|
||||
// Initialize shift, minNEntries, and maxNEntries based on the lg2 of the
|
||||
// number of buckets.
|
||||
void JS::GenericHashTable::recomputeMinMaxNEntries(uint lgNBuckets)
|
||||
{
|
||||
uint32 nBuckets = JS_BIT(lgNBuckets);
|
||||
shift = 32 - lgNBuckets;
|
||||
maxNEntries = nBuckets; // Maximum ratio is 100%
|
||||
// Minimum ratio is 37.5%
|
||||
minNEntries = lgNBuckets <= defaultLgNBuckets ? 0 : 3*(nBuckets>>3);
|
||||
}
|
||||
|
||||
|
||||
// Rehash the table. This method cannot throw out-of-memory exceptions, so it is
|
||||
// safe to call from a destructor.
|
||||
void JS::GenericHashTable::rehash()
|
||||
{
|
||||
uint32 newLgNBuckets = ceilingLog2(nEntries);
|
||||
if (newLgNBuckets < defaultLgNBuckets)
|
||||
newLgNBuckets = defaultLgNBuckets;
|
||||
uint32 newNBuckets = JS_BIT(newLgNBuckets);
|
||||
try {
|
||||
GenericHashEntry **newBuckets = new GenericHashEntry*[newNBuckets];
|
||||
// No exceptions after this point.
|
||||
|
||||
GenericHashEntry **newBucketsEnd = newBuckets + newNBuckets;
|
||||
zero(newBuckets, newBucketsEnd);
|
||||
recomputeMinMaxNEntries(newLgNBuckets);
|
||||
GenericHashEntry **be = bucketsEnd;
|
||||
for (GenericHashEntry **b = buckets; b != be; b++) {
|
||||
GenericHashEntry *e = *b;
|
||||
while (e) {
|
||||
GenericHashEntry *next = e->next;
|
||||
// Place e in the new set of buckets.
|
||||
GenericHashEntry **nb = newBuckets + (e->keyHash*goldenRatio >> shift);
|
||||
e->next = *nb;
|
||||
*nb = e;
|
||||
e = next;
|
||||
}
|
||||
}
|
||||
delete[] buckets;
|
||||
buckets = newBuckets;
|
||||
bucketsEnd = newBucketsEnd;
|
||||
} catch (std::bad_alloc) {
|
||||
// Out of memory. Ignore the error and just relax the resizing boundaries.
|
||||
if (buckets + JS_BIT(newLgNBuckets) > bucketsEnd)
|
||||
maxNEntries >>= 1;
|
||||
else
|
||||
minNEntries <<= 1;
|
||||
}
|
||||
}
|
||||
@@ -1,402 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifndef hash_h___
|
||||
#define hash_h___
|
||||
|
||||
#include "systemtypes.h"
|
||||
#include "utilities.h"
|
||||
#include "strings.h"
|
||||
#include "algo.h"
|
||||
|
||||
namespace JavaScript {
|
||||
|
||||
//
|
||||
// Hash Codes
|
||||
//
|
||||
|
||||
typedef uint32 HashNumber;
|
||||
|
||||
HashNumber hashString(const char *s);
|
||||
HashNumber hashString(const String &s);
|
||||
|
||||
template<class Key>
|
||||
struct Hash {
|
||||
HashNumber operator()(Key key) const;
|
||||
};
|
||||
|
||||
template<class Key>
|
||||
inline HashNumber Hash<Key>::operator()(Key key) const
|
||||
{
|
||||
return hashString(key);
|
||||
}
|
||||
|
||||
const HashNumber goldenRatio = 0x9E3779B9U;
|
||||
|
||||
|
||||
//
|
||||
// Private
|
||||
//
|
||||
|
||||
// Base class for user-defined hash entries.
|
||||
// private
|
||||
class GenericHashEntry {
|
||||
public:
|
||||
GenericHashEntry *next; // Link to next entry in the same bucket
|
||||
const HashNumber keyHash; // This entry's hash value
|
||||
|
||||
protected:
|
||||
explicit GenericHashEntry(HashNumber keyHash): next(0), keyHash(keyHash) {}
|
||||
|
||||
friend class GenericHashTable;
|
||||
};
|
||||
|
||||
|
||||
// private
|
||||
class GenericHashTableIterator;
|
||||
class GenericHashTable {
|
||||
protected:
|
||||
GenericHashEntry **buckets; // Vector of hash buckets
|
||||
GenericHashEntry **bucketsEnd; // Pointer past end of vector of hash buckets
|
||||
uint defaultLgNBuckets; // lg2 of minimum number of buckets for which to size the table
|
||||
uint32 nEntries; // Number of entries in table
|
||||
uint32 minNEntries; // Minimum number of entries without rehashing
|
||||
uint32 maxNEntries; // Maximum number of entries without rehashing
|
||||
uint32 shift; // 32 - lg2(number of buckets)
|
||||
#ifdef DEBUG
|
||||
public:
|
||||
uint32 nReferences; // Number of iterators and references
|
||||
// currently pointing to this hash table
|
||||
#endif
|
||||
|
||||
public:
|
||||
explicit GenericHashTable(uint32 nEntriesDefault);
|
||||
~GenericHashTable() {
|
||||
#ifndef _WIN32
|
||||
ASSERT(nReferences == 0);
|
||||
#endif
|
||||
delete[] buckets;
|
||||
}
|
||||
|
||||
void recomputeMinMaxNEntries(uint lgNBuckets);
|
||||
void rehash();
|
||||
void maybeGrow() {if (nEntries > maxNEntries) rehash();}
|
||||
void maybeShrink() {if (nEntries < minNEntries) rehash();}
|
||||
|
||||
friend class GenericHashTableIterator;
|
||||
|
||||
typedef GenericHashTableIterator Iterator;
|
||||
};
|
||||
|
||||
|
||||
// This ought to be GenericHashTable::Iterator, but this doesn't work
|
||||
// due to a Microsoft VC6 bug.
|
||||
class GenericHashTableIterator {
|
||||
protected:
|
||||
GenericHashTable &ht; // Hash table being iterated
|
||||
GenericHashEntry *entry; // Current entry; nil if done
|
||||
GenericHashEntry **backpointer; // Pointer to pointer to current entry
|
||||
GenericHashEntry **nextBucket; // Next bucket; pointer past end of vector of hash buckets if done
|
||||
public:
|
||||
explicit GenericHashTableIterator(GenericHashTable &ht);
|
||||
~GenericHashTableIterator() {ht.maybeShrink(); DEBUG_ONLY(--ht.nReferences);}
|
||||
|
||||
// Return true if there are entries left.
|
||||
operator bool() const {return entry != 0;}
|
||||
|
||||
GenericHashTableIterator &operator++();
|
||||
};
|
||||
|
||||
|
||||
//
|
||||
// Hash Tables
|
||||
//
|
||||
|
||||
template<class Data, class Key, class H = Hash<Key> >
|
||||
class HashTable: private GenericHashTable {
|
||||
H hasher; // Hash function
|
||||
|
||||
struct Entry: public GenericHashEntry {
|
||||
Data data;
|
||||
|
||||
Entry(HashNumber keyHash, Key key): GenericHashEntry(keyHash), data(key) {}
|
||||
template<class Value>
|
||||
Entry(HashNumber keyHash, Key key, Value value): GenericHashEntry(keyHash), data(key, value) {}
|
||||
};
|
||||
|
||||
public:
|
||||
class Reference {
|
||||
#ifdef _WIN32
|
||||
// Microsoft VC6 bug: friend declarations to inner classes don't work
|
||||
public:
|
||||
#endif
|
||||
Entry *entry; // Current entry; nil if done
|
||||
GenericHashEntry **backpointer; // Pointer to pointer to current entry
|
||||
const HashNumber keyHash; // This entry's key's hash value
|
||||
#ifdef DEBUG
|
||||
GenericHashTable *ht; // Hash table to which this Reference points
|
||||
#endif
|
||||
|
||||
public:
|
||||
#ifndef _WIN32
|
||||
Reference(HashTable &ht, Key key); // Search for an entry with the given key.
|
||||
#else
|
||||
// Microsoft VC6 bug: VC6 doesn't allow this to be defined outside the class
|
||||
Reference(HashTable &ht, Key key): keyHash(ht.hasher(key)) {
|
||||
#ifdef DEBUG
|
||||
Reference::ht = &ht;
|
||||
++ht.nReferences;
|
||||
#endif
|
||||
HashNumber kh = keyHash;
|
||||
HashNumber h = kh*goldenRatio >> ht.shift;
|
||||
GenericHashEntry **bp = ht.buckets + h;
|
||||
Entry *e;
|
||||
|
||||
while ((e = static_cast<Entry *>(*bp)) != 0 && !(e->keyHash == kh && e->data == key))
|
||||
bp = &e->next;
|
||||
entry = e;
|
||||
backpointer = bp;
|
||||
}
|
||||
#endif
|
||||
private:
|
||||
Reference(const Reference&); // No copy constructor
|
||||
void operator=(const Reference&); // No assignment operator
|
||||
public:
|
||||
#if defined(DEBUG) && !defined(_WIN32)
|
||||
~Reference() {if (ht) --ht->nReferences;}
|
||||
#endif
|
||||
|
||||
// Return true if an entry was found.
|
||||
operator bool() const {return entry != 0;}
|
||||
// Return the data of the entry that was found.
|
||||
Data &operator*() const {ASSERT(entry); return entry->data;}
|
||||
|
||||
friend class HashTable;
|
||||
};
|
||||
|
||||
class Iterator: public GenericHashTableIterator {
|
||||
public:
|
||||
explicit Iterator(HashTable &ht): GenericHashTableIterator(ht) {}
|
||||
private:
|
||||
Iterator(const Iterator&); // No copy constructor
|
||||
void operator=(const Iterator&); // No assignment operator
|
||||
public:
|
||||
|
||||
// Go to next entry.
|
||||
Iterator &operator++() {return *static_cast<Iterator*>(&GenericHashTableIterator::operator++());}
|
||||
// Return current entry's data.
|
||||
Data &operator*() const {ASSERT(entry); return static_cast<Entry *>(entry)->data;}
|
||||
|
||||
void erase();
|
||||
|
||||
};
|
||||
|
||||
HashTable(uint32 nEntriesDefault = 0, const H &hasher = H()): GenericHashTable(nEntriesDefault), hasher(hasher) {}
|
||||
~HashTable();
|
||||
|
||||
template<class Value> Data &insert(Reference &r, Key key, Value value);
|
||||
Data &insert(Reference &r, Key key);
|
||||
Data &insert(Key key);
|
||||
void erase(Reference &r);
|
||||
void erase(Key key);
|
||||
Data *operator[](Key key);
|
||||
|
||||
friend class Reference;
|
||||
friend class Iterator;
|
||||
|
||||
#ifndef _WIN32
|
||||
template<class Value> Data &insert(Key key, Value value);
|
||||
#else
|
||||
// Microsoft VC6 bug: VC6 doesn't allow this to be defined outside the
|
||||
// class
|
||||
template<class Value> Data &insert(Key key, Value value) {
|
||||
Reference r(*this, key);
|
||||
if (r)
|
||||
return *r = value;
|
||||
else
|
||||
return insert(r, key, value);
|
||||
}
|
||||
#endif
|
||||
};
|
||||
|
||||
|
||||
//
|
||||
// Implementation
|
||||
//
|
||||
|
||||
template<class Data, class Key, class H>
|
||||
HashTable<Data, Key, H>::~HashTable()
|
||||
{
|
||||
GenericHashEntry **be = bucketsEnd;
|
||||
for (GenericHashEntry **b = buckets; b != be; b++) {
|
||||
Entry *e = static_cast<Entry *>(*b);
|
||||
while (e) {
|
||||
Entry *next = static_cast<Entry *>(e->next);
|
||||
delete e;
|
||||
e = next;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#ifndef _WIN32
|
||||
template<class Data, class Key, class H>
|
||||
HashTable<Data, Key, H>::Reference::Reference(HashTable &ht, Key key):
|
||||
keyHash(ht.hasher(key))
|
||||
{
|
||||
#ifdef DEBUG
|
||||
Reference::ht = &ht;
|
||||
++ht.nReferences;
|
||||
#endif
|
||||
HashNumber kh = keyHash;
|
||||
HashNumber h = kh*goldenRatio >> ht.shift;
|
||||
GenericHashEntry **bp = ht.buckets + h;
|
||||
Entry *e;
|
||||
|
||||
while ((e = static_cast<Entry *>(*bp)) != 0 &&
|
||||
!(e->keyHash == kh && e->data == key))
|
||||
bp = &e->next;
|
||||
entry = e;
|
||||
backpointer = bp;
|
||||
}
|
||||
|
||||
|
||||
// Insert the given key/value pair into the hash table. Reference must
|
||||
// be the result of an unsuccessful search for that key in the table.
|
||||
// The reference is not valid after this method is called.
|
||||
// Return a reference to the new entry's value.
|
||||
template<class Data, class Key, class H> template<class Value>
|
||||
inline Data &HashTable<Data, Key, H>::insert(Reference &r, Key key, Value value)
|
||||
{
|
||||
ASSERT(r.ht == this && !r.entry);
|
||||
Entry *e = new Entry(r.keyHash, key, value);
|
||||
*r.backpointer = e;
|
||||
++nEntries;
|
||||
maybeGrow();
|
||||
#ifdef DEBUG
|
||||
--r.ht->nReferences;
|
||||
r.ht = 0;
|
||||
#endif
|
||||
return e->data;
|
||||
}
|
||||
#endif
|
||||
|
||||
// Same as above but without a Value argument.
|
||||
template<class Data, class Key, class H>
|
||||
inline Data &HashTable<Data, Key, H>::insert(Reference &r, Key key)
|
||||
{
|
||||
ASSERT(r.ht == this && !r.entry);
|
||||
Entry *e = new Entry(r.keyHash, key);
|
||||
*r.backpointer = e;
|
||||
++nEntries;
|
||||
maybeGrow();
|
||||
#ifdef DEBUG
|
||||
--r.ht->nReferences;
|
||||
r.ht = 0;
|
||||
#endif
|
||||
return e->data;
|
||||
}
|
||||
|
||||
|
||||
|
||||
// Insert the given key/value pair into the hash table. If an entry with a
|
||||
// matching key already exists, replace that entry's value.
|
||||
// Return a reference to the new entry's value.
|
||||
#ifndef _WIN32
|
||||
// Microsoft VC6 bug: VC6 doesn't allow this to be defined outside the class
|
||||
template<class Data, class Key, class H> template<class Value>
|
||||
Data &HashTable<Data, Key, H>::insert(Key key, Value value)
|
||||
{
|
||||
Reference r(*this, key);
|
||||
if (r)
|
||||
return *r = value;
|
||||
else
|
||||
return insert(r, key, value);
|
||||
}
|
||||
#endif
|
||||
|
||||
// Same as above but without a Value argument.
|
||||
template<class Data, class Key, class H>
|
||||
Data &HashTable<Data, Key, H>::insert(Key key)
|
||||
{
|
||||
Reference r(*this, key);
|
||||
if (r)
|
||||
return *r;
|
||||
else
|
||||
return insert(r, key);
|
||||
}
|
||||
|
||||
|
||||
// Reference r must point to an existing entry. Delete that entry.
|
||||
// The reference is not valid after this method is called.
|
||||
template<class Data, class Key, class H>
|
||||
inline void HashTable<Data, Key, H>::erase(Reference &r)
|
||||
{
|
||||
Entry *e = r.entry;
|
||||
ASSERT(r.ht == this && e);
|
||||
*r.backpointer = e->next;
|
||||
--nEntries;
|
||||
delete e;
|
||||
#ifdef DEBUG
|
||||
--r.ht->nReferences;
|
||||
r.ht = 0;
|
||||
#endif
|
||||
maybeShrink();
|
||||
}
|
||||
|
||||
|
||||
// Remove the hash table entry, if any, matching the given key.
|
||||
template<class Data, class Key, class H>
|
||||
void HashTable<Data, Key, H>::erase(Key key)
|
||||
{
|
||||
Reference r(*this, key);
|
||||
if (r)
|
||||
erase(r);
|
||||
}
|
||||
|
||||
|
||||
// Return a pointer to the value of the hash table entry matching the given
|
||||
// key. Return nil if no entry matches.
|
||||
template<class Data, class Key, class H>
|
||||
Data *HashTable<Data, Key, H>::operator[](Key key)
|
||||
{
|
||||
Reference r(*this, key);
|
||||
if (r)
|
||||
return &*r;
|
||||
else
|
||||
return 0;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
#endif
|
||||
@@ -1,51 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#include "exception.h"
|
||||
|
||||
namespace JavaScript {
|
||||
|
||||
extern const char* exception_types[];
|
||||
extern const char* exception_msgs[];
|
||||
|
||||
void
|
||||
JSException::toString8 (string8 &rval)
|
||||
{
|
||||
rval = string8(exception_types[mType]) + " Exception: " +
|
||||
string8(exception_msgs[mID]);
|
||||
if (mSource.size() != 0)
|
||||
rval += " in " + mSource;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
@@ -1,115 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifndef exception_h___
|
||||
#define exception_h___
|
||||
#include "utilities.h"
|
||||
|
||||
namespace JavaScript {
|
||||
|
||||
enum ExceptionType {
|
||||
etUnknown = 0,
|
||||
etLexer,
|
||||
etParser,
|
||||
etRuntime,
|
||||
etCount
|
||||
};
|
||||
|
||||
enum ExceptionID {
|
||||
eidExpectBool = 0,
|
||||
eidExpectDouble,
|
||||
eidExpectInt32,
|
||||
eidExpectUInt32,
|
||||
eidExpectRegister,
|
||||
eidExpectArgList,
|
||||
eidExpectColon,
|
||||
eidExpectCloseParen,
|
||||
eidExpectBinaryOp,
|
||||
eidExpectString,
|
||||
eidExpectLabel,
|
||||
eidExpectComma,
|
||||
eidExpectNewline,
|
||||
eidExpectIdentifier,
|
||||
eidDuplicateLabel,
|
||||
eidUnknownICode,
|
||||
eidUnknownBinaryOp,
|
||||
eidUnterminatedString,
|
||||
eidCount
|
||||
};
|
||||
|
||||
class JSException {
|
||||
public:
|
||||
JSException (ExceptionID ID, string8_citer pos = 0,
|
||||
string8 source = "", ExceptionType type = etUnknown)
|
||||
: mID(ID), mType(type), mPos(pos), mSource(source) {}
|
||||
ExceptionID mID;
|
||||
ExceptionType mType;
|
||||
string8_citer mPos;
|
||||
string8 mSource;
|
||||
|
||||
public:
|
||||
void toString8(string8 &rval);
|
||||
/*
|
||||
private:
|
||||
JSException(const JSException&);
|
||||
*/
|
||||
|
||||
};
|
||||
|
||||
class JSLexException : public JSException {
|
||||
public:
|
||||
JSLexException (ExceptionID ID, string8_citer pos = 0,
|
||||
string8 source = "") :
|
||||
JSException(ID, pos, source, etLexer) {}
|
||||
/*
|
||||
private:
|
||||
JSLexException (const JSLexException&);
|
||||
*/
|
||||
};
|
||||
|
||||
class JSParseException : public JSException {
|
||||
public:
|
||||
JSParseException (ExceptionID ID, string8_citer pos = 0,
|
||||
string8 source = "") :
|
||||
JSException(ID, pos, source, etParser) {}
|
||||
/*
|
||||
private:
|
||||
JSParseException (const JSParseException&);
|
||||
*/
|
||||
};
|
||||
|
||||
}
|
||||
|
||||
#endif /* exception_h___ */
|
||||
|
||||
|
||||
@@ -1,235 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <string>
|
||||
|
||||
#include "utilities.h"
|
||||
#include "icodegenerator.h"
|
||||
#include "lexutils.h"
|
||||
#include "icodeasm.h"
|
||||
|
||||
using namespace JavaScript;
|
||||
|
||||
void
|
||||
testAlpha (const string8 &str, const string &expect)
|
||||
{
|
||||
string *result;
|
||||
LexUtils::lexAlpha (str.begin(), str.end(), &result);
|
||||
if (*result == expect)
|
||||
fprintf (stderr, "PASS: ");
|
||||
else
|
||||
fprintf (stderr, "FAIL: ");
|
||||
fprintf (stderr, "string '%s' alpha parsed as '%s'\n", str.c_str(),
|
||||
result->c_str());
|
||||
}
|
||||
|
||||
void
|
||||
testBool (const string8 &str, bool expect)
|
||||
{
|
||||
bool b;
|
||||
LexUtils::lexBool (str.begin(), str.end(), &b);
|
||||
if (b == expect)
|
||||
fprintf (stderr, "PASS: ");
|
||||
else
|
||||
fprintf (stderr, "FAIL: ");
|
||||
fprintf (stderr, "string '%s' bool parsed as %i\n", str.c_str(), b);
|
||||
}
|
||||
|
||||
void
|
||||
testDouble (const string8 &str, double expect)
|
||||
{
|
||||
double result;
|
||||
LexUtils::lexDouble (str.begin(), str.end(), &result);
|
||||
if (result == expect)
|
||||
fprintf (stderr, "PASS: ");
|
||||
else
|
||||
fprintf (stderr, "FAIL: ");
|
||||
fprintf (stderr, "string '%s' double parsed as %f\n", str.c_str(),
|
||||
result);
|
||||
}
|
||||
|
||||
void
|
||||
testString (const string8 &str, const string &expect)
|
||||
{
|
||||
string *result;
|
||||
LexUtils::lexString8 (str.begin(), str.end(), &result);
|
||||
if (*result == expect)
|
||||
fprintf (stderr, "PASS: ");
|
||||
else
|
||||
fprintf (stderr, "FAIL: ");
|
||||
fprintf (stderr, "string '%s' string parsed as '%s'\n", str.c_str(),
|
||||
result->c_str());
|
||||
}
|
||||
|
||||
void
|
||||
testUInt32 (const string8 &str, uint32 expect)
|
||||
{
|
||||
uint32 result;
|
||||
LexUtils::lexUInt32 (str.begin(), str.end(), &result);
|
||||
if (result == expect)
|
||||
fprintf (stderr, "PASS: ");
|
||||
else
|
||||
fprintf (stderr, "FAIL: ");
|
||||
fprintf (stderr, "string '%s' uint32 parsed as %u\n", str.c_str(),
|
||||
result);
|
||||
}
|
||||
|
||||
void
|
||||
testParse (JavaScript::ICodeASM::ICodeParser &icp,
|
||||
JavaScript::Interpreter::Context cx,
|
||||
const string &str)
|
||||
{
|
||||
using namespace JavaScript;
|
||||
|
||||
icp.parseSourceFromString (str);
|
||||
ICG::ICodeModule icm = ICG::ICodeModule (icp.mInstructions,
|
||||
new ICG::VariableList(),
|
||||
new ICG::ParameterList(),
|
||||
icp.mMaxRegister, 0,
|
||||
&JSTypes::Object_Type);
|
||||
|
||||
stdOut << icm;
|
||||
|
||||
JSTypes::JSValues args;
|
||||
cx.interpret (&icm, args);
|
||||
|
||||
}
|
||||
|
||||
static JSTypes::JSValue
|
||||
print(Interpreter::Context *, const JSTypes::JSValues &argv)
|
||||
{
|
||||
size_t n = argv.size();
|
||||
if (n > 1) { // the 'this' parameter is un-interesting
|
||||
stdOut << argv[1];
|
||||
for (size_t i = 2; i < n; ++i)
|
||||
stdOut << ' ' << argv[i];
|
||||
}
|
||||
stdOut << "\n";
|
||||
return JSTypes::kUndefinedValue;
|
||||
}
|
||||
|
||||
int
|
||||
main (int , char **)
|
||||
{
|
||||
World world;
|
||||
JSTypes::JSScope global;
|
||||
|
||||
global.defineNativeFunction(world.identifiers["print"], print);
|
||||
|
||||
Interpreter::Context cx (world, &global);
|
||||
ICodeASM::ICodeParser icp(&cx);
|
||||
|
||||
testAlpha ("False", "False");
|
||||
testAlpha ("fe fi fo fum", "fe");
|
||||
testAlpha (" bla", "");
|
||||
|
||||
testBool ("true", true);
|
||||
testBool ("True", true);
|
||||
testBool ("tRue", true);
|
||||
testBool ("TRUE", true);
|
||||
testBool ("True", true);
|
||||
testBool ("false", false);
|
||||
testBool ("False", false);
|
||||
testBool ("fAlSe", false);
|
||||
testBool ("FALSE", false);
|
||||
testBool ("False", false);
|
||||
|
||||
testDouble ("123", 123);
|
||||
testDouble ("12.3", 12.3);
|
||||
testDouble ("-123", -123);
|
||||
testDouble ("-12.3", -12.3);
|
||||
|
||||
testString ("\"fe fi fo fum\"", "fe fi fo fum");
|
||||
testString ("'the tab is ->\\t<- here'", "the tab is ->\t<- here");
|
||||
testString ("'the newline is ->\\n<- here'", "the newline is ->\n<- here");
|
||||
testString ("'the cr is ->\\r<- here'", "the cr is ->\r<- here");
|
||||
testString ("\"an \\\"escaped\\\" string\"", "an \"escaped\" string");
|
||||
|
||||
testUInt32 ("123", 123);
|
||||
testUInt32 ("12.3", 12);
|
||||
testUInt32 ("-123", 0);
|
||||
testUInt32 ("-12.3", 0);
|
||||
/* XXX what to do with the overflow? */
|
||||
//testUInt32 (icp, "12123687213612873621873438754387934657834", 0);
|
||||
|
||||
string src;
|
||||
|
||||
src =
|
||||
"some_label:\n"
|
||||
"LOAD_STRING R1, 'hello' ;test comment\n"
|
||||
"CAST R2, R1, 'any';another test comment\n"
|
||||
"SAVE_NAME 'x', R2\n"
|
||||
"LOAD_NAME R1, 'x'\n"
|
||||
"LOAD_NAME R2, 'print'\n"
|
||||
"CALL R3, R2, <NaR>, (R1)\n"
|
||||
"RETURN R3";
|
||||
|
||||
testParse (icp, cx, src);
|
||||
|
||||
/* {x= 1; for (i = 10; i > 0; --i) x = x * i; print ("x is " + x);} */
|
||||
src =
|
||||
"LOAD_IMMEDIATE R1, 1\n"
|
||||
"CAST R2, R1, 'any'\n"
|
||||
"SAVE_NAME 'x', R2\n"
|
||||
"LOAD_IMMEDIATE R1, 10\n"
|
||||
"CAST R2, R1, 'any'\n"
|
||||
"SAVE_NAME 'i', R2\n"
|
||||
"BRANCH Offset 16\n"
|
||||
"LOAD_NAME R1, 'x'\n"
|
||||
"LOAD_NAME R2, 'i'\n"
|
||||
"GENERIC_BINARY_OP R3, Multiply, R1, R2\n"
|
||||
"CAST R4, R3, 'any'\n"
|
||||
"SAVE_NAME 'x', R4\n"
|
||||
"LOAD_NAME R1, 'i'\n"
|
||||
"LOAD_IMMEDIATE R2, 1\n"
|
||||
"GENERIC_BINARY_OP R3, Subtract, R1, R2\n"
|
||||
"SAVE_NAME 'i', R3\n"
|
||||
"LOAD_NAME R4, 'i'\n"
|
||||
"LOAD_IMMEDIATE R5, 0\n"
|
||||
"GENERIC_BINARY_OP R6, Less, R5, R4\n"
|
||||
"BRANCH_TRUE Offset 7, R6\n"
|
||||
"LOAD_STRING R1, 'x is '\n"
|
||||
"LOAD_NAME R2, 'x'\n"
|
||||
"GENERIC_BINARY_OP R3, Add, R1, R2\n"
|
||||
"LOAD_NAME R4, 'print'\n"
|
||||
"CALL R5, R4, <NaR>, (R3)\n"
|
||||
"RETURN <NaR>\n";
|
||||
|
||||
testParse (icp, cx, src);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -1,549 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
#include "icodeasm.h"
|
||||
#include "icodemap.h"
|
||||
#include "utilities.h"
|
||||
#include "lexutils.h"
|
||||
#include "exception.h"
|
||||
|
||||
namespace JavaScript {
|
||||
namespace ICodeASM {
|
||||
using namespace LexUtils;
|
||||
|
||||
static char *keyword_offset = "offset";
|
||||
static char *keyword_exprNodeKinds[] = {"add", "subtract", "multiply", "divide",
|
||||
"remainder", "leftshift", "rightshift",
|
||||
"logicalrightshift", "bitwiseor",
|
||||
"bitwisexor", "bitwiseand", "less",
|
||||
"lessorequal", "equal", "identical", 0};
|
||||
static ExprNode::Kind exprNodeOps[] =
|
||||
{ ExprNode::add, ExprNode::subtract, ExprNode::multiply, ExprNode::divide,
|
||||
ExprNode::modulo, ExprNode::leftShift, ExprNode::rightShift,
|
||||
ExprNode::logicalRightShift, ExprNode::bitwiseOr,
|
||||
ExprNode::bitwiseXor, ExprNode::bitwiseAnd, ExprNode::lessThan,
|
||||
ExprNode::lessThanOrEqual, ExprNode::equal, ExprNode::identical };
|
||||
|
||||
void
|
||||
ICodeParser::parseSourceFromString (const string8 &source)
|
||||
{
|
||||
uint statementNo = 0;
|
||||
string8_citer begin = source.begin();
|
||||
string8_citer end = source.end();
|
||||
|
||||
mInstructions = new VM::InstructionStream();
|
||||
mMaxRegister = 0;
|
||||
mInstructionCount = 0;
|
||||
mLabels.clear();
|
||||
mNamedLabels.clear();
|
||||
|
||||
while (begin < end)
|
||||
{
|
||||
try
|
||||
{
|
||||
++statementNo;
|
||||
begin = parseNextStatement (begin, end);
|
||||
}
|
||||
catch (JSException &e)
|
||||
{
|
||||
string8 etext;
|
||||
e.toString8(etext);
|
||||
|
||||
fprintf (stderr, "%s at statement %u\n",
|
||||
etext.c_str(), statementNo);
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
if (begin > end)
|
||||
NOT_REACHED ("Overran source buffer!");
|
||||
}
|
||||
|
||||
/**********************************************************************
|
||||
* operand parse functions (see comment in the .h file) ...
|
||||
*/
|
||||
|
||||
string8_citer
|
||||
ICodeParser::parseArgumentListOperand (string8_citer begin,
|
||||
string8_citer end,
|
||||
VM::ArgumentList **rval)
|
||||
{
|
||||
/* parse argument list on the format "(['argname': ]register[, ...])" */
|
||||
TokenLocation tl = seekTokenStart (begin, end);
|
||||
VM::ArgumentList *al = new VM::ArgumentList();
|
||||
|
||||
if (tl.estimate != teOpenParen)
|
||||
throw JSParseException (eidExpectArgList);
|
||||
|
||||
tl = seekTokenStart (tl.begin + 1, end);
|
||||
StringFormatter s_fmt;
|
||||
while (tl.estimate == teString || tl.estimate == teAlpha) {
|
||||
string *argName = 0;
|
||||
|
||||
if (tl.estimate == teString) {
|
||||
/* look for the argname in quotes */
|
||||
begin = lexString8 (tl.begin, end, &argName);
|
||||
|
||||
/* look for the : */
|
||||
tl = seekTokenStart (begin, end);
|
||||
if (tl.estimate != teColon)
|
||||
throw JSParseException (eidExpectColon);
|
||||
|
||||
/* and now the register */
|
||||
tl = seekTokenStart (tl.begin + 1, end);
|
||||
}
|
||||
|
||||
if (tl.estimate != teAlpha)
|
||||
throw JSParseException (eidExpectRegister);
|
||||
|
||||
JSTypes::Register r;
|
||||
begin = lexRegister (tl.begin, end, &r);
|
||||
if (r != VM::NotARegister && r > mMaxRegister)
|
||||
mMaxRegister = r;
|
||||
|
||||
/* pass 0 (null) as the "type" because it is
|
||||
* not actually used by the interpreter, only in (the current)
|
||||
* codegen (acording to rogerl.)
|
||||
*/
|
||||
VM::TypedRegister tr = VM::TypedRegister(r, 0);
|
||||
|
||||
StringAtom *sap = 0;
|
||||
if (argName) {
|
||||
sap = &(mCx->getWorld().identifiers[argName->c_str()]);
|
||||
delete argName;
|
||||
}
|
||||
else {
|
||||
/* if an argument name was not specified, use the position
|
||||
* to build a default name.
|
||||
*/
|
||||
s_fmt << (uint32)al->size();
|
||||
sap = &(mCx->getWorld().identifiers[s_fmt.getString()]);
|
||||
s_fmt.clear();
|
||||
|
||||
}
|
||||
VM::Argument arg = VM::Argument (tr, sap);
|
||||
|
||||
al->push_back(arg);
|
||||
|
||||
tl = seekTokenStart (begin, end);
|
||||
/* if the next token is a comma,
|
||||
* seek to the next one and go again */
|
||||
if (tl.estimate == teComma) {
|
||||
tl = seekTokenStart (tl.begin + 1, end);
|
||||
}
|
||||
}
|
||||
|
||||
if (tl.estimate != teCloseParen)
|
||||
throw JSParseException (eidExpectCloseParen);
|
||||
|
||||
*rval = al;
|
||||
|
||||
return tl.begin + 1;
|
||||
}
|
||||
|
||||
string8_citer
|
||||
ICodeParser::parseExprNodeKindOperand (string8_citer begin, string8_citer end,
|
||||
ExprNode::Kind *rval)
|
||||
{
|
||||
TokenLocation tl = seekTokenStart (begin, end);
|
||||
|
||||
if (tl.estimate != teAlpha)
|
||||
throw JSParseException (eidExpectBinaryOp);
|
||||
string8 *str;
|
||||
end = lexAlpha (tl.begin, end, &str);
|
||||
|
||||
for (int i = 0; keyword_exprNodeKinds[i] != 0; ++i)
|
||||
if (cmp_nocase (*str, keyword_exprNodeKinds[i], keyword_exprNodeKinds[i] +
|
||||
strlen (keyword_exprNodeKinds[i])) == 0) {
|
||||
*rval = exprNodeOps[i];
|
||||
delete str;
|
||||
return end;
|
||||
}
|
||||
|
||||
delete str;
|
||||
throw JSParseException (eidUnknownBinaryOp);
|
||||
}
|
||||
|
||||
string8_citer
|
||||
ICodeParser::parseBoolOperand (string8_citer begin, string8_citer end,
|
||||
bool *rval)
|
||||
{
|
||||
TokenLocation tl = seekTokenStart (begin, end);
|
||||
|
||||
if (tl.estimate != teAlpha)
|
||||
throw JSParseException (eidExpectBool);
|
||||
|
||||
return lexBool (tl.begin, end, rval);
|
||||
}
|
||||
|
||||
string8_citer
|
||||
ICodeParser::parseDoubleOperand (string8_citer begin, string8_citer end,
|
||||
double *rval)
|
||||
{
|
||||
TokenLocation tl = seekTokenStart (begin, end);
|
||||
|
||||
if ((tl.estimate != teNumeric) && (tl.estimate != teMinus) &&
|
||||
(tl.estimate != tePlus))
|
||||
throw JSParseException (eidExpectDouble);
|
||||
|
||||
return lexDouble (tl.begin, end, rval);
|
||||
}
|
||||
|
||||
string8_citer
|
||||
ICodeParser::parseICodeModuleOperand (string8_citer begin,
|
||||
string8_citer end,
|
||||
VM::ICodeModule **rval)
|
||||
{
|
||||
TokenLocation tl = seekTokenStart (begin, end);
|
||||
|
||||
if (tl.estimate != teString)
|
||||
throw JSParseException (eidExpectString);
|
||||
|
||||
string8 *str;
|
||||
end = lexString8 (tl.begin, end, &str);
|
||||
StringAtom &typename_atom = mCx->getWorld().identifiers[str->c_str()];
|
||||
delete str;
|
||||
JSTypes::JSValue jsv =
|
||||
mCx->getGlobalObject()->getVariable(typename_atom);
|
||||
if (!jsv.isFunction()) {
|
||||
ASSERT(false);
|
||||
}
|
||||
*rval = jsv.function->getICode();
|
||||
|
||||
return end;
|
||||
// NOT_REACHED ("ICode modules are hard, lets go shopping.");
|
||||
// return end;
|
||||
}
|
||||
|
||||
string8_citer
|
||||
ICodeParser::parseJSClassOperand (string8_citer begin,
|
||||
string8_citer end, JSTypes::JSType **rval)
|
||||
{
|
||||
TokenLocation tl = seekTokenStart (begin, end);
|
||||
|
||||
if (tl.estimate != teString)
|
||||
throw JSParseException (eidExpectString);
|
||||
|
||||
string8 *str;
|
||||
end = lexString8 (tl.begin, end, &str);
|
||||
StringAtom &typename_atom = mCx->getWorld().identifiers[str->c_str()];
|
||||
delete str;
|
||||
JSTypes::JSValue jsv =
|
||||
mCx->getGlobalObject()->getVariable(typename_atom);
|
||||
if (jsv.isType())
|
||||
*rval = jsv.type;
|
||||
else
|
||||
*rval = &(JSTypes::Object_Type);
|
||||
|
||||
return end;
|
||||
// NOT_REACHED ("JSClasses are hard, lets go shopping.");
|
||||
// return end;
|
||||
}
|
||||
|
||||
string8_citer
|
||||
ICodeParser::parseJSStringOperand (string8_citer begin, string8_citer end,
|
||||
JSTypes::JSString **rval)
|
||||
{
|
||||
TokenLocation tl = seekTokenStart (begin, end);
|
||||
|
||||
if (tl.estimate != teString)
|
||||
throw JSParseException (eidExpectString);
|
||||
string8 *str;
|
||||
end = lexString8 (tl.begin, end, &str);
|
||||
*rval = new JSTypes::JSString (str->c_str());
|
||||
delete str;
|
||||
return end;
|
||||
}
|
||||
|
||||
string8_citer
|
||||
ICodeParser::parseJSFunctionOperand (string8_citer /*begin*/,
|
||||
string8_citer end,
|
||||
string ** /*rval*/)
|
||||
{
|
||||
NOT_REACHED ("JSFunctions are hard, lets go shopping.");
|
||||
return end;
|
||||
}
|
||||
|
||||
string8_citer
|
||||
ICodeParser::parseJSTypeOperand (string8_citer begin, string8_citer end,
|
||||
JSTypes::JSType **rval)
|
||||
{
|
||||
TokenLocation tl = seekTokenStart (begin, end);
|
||||
|
||||
if (tl.estimate != teString)
|
||||
throw JSParseException (eidExpectString);
|
||||
|
||||
string8 *str;
|
||||
end = lexString8 (tl.begin, end, &str);
|
||||
StringAtom &typename_atom = mCx->getWorld().identifiers[str->c_str()];
|
||||
delete str;
|
||||
JSTypes::JSValue jsv =
|
||||
mCx->getGlobalObject()->getVariable(typename_atom);
|
||||
if (jsv.isType())
|
||||
*rval = jsv.type;
|
||||
else
|
||||
*rval = &(JSTypes::Object_Type);
|
||||
|
||||
return end;
|
||||
}
|
||||
|
||||
string8_citer
|
||||
ICodeParser::parseLabelOperand (string8_citer begin, string8_citer end,
|
||||
VM::Label **rval)
|
||||
{
|
||||
TokenLocation tl = seekTokenStart (begin, end);
|
||||
|
||||
if (tl.estimate != teAlpha)
|
||||
throw JSParseException (eidExpectLabel);
|
||||
|
||||
string8 *str;
|
||||
begin = lexAlpha (tl.begin, end, &str);
|
||||
|
||||
if (cmp_nocase(*str, keyword_offset, keyword_offset +
|
||||
strlen(keyword_offset)) == 0) {
|
||||
delete str;
|
||||
/* got the "Offset" keyword, treat next thing as a jump offset
|
||||
* expressed as "Offset +/-N" */
|
||||
tl = seekTokenStart (begin, end);
|
||||
|
||||
if (tl.estimate != teNumeric)
|
||||
throw JSParseException (eidExpectUInt32);
|
||||
|
||||
uint32 ofs;
|
||||
begin = lexUInt32 (tl.begin, end, &ofs);
|
||||
VM::Label *new_label = new VM::Label(mInstructions);
|
||||
new_label->mOffset = ofs;
|
||||
mLabels.push_back (new_label);
|
||||
*rval = new_label;
|
||||
} else {
|
||||
/* label expressed as "label_name", look for it in the
|
||||
* namedlabels map */
|
||||
LabelMap::const_iterator l = mNamedLabels.find(str->c_str());
|
||||
if (l != mNamedLabels.end()) {
|
||||
/* found the label, use it */
|
||||
*rval = (*l).second;
|
||||
} else {
|
||||
/* havn't seen the label definition yet, put a placeholder
|
||||
* in the namedlabels map */
|
||||
VM::Label *new_label = new VM::Label(mInstructions);
|
||||
new_label->mOffset = VM::NotALabel;
|
||||
*rval = new_label;
|
||||
mNamedLabels[str->c_str()] = new_label;
|
||||
mLabels.push_back (new_label);
|
||||
}
|
||||
delete str;
|
||||
}
|
||||
return begin;
|
||||
}
|
||||
|
||||
string8_citer
|
||||
ICodeParser::parseUInt32Operand (string8_citer begin,
|
||||
string8_citer end, uint32 *rval)
|
||||
{
|
||||
TokenLocation tl = seekTokenStart (begin, end);
|
||||
|
||||
if (tl.estimate != teNumeric)
|
||||
throw JSParseException (eidExpectUInt32);
|
||||
|
||||
return lexUInt32 (tl.begin, end, rval);
|
||||
}
|
||||
|
||||
string8_citer
|
||||
ICodeParser::parseRegisterOperand (string8_citer begin, string8_citer end,
|
||||
JSTypes::Register *rval)
|
||||
{
|
||||
TokenLocation tl = seekTokenStart (begin, end);
|
||||
|
||||
end = lexRegister (tl.begin, end, rval);
|
||||
if (*rval != VM::NotARegister && *rval > mMaxRegister)
|
||||
mMaxRegister = *rval;
|
||||
|
||||
return end;
|
||||
}
|
||||
|
||||
string8_citer
|
||||
ICodeParser::parseStringAtomOperand (string8_citer begin, string8_citer end,
|
||||
StringAtom **rval)
|
||||
{
|
||||
TokenLocation tl = seekTokenStart (begin, end);
|
||||
|
||||
if (tl.estimate != teString)
|
||||
throw JSParseException (eidExpectString);
|
||||
string8 *str;
|
||||
end = lexString8 (tl.begin, end, &str);
|
||||
*rval = &(mCx->getWorld().identifiers[str->c_str()]);
|
||||
delete str;
|
||||
return end;
|
||||
}
|
||||
|
||||
/* "High Level" parse functions ... */
|
||||
string8_citer
|
||||
ICodeParser::parseInstruction (uint icodeID, string8_citer begin,
|
||||
string8_citer end)
|
||||
{
|
||||
string8_citer curpos = begin;
|
||||
StatementNode node;
|
||||
node.icodeID = icodeID;
|
||||
|
||||
# define CASE_TYPE(T, C, CTYPE) \
|
||||
case ot##T: \
|
||||
{ \
|
||||
C rval; \
|
||||
node.operand[i].type = ot##T; \
|
||||
curpos = parse##T##Operand (curpos, end, &rval); \
|
||||
node.operand[i].data = CTYPE<int64>(rval); \
|
||||
break; \
|
||||
}
|
||||
|
||||
for (uint i = 0; i < 4; ++i)
|
||||
{
|
||||
switch (icodemap[icodeID].otype[i])
|
||||
{
|
||||
CASE_TYPE(ArgumentList, VM::ArgumentList *, reinterpret_cast);
|
||||
CASE_TYPE(ExprNodeKind, ExprNode::Kind, static_cast);
|
||||
CASE_TYPE(Bool, bool, static_cast);
|
||||
CASE_TYPE(Double, double, static_cast);
|
||||
CASE_TYPE(ICodeModule, VM::ICodeModule *, reinterpret_cast);
|
||||
CASE_TYPE(JSClass, JSTypes::JSType *, reinterpret_cast);
|
||||
CASE_TYPE(JSString, JSTypes::JSString *, reinterpret_cast);
|
||||
CASE_TYPE(JSFunction, string *, reinterpret_cast);
|
||||
CASE_TYPE(JSType, JSTypes::JSType *, reinterpret_cast);
|
||||
CASE_TYPE(Label, VM::Label *, reinterpret_cast);
|
||||
CASE_TYPE(UInt32, uint32, static_cast);
|
||||
CASE_TYPE(Register, JSTypes::Register, static_cast);
|
||||
CASE_TYPE(StringAtom, StringAtom *, reinterpret_cast);
|
||||
default:
|
||||
node.operand[i].type = otNone;
|
||||
break;
|
||||
}
|
||||
if (i != 3 && icodemap[icodeID].otype[i + 1] != otNone) {
|
||||
/* if the instruction has more arguments, eat a comma and
|
||||
* locate the next token */
|
||||
TokenLocation tl = seekTokenStart (curpos, end);
|
||||
if (tl.estimate != teComma)
|
||||
throw JSParseException (eidExpectComma);
|
||||
tl = seekTokenStart (tl.begin + 1, end);
|
||||
curpos = tl.begin;
|
||||
}
|
||||
}
|
||||
|
||||
# undef CASE_TYPE
|
||||
|
||||
mInstructions->push_back (InstructionFromNode(&node));
|
||||
++mInstructionCount;
|
||||
|
||||
TokenLocation tl = seekTokenStart (curpos, end);
|
||||
if (tl.estimate != teNewline && tl.estimate != teEOF)
|
||||
throw JSParseException (eidExpectNewline);
|
||||
|
||||
if (tl.estimate == teEOF)
|
||||
return tl.begin;
|
||||
else
|
||||
return tl.begin + 1;
|
||||
}
|
||||
|
||||
string8_citer
|
||||
ICodeParser::parseNextStatement (string8_citer begin, string8_citer end)
|
||||
{
|
||||
bool isLabel = false;
|
||||
string8_citer firstTokenEnd = end;
|
||||
TokenLocation tl = seekTokenStart (begin, end);
|
||||
|
||||
if (tl.estimate == teNewline) {
|
||||
/* empty statement, do nothing */
|
||||
return tl.begin + 1;
|
||||
}
|
||||
|
||||
if (tl.estimate != teAlpha)
|
||||
throw JSParseException (eidExpectIdentifier);
|
||||
|
||||
for (string8_citer curpos = tl.begin; curpos < end; ++curpos) {
|
||||
switch (*curpos)
|
||||
{
|
||||
case ':':
|
||||
isLabel = true;
|
||||
firstTokenEnd = ++curpos;
|
||||
goto scan_done;
|
||||
|
||||
default:
|
||||
if (!IS_ALPHA(*curpos)) {
|
||||
firstTokenEnd = curpos;
|
||||
goto scan_done;
|
||||
}
|
||||
}
|
||||
}
|
||||
scan_done:
|
||||
|
||||
if (isLabel) {
|
||||
/* the thing we scanned was a label...
|
||||
* ignore the trailing : */
|
||||
string8 label_str(tl.begin, firstTokenEnd - 1);
|
||||
/* check to see if it was already referenced... */
|
||||
LabelMap::const_iterator l = mNamedLabels.find(label_str.c_str());
|
||||
if (l == mNamedLabels.end()) {
|
||||
/* if it wasn't already referenced, add it */
|
||||
VM::Label *new_label = new VM::Label (mInstructions);
|
||||
new_label->mOffset = mInstructionCount;
|
||||
mNamedLabels[label_str.c_str()] = new_label;
|
||||
mLabels.push_back(new_label);
|
||||
} else {
|
||||
/* if it was already referenced, check to see if the offset
|
||||
* was already set */
|
||||
if ((*l).second->mOffset == VM::NotALabel) {
|
||||
/* offset not set yet, set it and move along */
|
||||
(*l).second->mOffset = mInstructionCount;
|
||||
} else {
|
||||
/* offset was already set, this must be a dupe! */
|
||||
throw JSParseException (eidDuplicateLabel);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
/* the thing we scanned was an instruction, search the icode map
|
||||
* for a matching instruction */
|
||||
string8 icode_str(tl.begin, firstTokenEnd);
|
||||
for (uint i = 0; i < icodemap_size; ++i)
|
||||
if (cmp_nocase(icode_str, &icodemap[i].name[0],
|
||||
&icodemap[i].name[0] +
|
||||
strlen(icodemap[i].name)) == 0)
|
||||
/* if match found, parse it's operands */
|
||||
return parseInstruction (i, firstTokenEnd, end);
|
||||
/* otherwise, choke on it */
|
||||
throw JSParseException (eidUnknownICode);
|
||||
}
|
||||
return firstTokenEnd;
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
@@ -1,160 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
|
||||
#ifdef _WIN32
|
||||
// Microsoft Visual C++ 6.0 whines about name lengths over 255 getting truncated in the browser database
|
||||
#pragma warning(disable : 4786)
|
||||
#endif
|
||||
|
||||
|
||||
#ifndef icodeasm_h___
|
||||
#define icodeasm_h___
|
||||
|
||||
#include <string>
|
||||
#include <iterator>
|
||||
|
||||
#include "vmtypes.h"
|
||||
#include "jstypes.h"
|
||||
#include "interpreter.h"
|
||||
|
||||
namespace JavaScript {
|
||||
namespace ICodeASM {
|
||||
|
||||
enum OperandType {
|
||||
otNone = 0,
|
||||
otArgumentList,
|
||||
otExprNodeKind,
|
||||
otBool,
|
||||
otDouble,
|
||||
otICodeModule,
|
||||
otJSClass,
|
||||
otJSString,
|
||||
otJSFunction,
|
||||
otJSType,
|
||||
otLabel,
|
||||
otUInt32,
|
||||
otRegister,
|
||||
otStringAtom
|
||||
};
|
||||
|
||||
struct AnyOperand {
|
||||
OperandType type;
|
||||
int64 data;
|
||||
/*void *data;*/
|
||||
};
|
||||
|
||||
struct StatementNode {
|
||||
uint icodeID;
|
||||
AnyOperand operand[4];
|
||||
};
|
||||
|
||||
class ICodeParser
|
||||
{
|
||||
private:
|
||||
ICodeParser(const ICodeParser&); /* No copy constructor */
|
||||
|
||||
Interpreter::Context *mCx;
|
||||
uint32 mInstructionCount;
|
||||
VM::LabelList mLabels; /* contains both named *and* unnamed labels */
|
||||
typedef std::map<const char *, VM::Label*> LabelMap;
|
||||
LabelMap mNamedLabels;
|
||||
|
||||
public:
|
||||
uint32 mMaxRegister;
|
||||
VM::InstructionStream *mInstructions;
|
||||
|
||||
public:
|
||||
ICodeParser (Interpreter::Context *aCx) : mCx(aCx), mInstructions(0) {}
|
||||
void parseSourceFromString (const string8 &source);
|
||||
|
||||
/* operand parse functions; These functions take care of finding
|
||||
* the start of the token with |SeekTokenStart|, and checking the
|
||||
* "estimation" (explicit checking takes care of |begin| == |end|,
|
||||
* aka EOF, because EOF is a token estimate.) Once the start of the
|
||||
* token is found, and it is of the expected type, the actual parsing is
|
||||
* carried out by one of the general purpose parse functions.
|
||||
*/
|
||||
string8_citer
|
||||
parseArgumentListOperand (string8_citer begin, string8_citer end,
|
||||
VM::ArgumentList **rval);
|
||||
string8_citer
|
||||
parseExprNodeKindOperand (string8_citer begin, string8_citer end,
|
||||
JavaScript::ExprNode::Kind *rval);
|
||||
string8_citer
|
||||
parseBoolOperand (string8_citer begin, string8_citer end,
|
||||
bool *rval);
|
||||
string8_citer
|
||||
parseDoubleOperand (string8_citer begin, string8_citer end,
|
||||
double *rval);
|
||||
string8_citer
|
||||
parseICodeModuleOperand (string8_citer begin, string8_citer end,
|
||||
VM::ICodeModule **rval);
|
||||
string8_citer
|
||||
parseJSClassOperand (string8_citer begin, string8_citer end,
|
||||
JSTypes::JSType **rval);
|
||||
string8_citer
|
||||
parseJSStringOperand (string8_citer begin, string8_citer end,
|
||||
JSTypes::JSString **rval);
|
||||
string8_citer
|
||||
parseJSFunctionOperand (string8_citer begin, string8_citer end,
|
||||
string8 **rval);
|
||||
string8_citer
|
||||
parseJSTypeOperand (string8_citer begin, string8_citer end,
|
||||
JSTypes::JSType **rval);
|
||||
string8_citer
|
||||
parseLabelOperand (string8_citer begin, string8_citer end,
|
||||
VM::Label **rval);
|
||||
string8_citer
|
||||
parseUInt32Operand (string8_citer begin, string8_citer end,
|
||||
uint32 *rval);
|
||||
string8_citer
|
||||
parseRegisterOperand (string8_citer begin, string8_citer end,
|
||||
JSTypes::Register *rval);
|
||||
string8_citer
|
||||
parseStringAtomOperand (string8_citer begin, string8_citer end,
|
||||
StringAtom **rval);
|
||||
|
||||
/* "high level" parse functions */
|
||||
string8_citer
|
||||
parseInstruction (uint icodeID, string8_citer start,
|
||||
string8_citer end);
|
||||
string8_citer
|
||||
parseNextStatement (string8_citer begin, string8_citer end);
|
||||
|
||||
};
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
#endif /* #ifndef icodeasm_h___ */
|
||||
@@ -1,905 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifdef _WIN32
|
||||
// Turn off warnings about identifiers too long in browser information
|
||||
#pragma warning(disable: 4786)
|
||||
#endif
|
||||
|
||||
#include <algorithm>
|
||||
#include "numerics.h"
|
||||
#include "world.h"
|
||||
#include "vmtypes.h"
|
||||
#include "jstypes.h"
|
||||
#include "jsclasses.h"
|
||||
#include "icodegenerator.h"
|
||||
#include "interpreter.h"
|
||||
#include "exception.h"
|
||||
#include "icodeasm.h"
|
||||
|
||||
#include <stdexcept>
|
||||
#include <stdio.h>
|
||||
|
||||
namespace JavaScript {
|
||||
namespace ICG {
|
||||
|
||||
using namespace VM;
|
||||
using namespace JSTypes;
|
||||
using namespace JSClasses;
|
||||
using namespace Interpreter;
|
||||
using namespace ICodeASM;
|
||||
|
||||
inline char narrow(char16 ch) { return char(ch); }
|
||||
|
||||
|
||||
uint32 ICodeModule::sMaxID = 0;
|
||||
|
||||
Formatter& operator<<(Formatter &f, ICodeGenerator &i)
|
||||
{
|
||||
return i.print(f);
|
||||
}
|
||||
|
||||
Formatter& operator<<(Formatter &f, ICodeModule &i)
|
||||
{
|
||||
return i.print(f);
|
||||
}
|
||||
|
||||
//
|
||||
// ICodeGenerator
|
||||
//
|
||||
|
||||
|
||||
ICodeGenerator::ICodeGenerator(Context *cx,
|
||||
ICodeGenerator *containingFunction,
|
||||
JSClass *aClass,
|
||||
ICodeGeneratorFlags flags,
|
||||
JSType *resultType)
|
||||
: mTopRegister(0),
|
||||
mExceptionRegister(TypedRegister(NotARegister, &None_Type)),
|
||||
variableList(new VariableList()),
|
||||
parameterList(new ParameterList()),
|
||||
mContext(cx),
|
||||
mInstructionMap(new InstructionMap()),
|
||||
mClass(aClass),
|
||||
mFlags(flags),
|
||||
pLabels(NULL),
|
||||
mInitName(cx->getWorld().identifiers["__init__"]),
|
||||
mContainingFunction(containingFunction),
|
||||
mResultType(resultType)
|
||||
{
|
||||
iCode = new InstructionStream();
|
||||
iCodeOwner = true;
|
||||
}
|
||||
|
||||
/*
|
||||
-Called to allocate parameter and variable registers, aka 'permanent' registers.
|
||||
-mTopRegister is the current high-water mark.
|
||||
-mPermanentRegister marks those registers given to variables/parameters.
|
||||
-Theoretically, mPermanentRegister[n] can be become false when a scope ends and
|
||||
the registers allocated to contained variables are then available for re-use.
|
||||
-Mostly the need is to handle overlapping allocation of temps & permanents as the
|
||||
variables' declarations are encountered. This wouldn't be necessary if a function
|
||||
presented a list of all variables, or a pre-pass executed to discover same.
|
||||
*/
|
||||
TypedRegister ICodeGenerator::allocateRegister(JSType *type)
|
||||
{
|
||||
Register r = mTopRegister;
|
||||
while (r < mPermanentRegister.size())
|
||||
if (!mPermanentRegister[r])
|
||||
break;
|
||||
else
|
||||
++r;
|
||||
if (r == mPermanentRegister.size())
|
||||
mPermanentRegister.resize(r + 1);
|
||||
mPermanentRegister[r] = true;
|
||||
|
||||
TypedRegister result(r, type);
|
||||
mTopRegister = ++r;
|
||||
return result;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::allocateVariable(const StringAtom& name, const StringAtom& typeName)
|
||||
{
|
||||
return allocateVariable(name, mContext->findType(typeName));
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::allocateParameter(const StringAtom& name, bool isOptional, const StringAtom& typeName)
|
||||
{
|
||||
return allocateParameter(name, isOptional, mContext->findType(typeName));
|
||||
}
|
||||
|
||||
ICodeModule *ICodeGenerator::complete()
|
||||
{
|
||||
#ifdef DEBUG
|
||||
for (LabelList::iterator i = labels.begin();
|
||||
i != labels.end(); i++) {
|
||||
ASSERT((*i)->mBase == iCode);
|
||||
ASSERT((*i)->mOffset <= iCode->size());
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
if (iCode->size()) {
|
||||
ICodeOp lastOp = (*iCode)[iCode->size() - 1]->op();
|
||||
if ((lastOp != RETURN) && (lastOp != RETURN_VOID))
|
||||
returnStmt();
|
||||
}
|
||||
else
|
||||
returnStmt();
|
||||
|
||||
|
||||
/*
|
||||
XXX FIXME
|
||||
I wanted to do the following rather than have to have the label set hanging around as well
|
||||
as the ICodeModule. Branches have since changed, but the concept is still good and should
|
||||
be re-introduced at some point.
|
||||
|
||||
for (InstructionIterator ii = iCode->begin();
|
||||
ii != iCode->end(); ii++) {
|
||||
if ((*ii)->op() == BRANCH) {
|
||||
Instruction *t = *ii;
|
||||
*ii = new ResolvedBranch(static_cast<Branch *>(*ii)->operand1->itsOffset);
|
||||
delete t;
|
||||
}
|
||||
else
|
||||
if ((*ii)->itsOp >= BRANCH_LT && (*ii)->itsOp <= BRANCH_GT) {
|
||||
Instruction *t = *ii;
|
||||
*ii = new ResolvedBranchCond((*ii)->itsOp,
|
||||
static_cast<BranchCond *>(*ii)->itsOperand1->itsOffset,
|
||||
static_cast<BranchCond *>(*ii)->itsOperand2);
|
||||
delete t;
|
||||
}
|
||||
}
|
||||
*/
|
||||
ICodeModule* module = new ICodeModule(*this);
|
||||
if (pLabels) {
|
||||
uint32 i;
|
||||
uint32 parameterInits = pLabels->size() - 1; // there's an extra label at the end for the actual entryPoint
|
||||
module->mParameterInit = new uint32[parameterInits];
|
||||
for (i = 0; i < parameterInits; i++) {
|
||||
module->mParameterInit[i] = (*pLabels)[i]->mOffset;
|
||||
}
|
||||
module->mEntryPoint = (*pLabels)[i]->mOffset;
|
||||
}
|
||||
iCodeOwner = false; // give ownership to the module.
|
||||
return module;
|
||||
}
|
||||
|
||||
|
||||
/********************************************************************/
|
||||
|
||||
TypedRegister ICodeGenerator::loadImmediate(double value)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Number_Type);
|
||||
LoadImmediate *instr = new LoadImmediate(dest, value);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::loadString(const String &value)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &String_Type);
|
||||
LoadString *instr = new LoadString(dest, new JSString(value));
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::loadString(const StringAtom &value)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &String_Type);
|
||||
LoadString *instr = new LoadString(dest, new JSString(value));
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::loadBoolean(bool value)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Boolean_Type);
|
||||
if (value)
|
||||
iCode->push_back(new LoadTrue(dest));
|
||||
else
|
||||
iCode->push_back(new LoadFalse(dest));
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::loadNull()
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
iCode->push_back(new LoadNull(dest));
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::loadType(JSType *type)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), type);
|
||||
iCode->push_back(new LoadType(dest, type));
|
||||
return dest;
|
||||
}
|
||||
|
||||
|
||||
TypedRegister ICodeGenerator::newObject(TypedRegister constructor)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
NewObject *instr = new NewObject(dest, constructor);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::newClass(JSClass *clazz)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
NewClass *instr = new NewClass(dest, clazz);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::genericNew(TypedRegister target, ArgumentList *args)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
NewGeneric *instr = new NewGeneric(dest, target, args);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::newFunction(ICodeModule *icm)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Function_Type);
|
||||
NewFunction *instr = new NewFunction(dest, icm);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::newArray()
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Array_Type);
|
||||
NewArray *instr = new NewArray(dest);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::dotClass(TypedRegister base)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Type_Type);
|
||||
Class *instr = new Class(dest, base);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::instanceOf(TypedRegister base, TypedRegister type)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Boolean_Type);
|
||||
Instanceof *instr = new Instanceof(dest, base, type);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::is(TypedRegister base, TypedRegister type)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Boolean_Type);
|
||||
Is *instr = new Is(dest, base, type);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
|
||||
TypedRegister ICodeGenerator::loadName(const StringAtom &name, JSType *t)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), t);
|
||||
LoadName *instr = new LoadName(dest, &name);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
void ICodeGenerator::saveName(const StringAtom &name, TypedRegister value)
|
||||
{
|
||||
SaveName *instr = new SaveName(&name, value);
|
||||
iCode->push_back(instr);
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::nameXcr(const StringAtom &name, ICodeOp op)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Number_Type);
|
||||
NameXcr *instr = new NameXcr(dest, &name, (op == ADD) ? 1.0 : -1.0);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
|
||||
|
||||
TypedRegister ICodeGenerator::varXcr(TypedRegister var, ICodeOp op)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Number_Type);
|
||||
VarXcr *instr = new VarXcr(dest, var, (op == ADD) ? 1.0 : -1.0);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
|
||||
TypedRegister ICodeGenerator::getField(TypedRegister base, TypedRegister field)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
GetField *instr = new GetField(dest, base, field);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
void ICodeGenerator::setField(TypedRegister base, TypedRegister field,
|
||||
TypedRegister value)
|
||||
{
|
||||
SetField *instr = new SetField(base, field, value);
|
||||
iCode->push_back(instr);
|
||||
}
|
||||
|
||||
|
||||
TypedRegister ICodeGenerator::deleteProperty(TypedRegister base, const StringAtom &name)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
DeleteProp *instr = new DeleteProp(dest, base, &name);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::getProperty(TypedRegister base, const StringAtom &name)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
GetProp *instr = new GetProp(dest, base, &name);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
void ICodeGenerator::setProperty(TypedRegister base, const StringAtom &name,
|
||||
TypedRegister value)
|
||||
{
|
||||
SetProp *instr = new SetProp(base, &name, value);
|
||||
iCode->push_back(instr);
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::propertyXcr(TypedRegister base, const StringAtom &name, ICodeOp op)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
PropXcr *instr = new PropXcr(dest, base, &name, (op == ADD) ? 1.0 : -1.0);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
|
||||
static const JSSlot& getStaticSlot(JSClass *&c, const String &name)
|
||||
{
|
||||
if (c->hasStatic(name))
|
||||
return c->getStatic(name);
|
||||
c = c->getSuperClass();
|
||||
ASSERT(c);
|
||||
return getStaticSlot(c, name);
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::getStatic(JSClass *base, const String &name)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
const JSSlot& slot = getStaticSlot(base, name);
|
||||
GetStatic *instr = new GetStatic(dest, base, slot.mIndex);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
void ICodeGenerator::setStatic(JSClass *base, const StringAtom &name,
|
||||
TypedRegister value)
|
||||
{
|
||||
const JSSlot& slot = getStaticSlot(base, name);
|
||||
SetStatic *instr = new SetStatic(base, slot.mIndex, value);
|
||||
iCode->push_back(instr);
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::staticXcr(JSClass *base, const StringAtom &name, ICodeOp /*op*/)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
const JSSlot& slot = getStaticSlot(base, name);
|
||||
StaticXcr *instr = new StaticXcr(dest, base, slot.mIndex, 1.0);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
|
||||
|
||||
TypedRegister ICodeGenerator::getSlot(TypedRegister base, uint32 slot)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
GetSlot *instr = new GetSlot(dest, base, slot);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
void ICodeGenerator::setSlot(TypedRegister base, uint32 slot,
|
||||
TypedRegister value)
|
||||
{
|
||||
SetSlot *instr = new SetSlot(base, slot, value);
|
||||
iCode->push_back(instr);
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::slotXcr(TypedRegister base, uint32 slot, ICodeOp op)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
SlotXcr *instr = new SlotXcr(dest, base, slot, (op == ADD) ? 1.0 : -1.0);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
TypedRegister ICodeGenerator::getElement(TypedRegister base, TypedRegister index)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
GetElement *instr = new GetElement(dest, base, index);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
void ICodeGenerator::setElement(TypedRegister base, TypedRegister index,
|
||||
TypedRegister value)
|
||||
{
|
||||
SetElement *instr = new SetElement(base, index, value);
|
||||
iCode->push_back(instr);
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::elementXcr(TypedRegister base, TypedRegister index, ICodeOp op)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Number_Type);
|
||||
ElemXcr *instr = new ElemXcr(dest, base, index, (op == ADD) ? 1.0 : -1.0);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
|
||||
|
||||
TypedRegister ICodeGenerator::op(ICodeOp op, TypedRegister source)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
ASSERT(source.first != NotARegister);
|
||||
Unary *instr = new Unary (op, dest, source);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
|
||||
void ICodeGenerator::move(TypedRegister destination, TypedRegister source)
|
||||
{
|
||||
ASSERT(destination.first != NotARegister);
|
||||
ASSERT(source.first != NotARegister);
|
||||
Move *instr = new Move(destination, source);
|
||||
iCode->push_back(instr);
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::logicalNot(TypedRegister source)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
Not *instr = new Not(dest, source);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::test(TypedRegister source)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
Test *instr = new Test(dest, source);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::op(ICodeOp op, TypedRegister source1,
|
||||
TypedRegister source2)
|
||||
{
|
||||
ASSERT(source1.first != NotARegister);
|
||||
ASSERT(source2.first != NotARegister);
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
Arithmetic *instr = new Arithmetic(op, dest, source1, source2);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::binaryOp(ICodeOp dblOp, JSTypes::Operator op, TypedRegister source1,
|
||||
TypedRegister source2)
|
||||
{
|
||||
ASSERT(source1.first != NotARegister);
|
||||
ASSERT(source2.first != NotARegister);
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
|
||||
if ((source1.second == &Number_Type) && (source2.second == &Number_Type)) {
|
||||
Arithmetic *instr = new Arithmetic(dblOp, dest, source1, source2);
|
||||
iCode->push_back(instr);
|
||||
}
|
||||
else {
|
||||
GenericBinaryOP *instr = new GenericBinaryOP(dest, op, source1, source2);
|
||||
iCode->push_back(instr);
|
||||
}
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::unaryOp(JSTypes::Operator op, TypedRegister source)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
GenericUnaryOP *instr = new GenericUnaryOP(dest, op, source);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::xcrementOp(JSTypes::Operator op, TypedRegister source)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
GenericXcrementOP *instr = new GenericXcrementOP(dest, op, source);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::call(TypedRegister target, ArgumentList *args)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
DirectCall *instr = new DirectCall(dest, target, args);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::invokeCallOp(TypedRegister target, ArgumentList *args)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
InvokeCall *instr = new InvokeCall(dest, target, args);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
/*
|
||||
TypedRegister ICodeGenerator::directCall(JSFunction *target, ArgumentList *args)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
DirectCall *instr = new DirectCall(dest, target, args);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
*/
|
||||
TypedRegister ICodeGenerator::bindThis(TypedRegister thisArg, TypedRegister target)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Function_Type);
|
||||
iCode->push_back(new BindThis(dest, thisArg, target));
|
||||
return dest;
|
||||
}
|
||||
|
||||
|
||||
TypedRegister ICodeGenerator::getClosure(uint32 count)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
iCode->push_back(new GetClosure(dest, count));
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::newClosure(ICodeModule *icm)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Function_Type);
|
||||
iCode->push_back(new NewClosure(dest, icm));
|
||||
return dest;
|
||||
}
|
||||
|
||||
|
||||
TypedRegister ICodeGenerator::getMethod(TypedRegister thisArg, uint32 slotIndex)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
GetMethod *instr = new GetMethod(dest, thisArg, slotIndex);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::super()
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), &Object_Type);
|
||||
Super *instr = new Super(dest);
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
TypedRegister ICodeGenerator::cast(TypedRegister arg, JSType *toType)
|
||||
{
|
||||
TypedRegister dest(getTempRegister(), toType);
|
||||
Cast *instr = new Cast(dest, arg, loadType(toType));
|
||||
iCode->push_back(instr);
|
||||
return dest;
|
||||
}
|
||||
|
||||
void ICodeGenerator::branch(Label *label)
|
||||
{
|
||||
Branch *instr = new Branch(label);
|
||||
iCode->push_back(instr);
|
||||
}
|
||||
|
||||
GenericBranch *ICodeGenerator::branchTrue(Label *label, TypedRegister condition)
|
||||
{
|
||||
GenericBranch *instr = new GenericBranch(BRANCH_TRUE, label, condition);
|
||||
iCode->push_back(instr);
|
||||
return instr;
|
||||
}
|
||||
|
||||
GenericBranch *ICodeGenerator::branchFalse(Label *label, TypedRegister condition)
|
||||
{
|
||||
GenericBranch *instr = new GenericBranch(BRANCH_FALSE, label, condition);
|
||||
iCode->push_back(instr);
|
||||
return instr;
|
||||
}
|
||||
|
||||
GenericBranch *ICodeGenerator::branchInitialized(Label *label, TypedRegister condition)
|
||||
{
|
||||
GenericBranch *instr = new GenericBranch(BRANCH_INITIALIZED, label, condition);
|
||||
iCode->push_back(instr);
|
||||
return instr;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
void ICodeGenerator::returnStmt(TypedRegister r)
|
||||
{
|
||||
iCode->push_back(new Return(r));
|
||||
}
|
||||
|
||||
void ICodeGenerator::returnStmt()
|
||||
{
|
||||
iCode->push_back(new ReturnVoid());
|
||||
}
|
||||
|
||||
|
||||
/********************************************************************/
|
||||
|
||||
Label *ICodeGenerator::getLabel()
|
||||
{
|
||||
labels.push_back(new Label(NULL));
|
||||
return labels.back();
|
||||
}
|
||||
|
||||
Label *ICodeGenerator::setLabel(Label *l)
|
||||
{
|
||||
l->mBase = iCode;
|
||||
l->mOffset = iCode->size();
|
||||
return l;
|
||||
}
|
||||
|
||||
|
||||
Formatter& ICodeGenerator::print(Formatter& f)
|
||||
{
|
||||
f << "ICG! " << (uint32)iCode->size() << "\n";
|
||||
VM::operator<<(f, *iCode);
|
||||
f << " Src : Instr" << "\n";
|
||||
for (InstructionMap::iterator i = mInstructionMap->begin(); i != mInstructionMap->end(); i++)
|
||||
{
|
||||
printDec( f, (*i).first, 6);
|
||||
f << " : ";
|
||||
printDec( f, (*i).second, 6);
|
||||
f << "\n";
|
||||
// f << (*i)->first << " : " << (*i)->second << "\n";
|
||||
}
|
||||
return f;
|
||||
}
|
||||
|
||||
Formatter& ICodeModule::print(Formatter& f)
|
||||
{
|
||||
f << "ICM[" << mID << "] from source at '" << mFileName << "' " <<
|
||||
(uint32)its_iCode->size() << " bytecodes\n";
|
||||
return VM::operator<<(f, *its_iCode);
|
||||
}
|
||||
|
||||
/*************************************************************************/
|
||||
|
||||
Formatter& operator<<(Formatter &f, string &s)
|
||||
{
|
||||
f << s.c_str();
|
||||
return f;
|
||||
}
|
||||
|
||||
ICodeModule *ICodeGenerator::readFunction(XMLNode *element, JSClass *thisClass)
|
||||
{
|
||||
#ifdef TEST_ICASM
|
||||
ICodeModule *result = NULL;
|
||||
|
||||
String resultTypeName;
|
||||
element->getValue(widenCString("type"), resultTypeName);
|
||||
ParameterList *theParameterList = new ParameterList();
|
||||
theParameterList->add(mContext->getWorld().identifiers["this"], TypedRegister(0, thisClass), false);
|
||||
uint32 pCount = 1;
|
||||
StringFormatter s;
|
||||
XMLNodeList ¶meters = element->children();
|
||||
for (XMLNodeList::const_iterator k = parameters.begin(); k != parameters.end(); k++) {
|
||||
XMLNode *parameter = *k;
|
||||
if (parameter->name().compare(widenCString("parameter")) == 0) {
|
||||
String parameterName;
|
||||
String parameterTypeName;
|
||||
element->getValue(widenCString("name"), parameterName);
|
||||
element->getValue(widenCString("type"), parameterTypeName);
|
||||
JSType *parameterType = mContext->findType(mContext->getWorld().identifiers[parameterTypeName]);
|
||||
theParameterList->add(mContext->getWorld().identifiers[parameterName], TypedRegister(pCount, parameterType), false);
|
||||
s << pCount - 1;
|
||||
theParameterList->add(mContext->getWorld().identifiers[s.getString()], TypedRegister(pCount, parameterType), false);
|
||||
s.clear();
|
||||
pCount++;
|
||||
}
|
||||
}
|
||||
theParameterList->setPositionalCount(pCount);
|
||||
|
||||
JSType *resultType = mContext->findType(mContext->getWorld().identifiers[resultTypeName]);
|
||||
String &body = element->body();
|
||||
if (body.length()) {
|
||||
std::string str(body.length(), char());
|
||||
std::transform(body.begin(), body.end(), str.begin(), narrow);
|
||||
ICodeParser icp(mContext);
|
||||
|
||||
stdOut << "Calling ICodeParser with :\n" << str << "\n";
|
||||
|
||||
icp.parseSourceFromString(str);
|
||||
|
||||
result = new ICodeModule(icp.mInstructions,
|
||||
NULL, /* VariableList *variables */
|
||||
theParameterList, /* ParameterList *parameters */
|
||||
icp.mMaxRegister,
|
||||
NULL, /* InstructionMap *instructionMap */
|
||||
resultType,
|
||||
NotABanana); /* exception register */
|
||||
}
|
||||
return result;
|
||||
#else
|
||||
return 0;
|
||||
#endif
|
||||
}
|
||||
|
||||
ICodeModule *ICodeGenerator::readICode(const char *fileName)
|
||||
{
|
||||
#ifdef TEST_ICASM
|
||||
ICodeModule *result = NULL;
|
||||
|
||||
XMLParser xp(fileName);
|
||||
XMLNode *top = xp.parseDocument();
|
||||
stdOut << *top;
|
||||
|
||||
XMLNodeList &kids = top->children();
|
||||
for (XMLNodeList::const_iterator i = kids.begin(); i != kids.end(); i++) {
|
||||
XMLNode *node = *i;
|
||||
|
||||
if (node->name().compare(widenCString("class")) == 0) {
|
||||
String className;
|
||||
String superName;
|
||||
JSClass* superclass = 0;
|
||||
|
||||
node->getValue(widenCString("name"), className);
|
||||
if (node->getValue(widenCString("super"), superName)) {
|
||||
const JSValue& superclassValue = mContext->getGlobalObject()->getVariable(superName);
|
||||
superclass = static_cast<JSClass*>(superclassValue.object);
|
||||
}
|
||||
JSClass* thisClass = new JSClass(mContext->getGlobalObject(), className, superclass);
|
||||
JSScope* thisScope = thisClass->getScope();
|
||||
Context *classContext = new Context(mContext->getWorld(), thisScope);
|
||||
ICodeGenerator scg(classContext, NULL, thisClass, kIsStaticMethod, &Void_Type);
|
||||
ICodeGenerator ccg(classContext, NULL, thisClass, kNoFlags, &Void_Type);
|
||||
ccg.allocateParameter(mContext->getWorld().identifiers["this"], false, thisClass);
|
||||
thisClass->defineStatic(mInitName, &Function_Type);
|
||||
|
||||
mContext->getGlobalObject()->defineVariable(className, &Type_Type, JSValue(thisClass));
|
||||
|
||||
XMLNodeList &elements = node->children();
|
||||
for (XMLNodeList::const_iterator j = elements.begin(); j != elements.end(); j++) {
|
||||
XMLNode *element = *j;
|
||||
bool isConstructor = (element->name().compare(widenCString("constructor")) == 0);
|
||||
|
||||
if (isConstructor || (element->name().compare(widenCString("method")) == 0)) {
|
||||
String methodName;
|
||||
node->getValue(widenCString("name"), methodName);
|
||||
ICodeModule *icm = readFunction(element, thisClass);
|
||||
if (icm) {
|
||||
if (isConstructor) {
|
||||
thisClass->defineConstructor(methodName);
|
||||
scg.setStatic(thisClass, mContext->getWorld().identifiers[methodName], scg.newFunction(icm));
|
||||
}
|
||||
else
|
||||
thisClass->defineMethod(methodName, new JSFunction(icm));
|
||||
}
|
||||
}
|
||||
else {
|
||||
if (element->name().compare(widenCString("field")) == 0) {
|
||||
String fieldName;
|
||||
String fieldType;
|
||||
|
||||
element->getValue(widenCString("name"), fieldName);
|
||||
element->getValue(widenCString("type"), fieldType);
|
||||
JSType *type = mContext->findType(mContext->getWorld().identifiers[fieldType]);
|
||||
|
||||
if (element->hasAttribute(widenCString("static")))
|
||||
thisClass->defineStatic(fieldName, type);
|
||||
else
|
||||
thisClass->defineSlot(fieldName, type);
|
||||
}
|
||||
}
|
||||
}
|
||||
scg.setStatic(thisClass, mInitName, scg.newFunction(ccg.complete()));
|
||||
thisClass->complete();
|
||||
|
||||
if (scg.getICode()->size()) {
|
||||
ICodeModule* clinit = scg.complete();
|
||||
classContext->interpret(clinit, JSValues());
|
||||
delete clinit;
|
||||
}
|
||||
delete classContext;
|
||||
}
|
||||
else {
|
||||
if (node->name().compare(widenCString("script")) == 0) {
|
||||
String &body = node->body();
|
||||
if (body.length()) {
|
||||
std::string str(body.length(), char());
|
||||
std::transform(body.begin(), body.end(), str.begin(), narrow);
|
||||
ICodeParser icp(mContext);
|
||||
|
||||
stdOut << "(script) Calling ICodeParser with :\n" << str << "\n";
|
||||
|
||||
icp.parseSourceFromString(str);
|
||||
|
||||
result = new ICodeModule(icp.mInstructions,
|
||||
NULL, /* VariableList *variables */
|
||||
NULL, /* ParameterList *parameters */
|
||||
icp.mMaxRegister,
|
||||
NULL, /* InstructionMap *instructionMap */
|
||||
&Void_Type,
|
||||
NotABanana); /* exception register */
|
||||
}
|
||||
}
|
||||
else {
|
||||
if (node->name().compare(widenCString("function")) == 0) {
|
||||
String functionName;
|
||||
node->getValue(widenCString("name"), functionName);
|
||||
ICodeModule *icm = readFunction(node, NULL);
|
||||
mContext->getGlobalObject()->defineFunction(functionName, icm);
|
||||
}
|
||||
else {
|
||||
if (node->name().compare(widenCString("instance")) == 0) {
|
||||
// find the appropriate class and initialize the fields
|
||||
}
|
||||
else {
|
||||
if (node->name().compare(widenCString("object")) == 0) {
|
||||
// an object literal
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
return result;
|
||||
#else
|
||||
return 0;
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
|
||||
} // namespace ICG
|
||||
|
||||
} // namespace JavaScript
|
||||
@@ -1,469 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifndef icodegenerator_h
|
||||
#define icodegenerator_h
|
||||
|
||||
#include <vector>
|
||||
#include <stack>
|
||||
|
||||
#include "utilities.h"
|
||||
#include "parser.h"
|
||||
#include "vmtypes.h"
|
||||
#include "jsclasses.h"
|
||||
#include "xmlparser.h"
|
||||
|
||||
|
||||
namespace JavaScript {
|
||||
namespace ICG {
|
||||
|
||||
using namespace VM;
|
||||
using namespace JSTypes;
|
||||
using namespace JSClasses;
|
||||
|
||||
// forward declarations of classes in this header
|
||||
class ICodeGenerator;
|
||||
class ICodeModule;
|
||||
|
||||
|
||||
struct VariableList { // Maps from variable (parameter) name to a TypedRegister.
|
||||
// But because we also want to map from a register number to
|
||||
// it's type, we keep the TypedRegsters in a separate array and
|
||||
// just store the index in the name map.
|
||||
|
||||
typedef std::map<String, uint32, std::less<String> > VariableMap;
|
||||
typedef VariableMap::value_type MapValue;
|
||||
|
||||
VariableMap variableMap;
|
||||
std::vector<TypedRegister> registerList;
|
||||
|
||||
TypedRegister findVariable(const StringAtom& name)
|
||||
{
|
||||
VariableMap::iterator i = variableMap.find(name);
|
||||
return (i == variableMap.end())
|
||||
? TypedRegister(NotARegister, &None_Type)
|
||||
: registerList[i->second];
|
||||
}
|
||||
|
||||
void add(const StringAtom& name, TypedRegister r)
|
||||
{
|
||||
variableMap.insert(MapValue(name, r.first));
|
||||
registerList.resize(r.first + 1);
|
||||
registerList[r.first] = r;
|
||||
}
|
||||
|
||||
TypedRegister getRegister(uint32 i)
|
||||
{
|
||||
ASSERT(i < registerList.size());
|
||||
return registerList[i];
|
||||
}
|
||||
|
||||
|
||||
};
|
||||
|
||||
struct ParameterList : public VariableList {
|
||||
typedef enum {
|
||||
NoRestParameter,
|
||||
HasRestParameterBeforeBar,
|
||||
HasRestParameterAfterBar,
|
||||
HasUnnamedRestParameter
|
||||
} RestParameterStatus;
|
||||
|
||||
|
||||
|
||||
std::vector<bool> mOptionalParameters; // whether or not a parameter has an optional value
|
||||
// ordered by lexical ordering === register number.
|
||||
RestParameterStatus mRestParameter;
|
||||
uint32 mPositionalCount; // number of positional parameters
|
||||
|
||||
|
||||
|
||||
|
||||
ParameterList() : mRestParameter(NoRestParameter), mPositionalCount(0) { }
|
||||
|
||||
void add(const StringAtom& name, TypedRegister r, bool isOptional)
|
||||
{
|
||||
VariableList::add(name, r);
|
||||
mOptionalParameters.resize(r.first + 1);
|
||||
mOptionalParameters[r.first] = isOptional;
|
||||
}
|
||||
|
||||
uint32 size() { return registerList.size(); } // the variableMap may be larger since it contains aliases
|
||||
|
||||
bool isOptional(uint32 i) { ASSERT(i < mOptionalParameters.size()); return mOptionalParameters[i]; }
|
||||
|
||||
void setRestParameter(RestParameterStatus rs) { mRestParameter = rs; }
|
||||
void setPositionalCount(uint32 x) { mPositionalCount = x; }
|
||||
|
||||
};
|
||||
|
||||
|
||||
typedef enum { NoKind, Var, Property, Slot, Static, Constructor, Name, Method, ClosureVar, Field } LValueKind;
|
||||
|
||||
class Reference {
|
||||
public:
|
||||
Reference(const StringAtom &name) : mKind(NoKind), mName(name) { }
|
||||
|
||||
LValueKind mKind;
|
||||
|
||||
TypedRegister mBase;
|
||||
const StringAtom &mName;
|
||||
TypedRegister mField;
|
||||
|
||||
uint32 mSlotIndex;
|
||||
JSClass *mClass;
|
||||
|
||||
JSType *mType;
|
||||
|
||||
TypedRegister getValue(ICodeGenerator *icg);
|
||||
void setValue(ICodeGenerator *icg, TypedRegister value);
|
||||
TypedRegister getCallTarget(ICodeGenerator *icg);
|
||||
};
|
||||
|
||||
typedef std::vector<const StringAtom *> LabelSet;
|
||||
class LabelEntry {
|
||||
public:
|
||||
LabelEntry(LabelSet *labelSet, Label *breakLabel)
|
||||
: labelSet(labelSet), breakLabel(breakLabel), continueLabel(NULL) { }
|
||||
LabelEntry(LabelSet *labelSet, Label *breakLabel, Label *continueLabel)
|
||||
: labelSet(labelSet), breakLabel(breakLabel), continueLabel(continueLabel) { }
|
||||
|
||||
bool containsLabel(const StringAtom *label);
|
||||
|
||||
LabelSet *labelSet;
|
||||
Label *breakLabel;
|
||||
Label *continueLabel;
|
||||
};
|
||||
typedef std::vector<LabelEntry *> LabelStack;
|
||||
|
||||
|
||||
typedef std::map<uint32, uint32, std::less<uint32> > InstructionMap;
|
||||
|
||||
/****************************************************************/
|
||||
|
||||
// An ICodeGenerator provides the interface between the parser and the
|
||||
// interpreter. The parser constructs one of these for each
|
||||
// function/script, adds statements and expressions to it and then
|
||||
// converts it into an ICodeModule, ready for execution.
|
||||
|
||||
class ICodeGenerator {
|
||||
public:
|
||||
friend class ICodeModule;
|
||||
typedef enum { kNoFlags = 0, kIsTopLevel = 0x01, kIsStaticMethod = 0x02, kIsWithinWith = 0x04 } ICodeGeneratorFlags;
|
||||
private:
|
||||
InstructionStream *iCode;
|
||||
bool iCodeOwner;
|
||||
LabelList labels;
|
||||
|
||||
Register mTopRegister; // highest (currently) allocated register
|
||||
TypedRegister mExceptionRegister; // reserved to carry the exception object.
|
||||
VariableList *variableList; // name|register pair for each variable
|
||||
ParameterList *parameterList; // name|register pair for each parameter
|
||||
// (with #0 reserved for 'this' regardless of scope)
|
||||
|
||||
Context *mContext; // the world and global object
|
||||
LabelStack mLabelStack; // stack of LabelEntry objects, one per nested looping construct
|
||||
// maps source position to instruction index
|
||||
InstructionMap *mInstructionMap;
|
||||
|
||||
JSClass *mClass; // enclosing class when generating code for methods
|
||||
ICodeGeneratorFlags mFlags; // assorted flags
|
||||
LabelList *pLabels; // label for each parameter initialization entry point
|
||||
|
||||
const StringAtom &mInitName;
|
||||
ICodeGenerator *mContainingFunction;// outer function for nested functions
|
||||
JSType *mResultType;
|
||||
|
||||
std::vector<bool> mPermanentRegister;
|
||||
|
||||
Register getTempRegister()
|
||||
{
|
||||
while (mTopRegister < mPermanentRegister.size())
|
||||
if (!mPermanentRegister[mTopRegister])
|
||||
return mTopRegister++;
|
||||
else
|
||||
++mTopRegister;
|
||||
mPermanentRegister.resize(mTopRegister + 1);
|
||||
mPermanentRegister[mTopRegister] = false;
|
||||
return mTopRegister++;
|
||||
}
|
||||
|
||||
void resetTopRegister() { mTopRegister = 0; }
|
||||
void resetStatement() { resetTopRegister(); }
|
||||
|
||||
TypedRegister allocateRegister(JSType *type);
|
||||
|
||||
|
||||
|
||||
void addParameterLabel(Label *label) { if (pLabels == NULL) pLabels = new LabelList(); pLabels->push_back(label); }
|
||||
|
||||
|
||||
Label *setLabel(Label *label);
|
||||
|
||||
void jsr(Label *label) { iCode->push_back(new Jsr(label)); }
|
||||
void rts() { iCode->push_back(new Rts()); }
|
||||
void branch(Label *label);
|
||||
GenericBranch *branchTrue(Label *label, TypedRegister condition);
|
||||
GenericBranch *branchFalse(Label *label, TypedRegister condition);
|
||||
GenericBranch *branchInitialized(Label *label, TypedRegister condition);
|
||||
|
||||
void beginTry(Label *catchLabel, Label *finallyLabel)
|
||||
{ iCode->push_back(new Tryin(catchLabel, finallyLabel)); }
|
||||
void endTry() { iCode->push_back(new Tryout()); }
|
||||
|
||||
void beginWith(TypedRegister obj) { iCode->push_back(new Within(obj)); }
|
||||
void endWith() { iCode->push_back(new Without()); }
|
||||
|
||||
|
||||
void startStatement(uint32 pos) { (*mInstructionMap)[iCode->size()] = pos; }
|
||||
|
||||
bool isTopLevel() { return (mFlags & kIsTopLevel) != 0; }
|
||||
bool isWithinWith() { return (mFlags & kIsWithinWith) != 0; }
|
||||
bool isStaticMethod() { return (mFlags & kIsStaticMethod) != 0; }
|
||||
|
||||
void setFlag(uint32 flag, bool v) { mFlags = (ICodeGeneratorFlags)((v) ? mFlags | flag : mFlags & ~flag); }
|
||||
|
||||
bool getVariableByName(const StringAtom &name, Reference &ref);
|
||||
bool scanForVariable(const StringAtom &name, Reference &ref);
|
||||
bool resolveIdentifier(const StringAtom &name, Reference &ref, bool lvalue);
|
||||
ICodeModule *genFunction(FunctionDefinition &function, bool isStatic, bool isConstructor, JSClass *superClass);
|
||||
|
||||
Reference genReference(ExprNode *p);
|
||||
Operator getOperator(uint32 parameterCount, String &name);
|
||||
|
||||
ICodeModule *readFunction(XMLNode *element, JSClass *thisClass);
|
||||
|
||||
public:
|
||||
|
||||
ICodeGenerator(Context *cx,
|
||||
ICodeGenerator *containingFunction = NULL,
|
||||
JSClass *aClass = NULL,
|
||||
ICodeGeneratorFlags flags = kIsTopLevel,
|
||||
JSType *resultType = &Object_Type);
|
||||
|
||||
~ICodeGenerator()
|
||||
{
|
||||
if (iCodeOwner) {
|
||||
delete iCode;
|
||||
delete mInstructionMap;
|
||||
if (pLabels) delete pLabels;
|
||||
}
|
||||
}
|
||||
|
||||
ICodeModule *complete();
|
||||
ICodeModule *readICode(const char *fileName);
|
||||
|
||||
TypedRegister genExpr(ExprNode *p,
|
||||
bool needBoolValueInBranch = false,
|
||||
Label *trueBranch = NULL,
|
||||
Label *falseBranch = NULL);
|
||||
TypedRegister genStmt(StmtNode *p, LabelSet *currentLabelSet = NULL);
|
||||
|
||||
void returnStmt(TypedRegister r);
|
||||
void returnStmt();
|
||||
void throwStmt(TypedRegister r) { iCode->push_back(new Throw(r)); }
|
||||
void debuggerStmt() { iCode->push_back(new Debugger()); }
|
||||
|
||||
TypedRegister allocateVariable(const StringAtom& name)
|
||||
{
|
||||
return allocateVariable(name, &Object_Type);
|
||||
}
|
||||
|
||||
TypedRegister allocateVariable(const StringAtom& name, const StringAtom& typeName);
|
||||
|
||||
TypedRegister allocateVariable(const StringAtom& name, JSType *type)
|
||||
{
|
||||
TypedRegister r = allocateRegister(type);
|
||||
variableList->add(name, r);
|
||||
return r;
|
||||
}
|
||||
|
||||
TypedRegister allocateVariable(const StringAtom& name, TypedRegister r)
|
||||
{
|
||||
variableList->add(name, r);
|
||||
return r;
|
||||
}
|
||||
|
||||
TypedRegister allocateParameter(const StringAtom& name, bool isOptional)
|
||||
{
|
||||
return allocateParameter(name, isOptional, &Object_Type);
|
||||
}
|
||||
|
||||
TypedRegister allocateParameter(const StringAtom& name, bool isOptional, const StringAtom& typeName);
|
||||
|
||||
TypedRegister allocateParameter(const StringAtom& name, bool isOptional, JSType *type)
|
||||
{
|
||||
TypedRegister r = allocateRegister(type);
|
||||
parameterList->add(name, r, isOptional);
|
||||
return r;
|
||||
}
|
||||
|
||||
|
||||
Formatter& print(Formatter& f);
|
||||
|
||||
TypedRegister op(ICodeOp op, TypedRegister source);
|
||||
TypedRegister op(ICodeOp op, TypedRegister source1, TypedRegister source2);
|
||||
TypedRegister binaryOp(ICodeOp dblOp, JSTypes::Operator op, TypedRegister source1, TypedRegister source2);
|
||||
TypedRegister unaryOp(JSTypes::Operator op, TypedRegister source);
|
||||
TypedRegister invokeCallOp(TypedRegister target, ArgumentList *args);
|
||||
TypedRegister xcrementOp(JSTypes::Operator op, TypedRegister source);
|
||||
TypedRegister call(TypedRegister target, ArgumentList *args);
|
||||
// TypedRegister directCall(JSFunction *target, ArgumentList *args);
|
||||
TypedRegister bindThis(TypedRegister thisArg, TypedRegister target);
|
||||
TypedRegister getMethod(TypedRegister thisArg, uint32 slotIndex);
|
||||
TypedRegister getClosure(uint32 count);
|
||||
TypedRegister newClosure(ICodeModule *icm);
|
||||
|
||||
void move(TypedRegister destination, TypedRegister source);
|
||||
TypedRegister logicalNot(TypedRegister source);
|
||||
TypedRegister test(TypedRegister source);
|
||||
|
||||
TypedRegister loadBoolean(bool value);
|
||||
TypedRegister loadImmediate(double value);
|
||||
TypedRegister loadString(const String &value);
|
||||
TypedRegister loadString(const StringAtom &name);
|
||||
TypedRegister loadNull();
|
||||
TypedRegister loadType(JSType *toType);
|
||||
|
||||
TypedRegister newObject(TypedRegister constructor);
|
||||
TypedRegister newArray();
|
||||
TypedRegister newFunction(ICodeModule *icm);
|
||||
TypedRegister newClass(JSClass *clazz);
|
||||
TypedRegister genericNew(TypedRegister target, ArgumentList *args);
|
||||
|
||||
TypedRegister cast(TypedRegister arg, JSType *toType);
|
||||
TypedRegister dotClass(TypedRegister base);
|
||||
TypedRegister instanceOf(TypedRegister base, TypedRegister type);
|
||||
TypedRegister is(TypedRegister base, TypedRegister type);
|
||||
|
||||
|
||||
TypedRegister super();
|
||||
TypedRegister loadName(const StringAtom &name, JSType *t = &Object_Type);
|
||||
void saveName(const StringAtom &name, TypedRegister value);
|
||||
TypedRegister nameXcr(const StringAtom &name, ICodeOp op);
|
||||
|
||||
TypedRegister getField(TypedRegister base, TypedRegister field);
|
||||
void setField(TypedRegister base, TypedRegister field, TypedRegister value);
|
||||
|
||||
TypedRegister deleteProperty(TypedRegister base, const StringAtom &name);
|
||||
TypedRegister getProperty(TypedRegister base, const StringAtom &name);
|
||||
void setProperty(TypedRegister base, const StringAtom &name, TypedRegister value);
|
||||
TypedRegister propertyXcr(TypedRegister base, const StringAtom &name, ICodeOp op);
|
||||
|
||||
TypedRegister getStatic(JSClass *base, const String &name);
|
||||
void setStatic(JSClass *base, const StringAtom &name, TypedRegister value);
|
||||
TypedRegister staticXcr(JSClass *base, const StringAtom &name, ICodeOp op);
|
||||
|
||||
TypedRegister getElement(TypedRegister base, TypedRegister index);
|
||||
void setElement(TypedRegister base, TypedRegister index, TypedRegister value);
|
||||
TypedRegister elementXcr(TypedRegister base, TypedRegister index, ICodeOp op);
|
||||
|
||||
TypedRegister getSlot(TypedRegister base, uint32 slot);
|
||||
void setSlot(TypedRegister base, uint32 slot, TypedRegister value);
|
||||
TypedRegister slotXcr(TypedRegister base, uint32 slot, ICodeOp op);
|
||||
|
||||
TypedRegister varXcr(TypedRegister var, ICodeOp op);
|
||||
|
||||
InstructionStream *getICode() { return iCode; }
|
||||
|
||||
Label *getLabel();
|
||||
|
||||
};
|
||||
|
||||
class ICodeModule {
|
||||
public:
|
||||
ICodeModule(InstructionStream *iCode, VariableList *variables,
|
||||
ParameterList *parameters,
|
||||
uint32 maxRegister,
|
||||
InstructionMap *instructionMap,
|
||||
JSType *resultType, uint32 exceptionRegister) :
|
||||
its_iCode(iCode), itsVariables(variables), itsParameters(parameters),
|
||||
itsMaxRegister(maxRegister),
|
||||
mID(++sMaxID), mInstructionMap(instructionMap),
|
||||
mParameterInit(NULL),
|
||||
mEntryPoint(0),
|
||||
mResultType(resultType),
|
||||
mExceptionRegister(exceptionRegister)
|
||||
{
|
||||
}
|
||||
|
||||
ICodeModule(ICodeGenerator &icg) :
|
||||
its_iCode(icg.iCode), itsVariables(icg.variableList), itsParameters(icg.parameterList),
|
||||
itsMaxRegister(icg.mPermanentRegister.size()),
|
||||
mID(++sMaxID), mInstructionMap(icg.mInstructionMap),
|
||||
mParameterInit(NULL),
|
||||
mEntryPoint(0),
|
||||
mResultType(icg.mResultType),
|
||||
mExceptionRegister(icg.mExceptionRegister.first)
|
||||
{
|
||||
}
|
||||
|
||||
|
||||
~ICodeModule()
|
||||
{
|
||||
delete its_iCode;
|
||||
delete itsVariables;
|
||||
delete mInstructionMap;
|
||||
if (mParameterInit) delete mParameterInit;
|
||||
}
|
||||
|
||||
Formatter& print(Formatter& f);
|
||||
void setFileName (String aFileName) { mFileName = aFileName; }
|
||||
String getFileName () { return mFileName; }
|
||||
|
||||
InstructionStream *its_iCode;
|
||||
VariableList *itsVariables;
|
||||
ParameterList *itsParameters;
|
||||
uint32 itsMaxRegister;
|
||||
uint32 mID;
|
||||
InstructionMap *mInstructionMap;
|
||||
String mFileName;
|
||||
uint32 *mParameterInit;
|
||||
uint32 mEntryPoint;
|
||||
JSType *mResultType;
|
||||
uint32 mExceptionRegister;
|
||||
|
||||
static uint32 sMaxID;
|
||||
|
||||
};
|
||||
|
||||
Formatter& operator<<(Formatter &f, ICodeGenerator &i);
|
||||
Formatter& operator<<(Formatter &f, ICodeModule &i);
|
||||
Formatter& operator<<(Formatter &f, std::string &s);
|
||||
|
||||
|
||||
|
||||
} /* namespace IGC */
|
||||
} /* namespace JavaScript */
|
||||
|
||||
#endif /* icodegenerator_h */
|
||||
@@ -1,417 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
/***** THIS FILE IS AUTO GENERATED! DO NOT EDIT THIS FILE! *****
|
||||
* make changes to js2/tools/genmap.pl and regenerate this file *
|
||||
***** THIS FILE IS AUTO GENERATED! DO NOT EDIT THIS FILE! *****/
|
||||
|
||||
#ifndef __icodemap_h
|
||||
|
||||
#define __icodemap_h
|
||||
|
||||
#include "systemtypes.h"
|
||||
#include "icodeasm.h"
|
||||
|
||||
namespace JavaScript {
|
||||
namespace ICodeASM {
|
||||
|
||||
static uint icodemap_size = 85;
|
||||
|
||||
static struct {
|
||||
char *name;
|
||||
OperandType otype[4];
|
||||
} icodemap [] = {
|
||||
{"ADD", {otRegister, otRegister, otRegister}},
|
||||
{"AND", {otRegister, otRegister, otRegister}},
|
||||
{"BIND_THIS", {otRegister, otRegister, otRegister}},
|
||||
{"BITNOT", {otRegister, otRegister}},
|
||||
{"BRANCH", {otLabel}},
|
||||
{"BRANCH_FALSE", {otLabel, otRegister}},
|
||||
{"BRANCH_INITIALIZED", {otLabel, otRegister}},
|
||||
{"BRANCH_TRUE", {otLabel, otRegister}},
|
||||
{"CAST", {otRegister, otRegister, otRegister}},
|
||||
{"CLASS", {otRegister, otRegister}},
|
||||
{"COMPARE_EQ", {otRegister, otRegister, otRegister}},
|
||||
{"COMPARE_GE", {otRegister, otRegister, otRegister}},
|
||||
{"COMPARE_GT", {otRegister, otRegister, otRegister}},
|
||||
{"COMPARE_IN", {otRegister, otRegister, otRegister}},
|
||||
{"COMPARE_LE", {otRegister, otRegister, otRegister}},
|
||||
{"COMPARE_LT", {otRegister, otRegister, otRegister}},
|
||||
{"COMPARE_NE", {otRegister, otRegister, otRegister}},
|
||||
{"DEBUGGER", {otNone}},
|
||||
{"DELETE_PROP", {otRegister, otRegister, otStringAtom}},
|
||||
{"DIRECT_CALL", {otRegister, otRegister, otArgumentList}},
|
||||
{"DIVIDE", {otRegister, otRegister, otRegister}},
|
||||
{"ELEM_XCR", {otRegister, otRegister, otRegister, otDouble}},
|
||||
{"GENERIC_BINARY_OP", {otRegister, otJSTypesOperator, otRegister, otRegister}},
|
||||
{"GENERIC_UNARY_OP", {otRegister, otJSTypesOperator, otRegister}},
|
||||
{"GENERIC_XCREMENT_OP", {otRegister, otJSTypesOperator, otRegister}},
|
||||
{"GET_CLOSURE", {otRegister, otUInt32}},
|
||||
{"GET_ELEMENT", {otRegister, otRegister, otRegister}},
|
||||
{"GET_FIELD", {otRegister, otRegister, otRegister}},
|
||||
{"GET_METHOD", {otRegister, otRegister, otUInt32}},
|
||||
{"GET_PROP", {otRegister, otRegister, otStringAtom}},
|
||||
{"GET_SLOT", {otRegister, otRegister, otUInt32}},
|
||||
{"GET_STATIC", {otRegister, otJSClass, otUInt32}},
|
||||
{"INSTANCEOF", {otRegister, otRegister, otRegister}},
|
||||
{"INVOKE_CALL", {otRegister, otRegister, otArgumentList}},
|
||||
{"IS", {otRegister, otRegister, otRegister}},
|
||||
{"JSR", {otLabel}},
|
||||
{"LOAD_FALSE", {otRegister}},
|
||||
{"LOAD_IMMEDIATE", {otRegister, otDouble}},
|
||||
{"LOAD_NAME", {otRegister, otStringAtom}},
|
||||
{"LOAD_NULL", {otRegister}},
|
||||
{"LOAD_STRING", {otRegister, otJSString}},
|
||||
{"LOAD_TRUE", {otRegister}},
|
||||
{"LOAD_TYPE", {otRegister, otJSType}},
|
||||
{"MOVE", {otRegister, otRegister}},
|
||||
{"MULTIPLY", {otRegister, otRegister, otRegister}},
|
||||
{"NAME_XCR", {otRegister, otStringAtom, otDouble}},
|
||||
{"NEGATE_DOUBLE", {otRegister, otRegister}},
|
||||
{"NEW_ARRAY", {otRegister}},
|
||||
{"NEW_CLASS", {otRegister, otJSClass}},
|
||||
{"NEW_CLOSURE", {otRegister, otICodeModule}},
|
||||
{"NEW_FUNCTION", {otRegister, otICodeModule}},
|
||||
{"NEW_GENERIC", {otRegister, otRegister, otArgumentList}},
|
||||
{"NEW_OBJECT", {otRegister, otRegister}},
|
||||
{"NOP", {otNone}},
|
||||
{"NOT", {otRegister, otRegister}},
|
||||
{"OR", {otRegister, otRegister, otRegister}},
|
||||
{"POSATE_DOUBLE", {otRegister, otRegister}},
|
||||
{"PROP_XCR", {otRegister, otRegister, otStringAtom, otDouble}},
|
||||
{"REMAINDER", {otRegister, otRegister, otRegister}},
|
||||
{"RETURN", {otRegister}},
|
||||
{"RETURN_VOID", {otNone}},
|
||||
{"RTS", {otNone}},
|
||||
{"SAVE_NAME", {otStringAtom, otRegister}},
|
||||
{"SET_ELEMENT", {otRegister, otRegister, otRegister}},
|
||||
{"SET_FIELD", {otRegister, otRegister, otRegister}},
|
||||
{"SET_PROP", {otRegister, otStringAtom, otRegister}},
|
||||
{"SET_SLOT", {otRegister, otUInt32, otRegister}},
|
||||
{"SET_STATIC", {otJSClass, otUInt32, otRegister}},
|
||||
{"SHIFTLEFT", {otRegister, otRegister, otRegister}},
|
||||
{"SHIFTRIGHT", {otRegister, otRegister, otRegister}},
|
||||
{"SLOT_XCR", {otRegister, otRegister, otUInt32, otDouble}},
|
||||
{"STATIC_XCR", {otRegister, otJSClass, otUInt32, otDouble}},
|
||||
{"STRICT_EQ", {otRegister, otRegister, otRegister}},
|
||||
{"STRICT_NE", {otRegister, otRegister, otRegister}},
|
||||
{"SUBTRACT", {otRegister, otRegister, otRegister}},
|
||||
{"SUPER", {otRegister}},
|
||||
{"TEST", {otRegister, otRegister}},
|
||||
{"THROW", {otRegister}},
|
||||
{"TRYIN", {otLabel, otLabel}},
|
||||
{"TRYOUT", {otNone}},
|
||||
{"USHIFTRIGHT", {otRegister, otRegister, otRegister}},
|
||||
{"VAR_XCR", {otRegister, otRegister, otDouble}},
|
||||
{"WITHIN", {otRegister}},
|
||||
{"WITHOUT", {otNone}},
|
||||
{"XOR", {otRegister, otRegister, otRegister}},
|
||||
};
|
||||
|
||||
VM::Instruction *InstructionFromNode (StatementNode *node)
|
||||
{
|
||||
using namespace VM;
|
||||
using namespace JSTypes;
|
||||
Instruction *i;
|
||||
|
||||
switch (node->icodeID)
|
||||
{
|
||||
case 0:
|
||||
i = new Add (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 1:
|
||||
i = new And (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 2:
|
||||
i = new BindThis (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 3:
|
||||
i = new Bitnot (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
|
||||
break;
|
||||
case 4:
|
||||
i = new Branch (reinterpret_cast<Label*>(node->operand[0].data));
|
||||
break;
|
||||
case 5:
|
||||
i = new BranchFalse (reinterpret_cast<Label*>(node->operand[0].data), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
|
||||
break;
|
||||
case 6:
|
||||
i = new BranchInitialized (reinterpret_cast<Label*>(node->operand[0].data), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
|
||||
break;
|
||||
case 7:
|
||||
i = new BranchTrue (reinterpret_cast<Label*>(node->operand[0].data), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
|
||||
break;
|
||||
case 8:
|
||||
i = new Cast (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 9:
|
||||
i = new Class (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
|
||||
break;
|
||||
case 10:
|
||||
i = new CompareEQ (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 11:
|
||||
i = new CompareGE (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 12:
|
||||
i = new CompareGT (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 13:
|
||||
i = new CompareIN (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 14:
|
||||
i = new CompareLE (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 15:
|
||||
i = new CompareLT (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 16:
|
||||
i = new CompareNE (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 17:
|
||||
i = new Debugger ();
|
||||
break;
|
||||
case 18:
|
||||
i = new DeleteProp (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), reinterpret_cast<const StringAtom*>(node->operand[2].data));
|
||||
break;
|
||||
case 19:
|
||||
i = new DirectCall (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), reinterpret_cast<ArgumentList*>(node->operand[2].data));
|
||||
break;
|
||||
case 20:
|
||||
i = new Divide (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 21:
|
||||
i = new ElemXcr (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0), static_cast<double>(node->operand[3].data));
|
||||
break;
|
||||
case 22:
|
||||
i = new GenericBinaryOP (TypedRegister(static_cast<Register>(node->operand[0].data), 0), static_cast<JSTypes::Operator>(node->operand[1].data), TypedRegister(static_cast<Register>(node->operand[2].data), 0), TypedRegister(static_cast<Register>(node->operand[3].data), 0));
|
||||
break;
|
||||
case 23:
|
||||
i = new GenericUnaryOP (TypedRegister(static_cast<Register>(node->operand[0].data), 0), static_cast<JSTypes::Operator>(node->operand[1].data), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 24:
|
||||
i = new GenericXcrementOP (TypedRegister(static_cast<Register>(node->operand[0].data), 0), static_cast<JSTypes::Operator>(node->operand[1].data), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 25:
|
||||
i = new GetClosure (TypedRegister(static_cast<Register>(node->operand[0].data), 0), static_cast<uint32>(node->operand[1].data));
|
||||
break;
|
||||
case 26:
|
||||
i = new GetElement (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 27:
|
||||
i = new GetField (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 28:
|
||||
i = new GetMethod (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), static_cast<uint32>(node->operand[2].data));
|
||||
break;
|
||||
case 29:
|
||||
i = new GetProp (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), reinterpret_cast<const StringAtom*>(node->operand[2].data));
|
||||
break;
|
||||
case 30:
|
||||
i = new GetSlot (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), static_cast<uint32>(node->operand[2].data));
|
||||
break;
|
||||
case 31:
|
||||
i = new GetStatic (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<JSClass*>(node->operand[1].data), static_cast<uint32>(node->operand[2].data));
|
||||
break;
|
||||
case 32:
|
||||
i = new Instanceof (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 33:
|
||||
i = new InvokeCall (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), reinterpret_cast<ArgumentList*>(node->operand[2].data));
|
||||
break;
|
||||
case 34:
|
||||
i = new Is (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 35:
|
||||
i = new Jsr (reinterpret_cast<Label*>(node->operand[0].data));
|
||||
break;
|
||||
case 36:
|
||||
i = new LoadFalse (TypedRegister(static_cast<Register>(node->operand[0].data), 0));
|
||||
break;
|
||||
case 37:
|
||||
i = new LoadImmediate (TypedRegister(static_cast<Register>(node->operand[0].data), 0), static_cast<double>(node->operand[1].data));
|
||||
break;
|
||||
case 38:
|
||||
i = new LoadName (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<const StringAtom*>(node->operand[1].data));
|
||||
break;
|
||||
case 39:
|
||||
i = new LoadNull (TypedRegister(static_cast<Register>(node->operand[0].data), 0));
|
||||
break;
|
||||
case 40:
|
||||
i = new LoadString (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<JSString*>(node->operand[1].data));
|
||||
break;
|
||||
case 41:
|
||||
i = new LoadTrue (TypedRegister(static_cast<Register>(node->operand[0].data), 0));
|
||||
break;
|
||||
case 42:
|
||||
i = new LoadType (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<JSType*>(node->operand[1].data));
|
||||
break;
|
||||
case 43:
|
||||
i = new Move (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
|
||||
break;
|
||||
case 44:
|
||||
i = new Multiply (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 45:
|
||||
i = new NameXcr (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<const StringAtom*>(node->operand[1].data), static_cast<double>(node->operand[2].data));
|
||||
break;
|
||||
case 46:
|
||||
i = new NegateDouble (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
|
||||
break;
|
||||
case 47:
|
||||
i = new NewArray (TypedRegister(static_cast<Register>(node->operand[0].data), 0));
|
||||
break;
|
||||
case 48:
|
||||
i = new NewClass (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<JSClass*>(node->operand[1].data));
|
||||
break;
|
||||
case 49:
|
||||
i = new NewClosure (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<ICodeModule*>(node->operand[1].data));
|
||||
break;
|
||||
case 50:
|
||||
i = new NewFunction (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<ICodeModule*>(node->operand[1].data));
|
||||
break;
|
||||
case 51:
|
||||
i = new NewGeneric (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), reinterpret_cast<ArgumentList*>(node->operand[2].data));
|
||||
break;
|
||||
case 52:
|
||||
i = new NewObject (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
|
||||
break;
|
||||
case 53:
|
||||
i = new Nop ();
|
||||
break;
|
||||
case 54:
|
||||
i = new Not (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
|
||||
break;
|
||||
case 55:
|
||||
i = new Or (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 56:
|
||||
i = new PosateDouble (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
|
||||
break;
|
||||
case 57:
|
||||
i = new PropXcr (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), reinterpret_cast<const StringAtom*>(node->operand[2].data), static_cast<double>(node->operand[3].data));
|
||||
break;
|
||||
case 58:
|
||||
i = new Remainder (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 59:
|
||||
i = new Return (TypedRegister(static_cast<Register>(node->operand[0].data), 0));
|
||||
break;
|
||||
case 60:
|
||||
i = new ReturnVoid ();
|
||||
break;
|
||||
case 61:
|
||||
i = new Rts ();
|
||||
break;
|
||||
case 62:
|
||||
i = new SaveName (reinterpret_cast<const StringAtom*>(node->operand[0].data), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
|
||||
break;
|
||||
case 63:
|
||||
i = new SetElement (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 64:
|
||||
i = new SetField (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 65:
|
||||
i = new SetProp (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<const StringAtom*>(node->operand[1].data), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 66:
|
||||
i = new SetSlot (TypedRegister(static_cast<Register>(node->operand[0].data), 0), static_cast<uint32>(node->operand[1].data), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 67:
|
||||
i = new SetStatic (reinterpret_cast<JSClass*>(node->operand[0].data), static_cast<uint32>(node->operand[1].data), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 68:
|
||||
i = new Shiftleft (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 69:
|
||||
i = new Shiftright (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 70:
|
||||
i = new SlotXcr (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), static_cast<uint32>(node->operand[2].data), static_cast<double>(node->operand[3].data));
|
||||
break;
|
||||
case 71:
|
||||
i = new StaticXcr (TypedRegister(static_cast<Register>(node->operand[0].data), 0), reinterpret_cast<JSClass*>(node->operand[1].data), static_cast<uint32>(node->operand[2].data), static_cast<double>(node->operand[3].data));
|
||||
break;
|
||||
case 72:
|
||||
i = new StrictEQ (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 73:
|
||||
i = new StrictNE (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 74:
|
||||
i = new Subtract (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 75:
|
||||
i = new Super (TypedRegister(static_cast<Register>(node->operand[0].data), 0));
|
||||
break;
|
||||
case 76:
|
||||
i = new Test (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0));
|
||||
break;
|
||||
case 77:
|
||||
i = new Throw (TypedRegister(static_cast<Register>(node->operand[0].data), 0));
|
||||
break;
|
||||
case 78:
|
||||
i = new Tryin (reinterpret_cast<Label*>(node->operand[0].data), reinterpret_cast<Label*>(node->operand[1].data));
|
||||
break;
|
||||
case 79:
|
||||
i = new Tryout ();
|
||||
break;
|
||||
case 80:
|
||||
i = new Ushiftright (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
case 81:
|
||||
i = new VarXcr (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), static_cast<double>(node->operand[2].data));
|
||||
break;
|
||||
case 82:
|
||||
i = new Within (TypedRegister(static_cast<Register>(node->operand[0].data), 0));
|
||||
break;
|
||||
case 83:
|
||||
i = new Without ();
|
||||
break;
|
||||
case 84:
|
||||
i = new Xor (TypedRegister(static_cast<Register>(node->operand[0].data), 0), TypedRegister(static_cast<Register>(node->operand[1].data), 0), TypedRegister(static_cast<Register>(node->operand[2].data), 0));
|
||||
break;
|
||||
|
||||
default:
|
||||
NOT_REACHED("Unknown icodeID");
|
||||
}
|
||||
|
||||
return i;
|
||||
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
#endif /* #ifdef __icodemap_h */
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,203 +0,0 @@
|
||||
// -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
//
|
||||
// The contents of this file are subject to the Netscape Public
|
||||
// License Version 1.1 (the "License"); you may not use this file
|
||||
// except in compliance with the License. You may obtain a copy of
|
||||
// the License at http://www.mozilla.org/NPL/
|
||||
//
|
||||
// Software distributed under the License is distributed on an "AS
|
||||
// IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
// implied. See the License for the specific language governing
|
||||
// rights and limitations under the License.
|
||||
//
|
||||
// The Original Code is the JavaScript 2 Prototype.
|
||||
//
|
||||
// The Initial Developer of the Original Code is Netscape
|
||||
// Communications Corporation. Portions created by Netscape are
|
||||
// Copyright (C) 2000 Netscape Communications Corporation. All
|
||||
// Rights Reserved.
|
||||
|
||||
#ifndef interpreter_h
|
||||
#define interpreter_h
|
||||
|
||||
#include "utilities.h"
|
||||
#include "icodegenerator.h"
|
||||
#include "jstypes.h"
|
||||
#include "vmtypes.h"
|
||||
#include "gc_allocator.h"
|
||||
|
||||
namespace JavaScript {
|
||||
namespace Interpreter {
|
||||
|
||||
using namespace ICG;
|
||||
using namespace JSTypes;
|
||||
|
||||
struct Activation;
|
||||
|
||||
struct Linkage;
|
||||
|
||||
class Context : public gc_base {
|
||||
void initContext();
|
||||
public:
|
||||
explicit Context(World& world, JSScope* aGlobal)
|
||||
: mWorld(world), mGlobal(aGlobal), mLinkage(0), mActivation(0), mCurrentClosure(0) { initContext(); }
|
||||
|
||||
Context(Context *cx) : mWorld(cx->getWorld()), mGlobal(cx->getGlobalObject()),
|
||||
mLinkage(0), mActivation(0), mCurrentClosure(0)
|
||||
{
|
||||
initContext();
|
||||
for (ListenerIterator i = cx->mListeners.begin(), e = cx->mListeners.end(); i != e; ++i)
|
||||
addListener(*i);
|
||||
}
|
||||
|
||||
World& getWorld() { return mWorld; }
|
||||
JSScope* getGlobalObject() { return mGlobal; }
|
||||
InstructionIterator getPC() { return mPC; }
|
||||
|
||||
JSValues& getRegisters();
|
||||
ICodeModule* getICode();
|
||||
|
||||
enum Event {
|
||||
EV_NONE = 0x0000,
|
||||
EV_STEP = 0x0001,
|
||||
EV_THROW = 0x0002,
|
||||
EV_DEBUG = 0x0004,
|
||||
EV_ALL = 0xffff
|
||||
};
|
||||
|
||||
class Listener {
|
||||
public:
|
||||
virtual void listen(Context *context, Event event) = 0;
|
||||
};
|
||||
|
||||
void addListener(Listener* listener);
|
||||
void removeListener(Listener* listener);
|
||||
|
||||
class Frame {
|
||||
public:
|
||||
virtual Frame* getNext() = 0;
|
||||
virtual void getState(InstructionIterator& pc, JSValues*& registers,
|
||||
ICodeModule*& iCode) = 0;
|
||||
};
|
||||
|
||||
Frame* getFrames();
|
||||
|
||||
JSValue interpret(ICodeModule* iCode, const JSValues& args);
|
||||
bool invokeFunction(JSFunction *target, JSValues* ®isters, TypedRegister resultReg, JSValue thisArg, ArgumentList *args);
|
||||
|
||||
|
||||
|
||||
ICodeModule* compileFunction(const String &source);
|
||||
ICodeModule* genCode(StmtNode *p, const String &fileName);
|
||||
JSValue readEvalFile(FILE* in, const String& fileName);
|
||||
|
||||
ICodeModule* loadClass(const char *fileName);
|
||||
|
||||
const JSValue findBinaryOverride(JSValue &operand1, JSValue &operand2, JSTypes::Operator op);
|
||||
const JSValue findUnaryOverride(JSValue &operand1, JSTypes::Operator op);
|
||||
|
||||
JSType *findType(const StringAtom& typeName);
|
||||
JSType *extractType(ExprNode *t);
|
||||
JSType *getParameterType(FunctionDefinition &function, int index);
|
||||
uint32 getParameterCount(FunctionDefinition &function);
|
||||
|
||||
private:
|
||||
void broadcast(Event event);
|
||||
void initOperatorsPackage();
|
||||
bool hasNamedArguments(ArgumentList &args);
|
||||
|
||||
private:
|
||||
World& mWorld;
|
||||
JSScope* mGlobal;
|
||||
Linkage* mLinkage;
|
||||
typedef std::vector<Listener*, gc_allocator<Listener*> > ListenerList;
|
||||
typedef ListenerList::iterator ListenerIterator;
|
||||
ListenerList mListeners;
|
||||
Activation* mActivation;
|
||||
ICodeModule* mICode;
|
||||
JSClosure* mCurrentClosure;
|
||||
|
||||
InstructionIterator mPC;
|
||||
|
||||
}; /* class Context */
|
||||
|
||||
/**
|
||||
*
|
||||
*/
|
||||
struct Handler: public gc_base {
|
||||
Handler(Label *catchLabel, Label *finallyLabel)
|
||||
: catchTarget(catchLabel), finallyTarget(finallyLabel) {}
|
||||
Label *catchTarget;
|
||||
Label *finallyTarget;
|
||||
};
|
||||
typedef std::vector<Handler *> CatchStack;
|
||||
|
||||
|
||||
/**
|
||||
* Represents the current function's invocation state.
|
||||
*/
|
||||
struct Activation : public JSObject {
|
||||
JSValues mRegisters;
|
||||
CatchStack catchStack;
|
||||
|
||||
Activation(uint32 highRegister, const JSValues& args)
|
||||
: mRegisters(highRegister + 1)
|
||||
{
|
||||
// copy arg list to initial registers.
|
||||
JSValues::iterator dest = mRegisters.begin();
|
||||
for (JSValues::const_iterator src = args.begin(),
|
||||
end = args.end(); src != end; ++src, ++dest) {
|
||||
*dest = *src;
|
||||
}
|
||||
}
|
||||
|
||||
Activation(uint32 highRegister, Activation* caller, const JSValue thisArg,
|
||||
const ArgumentList* list)
|
||||
: mRegisters(highRegister + 1)
|
||||
{
|
||||
// copy caller's parameter list to initial registers.
|
||||
JSValues::iterator dest = mRegisters.begin();
|
||||
*dest++ = thisArg;
|
||||
if (list) {
|
||||
const JSValues& params = caller->mRegisters;
|
||||
for (ArgumentList::const_iterator src = list->begin(),
|
||||
end = list->end(); src != end; ++src, ++dest) {
|
||||
Register r = (*src).first.first;
|
||||
if (r != NotARegister)
|
||||
*dest = params[r];
|
||||
else
|
||||
*dest = JSValue(JSValue::uninitialized_tag);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
// calling a binary operator, no 'this'
|
||||
Activation(uint32 highRegister, const JSValue thisArg, const JSValue arg1, const JSValue arg2)
|
||||
: mRegisters(highRegister + 1)
|
||||
{
|
||||
mRegisters[0] = thisArg;
|
||||
mRegisters[1] = arg1;
|
||||
mRegisters[2] = arg2;
|
||||
}
|
||||
|
||||
// calling a getter function, no arguments
|
||||
Activation(uint32 highRegister, const JSValue thisArg)
|
||||
: mRegisters(highRegister + 1)
|
||||
{
|
||||
mRegisters[0] = thisArg;
|
||||
}
|
||||
|
||||
// calling a setter function, 1 argument
|
||||
Activation(uint32 highRegister, const JSValue thisArg, const JSValue arg)
|
||||
: mRegisters(highRegister + 1)
|
||||
{
|
||||
mRegisters[0] = thisArg;
|
||||
mRegisters[1] = arg;
|
||||
}
|
||||
|
||||
}; /* struct Activation */
|
||||
|
||||
} /* namespace Interpreter */
|
||||
} /* namespace JavaScript */
|
||||
|
||||
#endif /* interpreter_h */
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -1,550 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifdef _WIN32
|
||||
// Turn off warnings about identifiers too long in browser information
|
||||
#pragma warning(disable: 4786)
|
||||
#pragma warning(disable: 4711)
|
||||
#pragma warning(disable: 4710)
|
||||
#endif
|
||||
|
||||
#include <algorithm>
|
||||
|
||||
#include "parser.h"
|
||||
#include "numerics.h"
|
||||
#include "js2runtime.h"
|
||||
|
||||
// this is the IdentifierList passed to the name lookup routines
|
||||
#define CURRENT_ATTR (NULL)
|
||||
|
||||
#include "jsarray.h"
|
||||
|
||||
namespace JavaScript {
|
||||
namespace JS2Runtime {
|
||||
|
||||
JSValue Array_Constructor(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
|
||||
{
|
||||
JSValue thatValue = thisValue;
|
||||
if (thatValue.isNull())
|
||||
thatValue = Array_Type->newInstance(cx);
|
||||
ASSERT(thatValue.isObject());
|
||||
JSObject *thisObj = thatValue.object;
|
||||
ASSERT(dynamic_cast<JSArrayInstance *>(thisObj));
|
||||
JSArrayInstance *arrInst = (JSArrayInstance *)thisObj;
|
||||
if (argc > 0) {
|
||||
if (argc == 1) {
|
||||
arrInst->mLength = (uint32)(argv[0].toNumber(cx).f64);
|
||||
}
|
||||
else {
|
||||
arrInst->mLength = argc;
|
||||
for (uint32 i = 0; i < argc; i++) {
|
||||
String *id = numberToString(i);
|
||||
arrInst->defineVariable(cx, *id, (NamespaceList *)(NULL), Object_Type, argv[i]);
|
||||
delete id;
|
||||
}
|
||||
}
|
||||
}
|
||||
return thatValue;
|
||||
}
|
||||
|
||||
|
||||
static JSValue Array_toString(Context *cx, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
|
||||
{
|
||||
ASSERT(thisValue.isObject());
|
||||
JSObject *thisObj = thisValue.object;
|
||||
ASSERT(dynamic_cast<JSArrayInstance *>(thisObj));
|
||||
JSArrayInstance *arrInst = (JSArrayInstance *)thisObj;
|
||||
|
||||
ContextStackReplacement csr(cx);
|
||||
|
||||
if (arrInst->mLength == 0)
|
||||
return JSValue(new String(widenCString("")));
|
||||
else {
|
||||
String *s = new String();
|
||||
for (uint32 i = 0; i < arrInst->mLength; i++) {
|
||||
String *id = numberToString(i);
|
||||
arrInst->getProperty(cx, *id, NULL);
|
||||
JSValue result = cx->popValue();
|
||||
s->append(*result.toString(cx).string);
|
||||
if (i < (arrInst->mLength - 1))
|
||||
s->append(widenCString(","));
|
||||
}
|
||||
return JSValue(s);
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
static JSValue Array_toSource(Context *cx, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
|
||||
{
|
||||
ASSERT(thisValue.isObject());
|
||||
JSObject *thisObj = thisValue.object;
|
||||
ASSERT(dynamic_cast<JSArrayInstance *>(thisObj));
|
||||
JSArrayInstance *arrInst = (JSArrayInstance *)thisObj;
|
||||
|
||||
ContextStackReplacement csr(cx);
|
||||
|
||||
if (arrInst->mLength == 0)
|
||||
return JSValue(new String(widenCString("[]")));
|
||||
else {
|
||||
String *s = new String(widenCString("["));
|
||||
for (uint32 i = 0; i < arrInst->mLength; i++) {
|
||||
String *id = numberToString(i);
|
||||
arrInst->getProperty(cx, *id, NULL);
|
||||
JSValue result = cx->popValue();
|
||||
if (!result.isUndefined())
|
||||
s->append(*result.toString(cx).string);
|
||||
if (i < (arrInst->mLength - 1))
|
||||
s->append(widenCString(", "));
|
||||
}
|
||||
s->append(widenCString("]"));
|
||||
return JSValue(s);
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
static JSValue Array_push(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
|
||||
{
|
||||
ASSERT(thisValue.isObject());
|
||||
JSObject *thisObj = thisValue.object;
|
||||
ASSERT(dynamic_cast<JSArrayInstance *>(thisObj));
|
||||
JSArrayInstance *arrInst = (JSArrayInstance *)thisObj;
|
||||
|
||||
for (uint32 i = 0; i < argc; i++) {
|
||||
String *id = numberToString(i + arrInst->mLength);
|
||||
arrInst->defineVariable(cx, *id, (NamespaceList *)(NULL), Object_Type, argv[i]);
|
||||
delete id;
|
||||
}
|
||||
arrInst->mLength += argc;
|
||||
return JSValue((float64)arrInst->mLength);
|
||||
}
|
||||
|
||||
static JSValue Array_pop(Context *cx, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
|
||||
{
|
||||
ASSERT(thisValue.isObject());
|
||||
JSObject *thisObj = thisValue.object;
|
||||
ASSERT(dynamic_cast<JSArrayInstance *>(thisObj));
|
||||
JSArrayInstance *arrInst = (JSArrayInstance *)thisObj;
|
||||
|
||||
ContextStackReplacement csr(cx);
|
||||
|
||||
if (arrInst->mLength > 0) {
|
||||
String *id = numberToString(arrInst->mLength - 1);
|
||||
arrInst->getProperty(cx, *id, NULL);
|
||||
JSValue result = cx->popValue();
|
||||
arrInst->deleteProperty(*id, NULL);
|
||||
--arrInst->mLength;
|
||||
delete id;
|
||||
return result;
|
||||
}
|
||||
else
|
||||
return kUndefinedValue;
|
||||
}
|
||||
|
||||
JSValue Array_concat(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
|
||||
{
|
||||
JSValue E = thisValue;
|
||||
|
||||
JSArrayInstance *A = (JSArrayInstance *)(Array_Type->newInstance(cx));
|
||||
uint32 n = 0;
|
||||
uint32 i = 0;
|
||||
|
||||
ContextStackReplacement csr(cx);
|
||||
|
||||
do {
|
||||
if (E.getType() != Array_Type) {
|
||||
String *id = numberToString(n++);
|
||||
A->setProperty(cx, *id, CURRENT_ATTR, E);
|
||||
}
|
||||
else {
|
||||
ASSERT(E.isObject() && dynamic_cast<JSArrayInstance *>(E.object));
|
||||
JSArrayInstance *arrInst = (JSArrayInstance *)(E.object);
|
||||
for (uint32 k = 0; k < arrInst->mLength; k++) {
|
||||
String *id = numberToString(k);
|
||||
arrInst->getProperty(cx, *id, NULL);
|
||||
JSValue result = cx->popValue();
|
||||
id = numberToString(n++);
|
||||
A->setProperty(cx, *id, CURRENT_ATTR, result);
|
||||
}
|
||||
}
|
||||
E = argv[i++];
|
||||
} while (i <= argc);
|
||||
|
||||
return JSValue(A);
|
||||
}
|
||||
|
||||
static JSValue Array_join(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
|
||||
{
|
||||
ContextStackReplacement csr(cx);
|
||||
|
||||
ASSERT(thisValue.isObject());
|
||||
JSObject *thisObj = thisValue.object;
|
||||
|
||||
thisObj->getProperty(cx, widenCString("length"), CURRENT_ATTR);
|
||||
JSValue result = cx->popValue();
|
||||
uint32 length = (uint32)(result.toUInt32(cx).f64);
|
||||
|
||||
const String *separator;
|
||||
if (argc == 0)
|
||||
separator = new String(',', 1);
|
||||
else
|
||||
separator = argv[0].toString(cx).string;
|
||||
|
||||
thisObj->getProperty(cx, *numberToString(0), CURRENT_ATTR);
|
||||
result = cx->popValue();
|
||||
|
||||
String *S = new String();
|
||||
|
||||
for (uint32 k = 0; k < length; k++) {
|
||||
thisObj->getProperty(cx, *numberToString(0), CURRENT_ATTR);
|
||||
result = cx->popValue();
|
||||
if (!result.isUndefined() && !result.isNull())
|
||||
*S += *result.toString(cx).string;
|
||||
|
||||
if (k < (length - 1))
|
||||
*S += *separator;
|
||||
}
|
||||
|
||||
return JSValue(S);
|
||||
}
|
||||
|
||||
static JSValue Array_reverse(Context *cx, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
|
||||
{
|
||||
ContextStackReplacement csr(cx);
|
||||
|
||||
ASSERT(thisValue.isObject());
|
||||
JSObject *thisObj = thisValue.object;
|
||||
|
||||
thisObj->getProperty(cx, widenCString("length"), CURRENT_ATTR);
|
||||
JSValue result = cx->popValue();
|
||||
uint32 length = (uint32)(result.toUInt32(cx).f64);
|
||||
|
||||
uint32 halfway = length / 2;
|
||||
|
||||
for (uint32 k = 0; k < halfway; k++) {
|
||||
String *id1 = numberToString(k);
|
||||
String *id2 = numberToString(length - k - 1);
|
||||
|
||||
PropertyIterator it;
|
||||
if (thisObj->hasOwnProperty(*id1, CURRENT_ATTR, Read, &it)) {
|
||||
if (thisObj->hasOwnProperty(*id2, CURRENT_ATTR, Read, &it)) {
|
||||
thisObj->getProperty(cx, *id1, CURRENT_ATTR);
|
||||
thisObj->getProperty(cx, *id2, CURRENT_ATTR);
|
||||
thisObj->setProperty(cx, *id1, CURRENT_ATTR, cx->popValue());
|
||||
thisObj->setProperty(cx, *id2, CURRENT_ATTR, cx->popValue());
|
||||
}
|
||||
else {
|
||||
thisObj->getProperty(cx, *id1, CURRENT_ATTR);
|
||||
thisObj->setProperty(cx, *id2, CURRENT_ATTR, cx->popValue());
|
||||
thisObj->deleteProperty(*id1, CURRENT_ATTR);
|
||||
}
|
||||
}
|
||||
else {
|
||||
if (thisObj->hasOwnProperty(*id2, CURRENT_ATTR, Read, &it)) {
|
||||
thisObj->getProperty(cx, *id2, CURRENT_ATTR);
|
||||
thisObj->setProperty(cx, *id1, CURRENT_ATTR, cx->popValue());
|
||||
thisObj->deleteProperty(*id2, CURRENT_ATTR);
|
||||
}
|
||||
else {
|
||||
thisObj->deleteProperty(*id1, CURRENT_ATTR);
|
||||
thisObj->deleteProperty(*id2, CURRENT_ATTR);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return thisValue;
|
||||
}
|
||||
|
||||
static JSValue Array_shift(Context *cx, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
|
||||
{
|
||||
ContextStackReplacement csr(cx);
|
||||
|
||||
ASSERT(thisValue.isObject());
|
||||
JSObject *thisObj = thisValue.object;
|
||||
|
||||
thisObj->getProperty(cx, widenCString("length"), CURRENT_ATTR);
|
||||
JSValue result = cx->popValue();
|
||||
uint32 length = (uint32)(result.toUInt32(cx).f64);
|
||||
|
||||
if (length == 0) {
|
||||
thisObj->setProperty(cx, widenCString("length"), CURRENT_ATTR, result);
|
||||
return kUndefinedValue;
|
||||
}
|
||||
|
||||
thisObj->getProperty(cx, *numberToString(0), CURRENT_ATTR);
|
||||
result = cx->popValue();
|
||||
|
||||
for (uint32 k = 1; k < length; k++) {
|
||||
String *id1 = numberToString(k);
|
||||
String *id2 = numberToString(k - 1);
|
||||
|
||||
PropertyIterator it;
|
||||
if (thisObj->hasOwnProperty(*id1, CURRENT_ATTR, Read, &it)) {
|
||||
thisObj->getProperty(cx, *id1, CURRENT_ATTR);
|
||||
thisObj->setProperty(cx, *id2, CURRENT_ATTR, cx->popValue());
|
||||
}
|
||||
else
|
||||
thisObj->deleteProperty(*id2, CURRENT_ATTR);
|
||||
}
|
||||
|
||||
thisObj->deleteProperty(*numberToString(length - 1), CURRENT_ATTR);
|
||||
thisObj->setProperty(cx, widenCString("length"), CURRENT_ATTR, JSValue((float64)(length - 1)) );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
static JSValue Array_slice(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
|
||||
{
|
||||
ContextStackReplacement csr(cx);
|
||||
|
||||
ASSERT(thisValue.isObject());
|
||||
JSObject *thisObj = thisValue.object;
|
||||
|
||||
JSArrayInstance *A = (JSArrayInstance *)Array_Type->newInstance(cx);
|
||||
|
||||
thisObj->getProperty(cx, widenCString("length"), CURRENT_ATTR);
|
||||
JSValue result = cx->popValue();
|
||||
uint32 length = (uint32)(result.toUInt32(cx).f64);
|
||||
|
||||
uint32 start, end;
|
||||
if (argc < 1)
|
||||
start = 0;
|
||||
else {
|
||||
int32 arg0 = (int32)(argv[0].toInt32(cx).f64);
|
||||
if (arg0 < 0) {
|
||||
arg0 += length;
|
||||
if (arg0 < 0)
|
||||
start = 0;
|
||||
else
|
||||
start = toUInt32(arg0);
|
||||
}
|
||||
else {
|
||||
if (toUInt32(arg0) >= length) // cast ok since > 0
|
||||
start = length;
|
||||
else
|
||||
start = toUInt32(arg0);
|
||||
}
|
||||
}
|
||||
|
||||
if (argc < 2)
|
||||
end = length;
|
||||
else {
|
||||
int32 arg1 = (int32)(argv[1].toInt32(cx).f64);
|
||||
if (arg1 < 0) {
|
||||
arg1 += length;
|
||||
if (arg1 < 0)
|
||||
end = 0;
|
||||
else
|
||||
end = toUInt32(arg1);
|
||||
}
|
||||
else {
|
||||
if (toUInt32(arg1) >= length)
|
||||
end = length;
|
||||
else
|
||||
end = toUInt32(arg1);
|
||||
}
|
||||
}
|
||||
|
||||
uint32 n = 0;
|
||||
while (start < end) {
|
||||
String *id1 = numberToString(start);
|
||||
PropertyIterator it;
|
||||
if (thisObj->hasOwnProperty(*id1, CURRENT_ATTR, Read, &it)) {
|
||||
String *id2 = numberToString(n);
|
||||
thisObj->getProperty(cx, *id1, CURRENT_ATTR);
|
||||
A->setProperty(cx, *id2, CURRENT_ATTR, cx->popValue());
|
||||
}
|
||||
n++;
|
||||
start++;
|
||||
}
|
||||
A->setProperty(cx, widenCString("length"), CURRENT_ATTR, JSValue((float64)n) );
|
||||
return JSValue(A);
|
||||
}
|
||||
|
||||
static JSValue Array_sort(Context * /*cx*/, const JSValue& /*thisValue*/, JSValue * /*argv*/, uint32 /*argc*/)
|
||||
{
|
||||
return kUndefinedValue;
|
||||
}
|
||||
|
||||
static JSValue Array_splice(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc > 1) {
|
||||
uint32 k;
|
||||
ContextStackReplacement csr(cx);
|
||||
|
||||
ASSERT(thisValue.isObject());
|
||||
JSObject *thisObj = thisValue.object;
|
||||
thisObj->getProperty(cx, widenCString("length"), CURRENT_ATTR);
|
||||
JSValue result = cx->popValue();
|
||||
uint32 length = (uint32)(result.toUInt32(cx).f64);
|
||||
|
||||
JSArrayInstance *A = (JSArrayInstance *)Array_Type->newInstance(cx);
|
||||
|
||||
int32 arg0 = (int32)(argv[0].toInt32(cx).f64);
|
||||
uint32 start;
|
||||
if (arg0 < 0) {
|
||||
arg0 += length;
|
||||
if (arg0 < 0)
|
||||
start = 0;
|
||||
else
|
||||
start = toUInt32(arg0);
|
||||
}
|
||||
else {
|
||||
if (toUInt32(arg0) >= length)
|
||||
start = length;
|
||||
else
|
||||
start = toUInt32(arg0);
|
||||
}
|
||||
|
||||
uint32 deleteCount;
|
||||
int32 arg1 = (int32)(argv[1].toInt32(cx).f64);
|
||||
if (arg1 < 0)
|
||||
deleteCount = 0;
|
||||
else
|
||||
if (toUInt32(arg1) >= (length - start))
|
||||
deleteCount = length - start;
|
||||
else
|
||||
deleteCount = toUInt32(arg1);
|
||||
|
||||
for (k = 0; k < deleteCount; k++) {
|
||||
String *id1 = numberToString(start + k);
|
||||
PropertyIterator it;
|
||||
if (thisObj->hasOwnProperty(*id1, CURRENT_ATTR, Read, &it)) {
|
||||
String *id2 = numberToString(k);
|
||||
thisObj->getProperty(cx, *id1, CURRENT_ATTR);
|
||||
A->setProperty(cx, *id2, CURRENT_ATTR, cx->popValue());
|
||||
}
|
||||
}
|
||||
A->setProperty(cx, widenCString("length"), CURRENT_ATTR, JSValue((float64)deleteCount) );
|
||||
|
||||
uint32 newItemCount = argc - 2;
|
||||
if (newItemCount < deleteCount) {
|
||||
for (k = start; k < (length - deleteCount); k++) {
|
||||
String *id1 = numberToString(k + deleteCount);
|
||||
String *id2 = numberToString(k + newItemCount);
|
||||
PropertyIterator it;
|
||||
if (thisObj->hasOwnProperty(*id1, CURRENT_ATTR, Read, &it)) {
|
||||
thisObj->getProperty(cx, *id1, CURRENT_ATTR);
|
||||
thisObj->setProperty(cx, *id2, CURRENT_ATTR, cx->popValue());
|
||||
}
|
||||
else
|
||||
thisObj->deleteProperty(*id2, CURRENT_ATTR);
|
||||
}
|
||||
for (k = length; k > (length - deleteCount + newItemCount); k--) {
|
||||
String *id1 = numberToString(k - 1);
|
||||
thisObj->deleteProperty(*id1, CURRENT_ATTR);
|
||||
}
|
||||
}
|
||||
else {
|
||||
if (newItemCount > deleteCount) {
|
||||
for (k = length - deleteCount; k > start; k--) {
|
||||
String *id1 = numberToString(k + deleteCount - 1);
|
||||
String *id2 = numberToString(k + newItemCount - 1);
|
||||
PropertyIterator it;
|
||||
if (thisObj->hasOwnProperty(*id1, CURRENT_ATTR, Read, &it)) {
|
||||
thisObj->getProperty(cx, *id1, CURRENT_ATTR);
|
||||
thisObj->setProperty(cx, *id2, CURRENT_ATTR, cx->popValue());
|
||||
}
|
||||
else
|
||||
thisObj->deleteProperty(*id2, CURRENT_ATTR);
|
||||
}
|
||||
}
|
||||
}
|
||||
k = start;
|
||||
for (uint32 i = 2; i < argc; i++) {
|
||||
String *id1 = numberToString(k++);
|
||||
thisObj->setProperty(cx, *id1, CURRENT_ATTR, argv[i]);
|
||||
}
|
||||
thisObj->setProperty(cx, widenCString("length"), CURRENT_ATTR, JSValue((float64)(length - deleteCount + newItemCount)) );
|
||||
|
||||
return JSValue(A);
|
||||
}
|
||||
return kUndefinedValue;
|
||||
}
|
||||
|
||||
static JSValue Array_unshift(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
|
||||
{
|
||||
ContextStackReplacement csr(cx);
|
||||
|
||||
ASSERT(thisValue.isObject());
|
||||
JSObject *thisObj = thisValue.object;
|
||||
thisObj->getProperty(cx, widenCString("length"), CURRENT_ATTR);
|
||||
JSValue result = cx->popValue();
|
||||
uint32 length = (uint32)(result.toUInt32(cx).f64);
|
||||
uint32 k;
|
||||
|
||||
for (k = length; k > 0; k--) {
|
||||
String *id1 = numberToString(k - 1);
|
||||
String *id2 = numberToString(k + argc - 1);
|
||||
PropertyIterator it;
|
||||
if (thisObj->hasOwnProperty(*id1, CURRENT_ATTR, Read, &it)) {
|
||||
thisObj->getProperty(cx, *id1, CURRENT_ATTR);
|
||||
thisObj->setProperty(cx, *id2, CURRENT_ATTR, cx->popValue());
|
||||
}
|
||||
else
|
||||
thisObj->deleteProperty(*id2, CURRENT_ATTR);
|
||||
}
|
||||
|
||||
for (k = 0; k < argc; k++) {
|
||||
String *id1 = numberToString(k);
|
||||
thisObj->setProperty(cx, *id1, CURRENT_ATTR, argv[k]);
|
||||
}
|
||||
thisObj->setProperty(cx, widenCString("length"), CURRENT_ATTR, JSValue((float64)(length + argc)) );
|
||||
|
||||
return thisValue;
|
||||
}
|
||||
|
||||
|
||||
Context::PrototypeFunctions *getArrayProtos()
|
||||
{
|
||||
Context::ProtoFunDef arrayProtos[] =
|
||||
{
|
||||
{ "toString", String_Type, 0, Array_toString },
|
||||
{ "toLocaleString", String_Type, 0, Array_toString }, // XXX
|
||||
{ "toSource", String_Type, 0, Array_toSource },
|
||||
{ "push", Number_Type, 1, Array_push },
|
||||
{ "pop", Object_Type, 0, Array_pop },
|
||||
{ "concat", Array_Type, 1, Array_concat },
|
||||
{ "join", String_Type, 1, Array_join },
|
||||
{ "reverse", Array_Type, 0, Array_reverse },
|
||||
{ "shift", Object_Type, 0, Array_shift },
|
||||
{ "slice", Array_Type, 2, Array_slice },
|
||||
{ "sort", Array_Type, 1, Array_sort },
|
||||
{ "splice", Array_Type, 2, Array_splice },
|
||||
{ "unshift", Number_Type, 1, Array_unshift },
|
||||
{ NULL }
|
||||
};
|
||||
return new Context::PrototypeFunctions(&arrayProtos[0]);
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
@@ -1,48 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
namespace JavaScript {
|
||||
|
||||
namespace JS2Runtime {
|
||||
|
||||
|
||||
extern JSValue Array_Constructor(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc);
|
||||
extern JSValue Array_concat(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc);
|
||||
|
||||
Context::PrototypeFunctions *getArrayProtos();
|
||||
|
||||
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
@@ -1,491 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef jsclasses_h
|
||||
#define jsclasses_h
|
||||
|
||||
#include "jstypes.h"
|
||||
|
||||
namespace JavaScript {
|
||||
namespace JSClasses {
|
||||
|
||||
using JSTypes::JSValue;
|
||||
using JSTypes::JSObject;
|
||||
using JSTypes::JSType;
|
||||
using JSTypes::JSScope;
|
||||
using JSTypes::JSFunction;
|
||||
using JSTypes::FunctionMap;
|
||||
using ICG::ICodeModule;
|
||||
|
||||
|
||||
struct JSSlot {
|
||||
typedef enum { kNoFlag = 0, kIsConstructor = 0x01, kIsVirtual = 0x02 } SlotFlags; // <-- readonly, enumerable etc
|
||||
|
||||
// a slot may have a getter or a setter or both, but NOT either if mActual
|
||||
JSType* mType;
|
||||
uint32 mIndex;
|
||||
SlotFlags mFlags;
|
||||
JSFunction* mGetter;
|
||||
JSFunction* mSetter;
|
||||
bool mActual;
|
||||
|
||||
JSSlot() : mType(0), mFlags(kNoFlag), mGetter(0), mSetter(0), mActual(true)
|
||||
{
|
||||
}
|
||||
|
||||
bool isConstructor() const { return (mFlags & kIsConstructor) != 0; }
|
||||
bool isVirtual() const { return (mFlags & kIsVirtual) != 0; }
|
||||
};
|
||||
|
||||
typedef gc_map_allocator(JSSlot) gc_slot_allocator;
|
||||
typedef std::map<String, JSSlot, std::less<const String>, gc_slot_allocator> JSSlots;
|
||||
|
||||
|
||||
typedef std::pair<String, JSFunction*> MethodEntry;
|
||||
typedef std::vector<MethodEntry, gc_allocator<MethodEntry> > JSMethods;
|
||||
typedef std::vector<JSFunction*, gc_allocator<JSFunction*> > JSFunctions;
|
||||
|
||||
struct JSOperator {
|
||||
JSType *mOperand1;
|
||||
JSType *mOperand2;
|
||||
JSFunction *mFunction;
|
||||
JSOperator(JSType *op1, JSType *op2, JSFunction *f) : mOperand1(op1), mOperand2(op2), mFunction(f) { }
|
||||
};
|
||||
typedef std::vector<JSOperator *, gc_allocator<JSOperator *> > JSOperatorList;
|
||||
|
||||
|
||||
/**
|
||||
* Represents a class in the JavaScript 2 (ECMA 4) language.
|
||||
* Since a class defines a scope, and is defined in a scope,
|
||||
* a new scope is created whose parent scope is the scope of
|
||||
* class definition.
|
||||
*/
|
||||
class JSClass : public JSType {
|
||||
|
||||
protected:
|
||||
JSScope* mScope;
|
||||
uint32 mSlotCount;
|
||||
JSSlots mSlots;
|
||||
uint32 mStaticCount;
|
||||
JSSlots mStaticSlots;
|
||||
JSValue* mStaticData;
|
||||
JSMethods mMethods;
|
||||
bool mHasGetters; // tracks whether any getters/setters get assigned
|
||||
bool mHasSetters;
|
||||
JSFunctions mGetters; // allocated at 'complete()' time
|
||||
JSFunctions mSetters;
|
||||
JSOperatorList *mOperators[JSTypes::OperatorCount];
|
||||
public:
|
||||
JSClass(JSScope* scope, const String& name, JSClass* superClass = 0)
|
||||
: JSType(name, superClass),
|
||||
mScope(new JSScope(scope)),
|
||||
mSlotCount(superClass ? superClass->mSlotCount : 0),
|
||||
mStaticCount(0),
|
||||
mStaticData(0),
|
||||
mHasGetters(false), mHasSetters(false), mGetters(0), mSetters(0)
|
||||
{
|
||||
if (superClass) {
|
||||
// inherit superclass methods
|
||||
mMethods = JSMethods(superClass->mMethods);
|
||||
// and virtual fields
|
||||
JSSlots::iterator sEnd = superClass->mSlots.end();
|
||||
for (JSSlots::iterator si = superClass->mSlots.begin(); si != sEnd; si++)
|
||||
if (si->second.isVirtual())
|
||||
mSlots[si->first] = si->second;
|
||||
}
|
||||
for (uint32 i = 0; i < JSTypes::OperatorCount; i++)
|
||||
mOperators[i] = NULL;
|
||||
}
|
||||
|
||||
JSClass* getSuperClass()
|
||||
{
|
||||
return static_cast<JSClass*>(mBaseType);
|
||||
}
|
||||
|
||||
JSScope* getScope()
|
||||
{
|
||||
return mScope;
|
||||
}
|
||||
|
||||
const JSSlot& defineSlot(const String& name, JSType* type, JSSlot::SlotFlags flags = JSSlot::kNoFlag, JSFunction* getter = 0, JSFunction* setter = 0)
|
||||
{
|
||||
JSSlot& slot = mSlots[name];
|
||||
slot.mType = type;
|
||||
slot.mIndex = mSlotCount++; // starts at 0.
|
||||
slot.mSetter = setter;
|
||||
slot.mGetter = getter;
|
||||
slot.mFlags = flags;
|
||||
if (setter || getter)
|
||||
slot.mActual = false;
|
||||
return slot;
|
||||
}
|
||||
|
||||
void setGetter(const String& name, JSFunction *getter, JSType* type)
|
||||
{
|
||||
JSSlots::iterator slti = mSlots.find(name);
|
||||
if (slti == mSlots.end())
|
||||
defineSlot(name, type, JSSlot::kNoFlag, getter, 0);
|
||||
else {
|
||||
ASSERT(!slti->second.mActual || slti->second.isVirtual());
|
||||
ASSERT(slti->second.mGetter == 0);
|
||||
slti->second.mGetter = getter;
|
||||
slti->second.mActual = false;
|
||||
}
|
||||
mHasGetters = true;
|
||||
}
|
||||
|
||||
void setSetter(const String& name, JSFunction *setter, JSType* type)
|
||||
{
|
||||
JSSlots::iterator slti = mSlots.find(name);
|
||||
if (slti == mSlots.end())
|
||||
defineSlot(name, type, JSSlot::kNoFlag, 0, setter);
|
||||
else {
|
||||
JSSlot &s = slti->second;
|
||||
ASSERT(!s.mActual || s.isVirtual());
|
||||
ASSERT(s.mSetter == 0);
|
||||
s.mSetter = setter;
|
||||
s.mActual = false;
|
||||
}
|
||||
mHasSetters = true;
|
||||
}
|
||||
|
||||
bool hasGetter(const String& name)
|
||||
{
|
||||
JSSlots::iterator slti = mSlots.find(name);
|
||||
return ((slti != mSlots.end()) && slti->second.mGetter);
|
||||
}
|
||||
|
||||
bool hasSetter(const String& name)
|
||||
{
|
||||
JSSlots::iterator slti = mSlots.find(name);
|
||||
return ((slti != mSlots.end()) && slti->second.mSetter);
|
||||
}
|
||||
|
||||
bool hasGetter(uint32 index)
|
||||
{
|
||||
return (index < mGetters.size() && mGetters[index]);
|
||||
}
|
||||
|
||||
bool hasSetter(uint32 index)
|
||||
{
|
||||
return (index < mSetters.size() && mSetters[index]);
|
||||
}
|
||||
|
||||
JSFunction* getter(uint32 index)
|
||||
{
|
||||
return mGetters[index];
|
||||
}
|
||||
|
||||
JSFunction* setter(uint32 index)
|
||||
{
|
||||
return mSetters[index];
|
||||
}
|
||||
|
||||
|
||||
const JSSlot& getSlot(const String& name)
|
||||
{
|
||||
return mSlots[name];
|
||||
}
|
||||
|
||||
bool hasSlot(const String& name)
|
||||
{
|
||||
return (mSlots.find(name) != mSlots.end());
|
||||
}
|
||||
|
||||
bool hasGetterOrSetter(const String& name)
|
||||
{
|
||||
return (mSlots.find(name) != mSlots.end());
|
||||
}
|
||||
|
||||
JSSlots& getSlots()
|
||||
{
|
||||
return mSlots;
|
||||
}
|
||||
|
||||
uint32 getSlotCount()
|
||||
{
|
||||
return mSlotCount;
|
||||
}
|
||||
|
||||
/**
|
||||
* Define a static/class variable.
|
||||
*/
|
||||
const JSSlot& defineStatic(const String& name, JSType* type)
|
||||
{
|
||||
JSSlot& slot = mStaticSlots[name];
|
||||
ASSERT(slot.mType == 0);
|
||||
slot.mType = type;
|
||||
slot.mIndex = mStaticCount++;
|
||||
return slot;
|
||||
}
|
||||
|
||||
const JSSlot& defineConstructor(const String& name)
|
||||
{
|
||||
JSSlot& slot = mStaticSlots[name];
|
||||
ASSERT(slot.mType == 0);
|
||||
slot.mType = &JSTypes::Function_Type;
|
||||
slot.mIndex = mStaticCount++;
|
||||
slot.mFlags = JSSlot::kIsConstructor;
|
||||
return slot;
|
||||
}
|
||||
|
||||
JSFunction *getDefaultConstructor()
|
||||
{
|
||||
if (hasStatic(mName)) {
|
||||
const JSSlot &s = getStatic(mName);
|
||||
ASSERT(s.isConstructor());
|
||||
JSValue &v = (*this)[s.mIndex];
|
||||
ASSERT(v.isFunction());
|
||||
return v.function;
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
const JSSlot& getStatic(const String& name)
|
||||
{
|
||||
return mStaticSlots[name];
|
||||
}
|
||||
|
||||
bool hasStatic(const String& name, JSType*& type, bool &isConstructor)
|
||||
{
|
||||
JSSlots::const_iterator i = mStaticSlots.find(name);
|
||||
if (i != mStaticSlots.end()) {
|
||||
type = i->second.mType;
|
||||
isConstructor = i->second.isConstructor();
|
||||
return true;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
bool hasStatic(const String& name)
|
||||
{
|
||||
return (mStaticSlots.find(name) != mStaticSlots.end());
|
||||
}
|
||||
|
||||
bool complete()
|
||||
{
|
||||
if (mHasGetters || mHasSetters) {
|
||||
if (mHasGetters) mGetters.resize(mSlotCount);
|
||||
if (mHasSetters) mSetters.resize(mSlotCount);
|
||||
JSSlots::iterator end = mSlots.end();
|
||||
for (JSSlots::iterator i = mSlots.begin(); i != end; i++) {
|
||||
if (mHasGetters) mGetters[i->second.mIndex] = i->second.mGetter;
|
||||
if (mHasSetters) mSetters[i->second.mIndex] = i->second.mSetter;
|
||||
}
|
||||
}
|
||||
mStaticData = new JSValue[mStaticCount];
|
||||
return (mStaticData != 0);
|
||||
}
|
||||
|
||||
JSValue& operator[] (uint32 index)
|
||||
{
|
||||
return mStaticData[index];
|
||||
}
|
||||
|
||||
virtual void printProperties(Formatter& f)
|
||||
{
|
||||
f << "Properties:\n";
|
||||
JSObject::printProperties(f);
|
||||
f << "Statics:\n";
|
||||
printStatics(f);
|
||||
}
|
||||
|
||||
void printStatics(Formatter& f)
|
||||
{
|
||||
JSClass* superClass = getSuperClass();
|
||||
if (superClass) superClass->printStatics(f);
|
||||
for (JSSlots::iterator i = mStaticSlots.begin(), end = mStaticSlots.end(); i != end; ++i) {
|
||||
f << i->first << " : " << mStaticData[i->second.mIndex] << "\n";
|
||||
}
|
||||
}
|
||||
|
||||
void defineOperator(JSTypes::Operator op, JSType *operand1, JSType *operand2, JSFunction *f)
|
||||
{
|
||||
if (!mOperators[op])
|
||||
mOperators[op] = new JSOperatorList();
|
||||
else {
|
||||
for (JSOperatorList::iterator i = mOperators[op]->begin(),
|
||||
end = mOperators[op]->end(); i != end; ++i) {
|
||||
if (((*i)->mOperand1 == operand1)
|
||||
&& ((*i)->mOperand2 == operand2)) {
|
||||
(*i)->mFunction = f;
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
mOperators[op]->push_back(new JSOperator(operand1, operand2, f));
|
||||
}
|
||||
|
||||
void addApplicableOperators(JSOperatorList &list, JSTypes::Operator op, const JSType *operand1, const JSType *operand2)
|
||||
{
|
||||
if (mOperators[op]) {
|
||||
for (JSOperatorList::iterator i = mOperators[op]->begin(),
|
||||
end = mOperators[op]->end(); i != end; ++i) {
|
||||
if (operand1->isSubTypeOf((*i)->mOperand1) && operand2->isSubTypeOf((*i)->mOperand2)) {
|
||||
list.push_back(*i);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
JSOperator *findUnaryOperator(JSTypes::Operator op)
|
||||
{
|
||||
if (mOperators[op])
|
||||
return *mOperators[op]->begin();
|
||||
else {
|
||||
JSClass *super = getSuperClass();
|
||||
if (super)
|
||||
return super->findUnaryOperator(op);
|
||||
else
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
|
||||
void defineMethod(const String& name, JSFunction *f)
|
||||
{
|
||||
uint32 slot;
|
||||
if (hasMethod(name, slot))
|
||||
mMethods[slot] = MethodEntry(name, f);
|
||||
else
|
||||
mMethods.push_back(MethodEntry(name, f));
|
||||
}
|
||||
|
||||
bool hasMethod(const String& name, uint32& index)
|
||||
{
|
||||
JSMethods::iterator end = mMethods.end();
|
||||
for (JSMethods::iterator i = mMethods.begin(); i != end; i++) {
|
||||
if (i->first == name) {
|
||||
index = static_cast<uint32>(i - mMethods.begin());
|
||||
return true;
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
JSFunction* getMethod(uint32 index)
|
||||
{
|
||||
return mMethods[index].second;
|
||||
}
|
||||
};
|
||||
|
||||
/**
|
||||
* Represents an instance of a JSClass.
|
||||
*/
|
||||
class JSInstance : public JSObject {
|
||||
protected:
|
||||
JSValue mSlots[1];
|
||||
public:
|
||||
void* operator new(size_t n, JSClass* thisClass)
|
||||
{
|
||||
uint32 slotCount = thisClass->getSlotCount();
|
||||
if (slotCount > 0) n += sizeof(JSValue) * (slotCount - 1);
|
||||
return gc_base::operator new(n);
|
||||
}
|
||||
|
||||
void operator delete(void* /*ptr*/) {}
|
||||
void operator delete(void* /*ptr*/, JSClass* /*thisClass*/) {}
|
||||
|
||||
JSInstance(JSClass* thisClass)
|
||||
{
|
||||
mType = thisClass;
|
||||
// initialize extra slots with undefined.
|
||||
uint32 slotCount = thisClass->getSlotCount();
|
||||
if (slotCount > 0) {
|
||||
std::uninitialized_fill(&mSlots[1], &mSlots[1] + (slotCount - 1),
|
||||
JSTypes::kUndefinedValue);
|
||||
}
|
||||
// for grins, use the prototype link to access methods.
|
||||
// setPrototype(thisClass->getScope());
|
||||
}
|
||||
|
||||
JSFunction* getMethod(uint32 index)
|
||||
{
|
||||
return getClass()->getMethod(index);
|
||||
}
|
||||
|
||||
JSClass* getClass()
|
||||
{
|
||||
return static_cast<JSClass*>(mType);
|
||||
}
|
||||
|
||||
JSValue& operator[] (uint32 index)
|
||||
{
|
||||
return mSlots[index];
|
||||
}
|
||||
|
||||
virtual void printProperties(Formatter& f)
|
||||
{
|
||||
f << "Properties:\n";
|
||||
JSObject::printProperties(f);
|
||||
f << "Slots:\n";
|
||||
printSlots(f, getClass());
|
||||
}
|
||||
|
||||
bool hasGetter(uint32 index)
|
||||
{
|
||||
return getClass()->hasGetter(index);
|
||||
}
|
||||
|
||||
bool hasSetter(uint32 index)
|
||||
{
|
||||
return getClass()->hasSetter(index);
|
||||
}
|
||||
|
||||
JSFunction* getter(uint32 index)
|
||||
{
|
||||
return getClass()->getter(index);
|
||||
}
|
||||
|
||||
JSFunction* setter(uint32 index)
|
||||
{
|
||||
return getClass()->setter(index);
|
||||
}
|
||||
|
||||
|
||||
private:
|
||||
void printSlots(Formatter& f, JSClass* thisClass)
|
||||
{
|
||||
JSClass* superClass = thisClass->getSuperClass();
|
||||
if (superClass) printSlots(f, superClass);
|
||||
JSSlots& slots = thisClass->getSlots();
|
||||
for (JSSlots::iterator i = slots.begin(), end = slots.end(); i != end; ++i) {
|
||||
f << i->first << " : " << mSlots[i->second.mIndex] << "\n";
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
} /* namespace JSClasses */
|
||||
} /* namespace JavaScript */
|
||||
|
||||
#endif /* jsclasses_h */
|
||||
@@ -1,261 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifdef _WIN32
|
||||
// Turn off warnings about identifiers too long in browser information
|
||||
#pragma warning(disable: 4786)
|
||||
#pragma warning(disable: 4711)
|
||||
#pragma warning(disable: 4710)
|
||||
#endif
|
||||
|
||||
#include <algorithm>
|
||||
|
||||
#include "parser.h"
|
||||
#include "numerics.h"
|
||||
#include "js2runtime.h"
|
||||
|
||||
#include "jsmath.h"
|
||||
|
||||
#include "fdlibm_ns.h"
|
||||
|
||||
namespace JavaScript {
|
||||
namespace JS2Runtime {
|
||||
|
||||
#ifndef M_E
|
||||
#define M_E 2.7182818284590452354
|
||||
#endif
|
||||
#ifndef M_LOG2E
|
||||
#define M_LOG2E 1.4426950408889634074
|
||||
#endif
|
||||
#ifndef M_LOG10E
|
||||
#define M_LOG10E 0.43429448190325182765
|
||||
#endif
|
||||
#ifndef M_LN2
|
||||
#define M_LN2 0.69314718055994530942
|
||||
#endif
|
||||
#ifndef M_LN10
|
||||
#define M_LN10 2.30258509299404568402
|
||||
#endif
|
||||
#ifndef M_PI
|
||||
#define M_PI 3.14159265358979323846
|
||||
#endif
|
||||
#ifndef M_SQRT2
|
||||
#define M_SQRT2 1.41421356237309504880
|
||||
#endif
|
||||
#ifndef M_SQRT1_2
|
||||
#define M_SQRT1_2 0.70710678118654752440
|
||||
#endif
|
||||
#define M_CONSTANTS_COUNT 8
|
||||
|
||||
|
||||
static JSValue Math_abs(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc == 0)
|
||||
return kNaNValue;
|
||||
else
|
||||
return JSValue(fd::fabs(argv[0].toNumber(cx).f64));
|
||||
}
|
||||
static JSValue Math_acos(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc == 0)
|
||||
return kNaNValue;
|
||||
return JSValue(fd::acos(argv[0].toNumber(cx).f64));
|
||||
}
|
||||
static JSValue Math_asin(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc == 0)
|
||||
return kNaNValue;
|
||||
return JSValue(fd::asin(argv[0].toNumber(cx).f64));
|
||||
}
|
||||
static JSValue Math_atan(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc == 0)
|
||||
return kNaNValue;
|
||||
return JSValue(fd::atan(argv[0].toNumber(cx).f64));
|
||||
}
|
||||
static JSValue Math_atan2(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc <= 1)
|
||||
return kNaNValue;
|
||||
float64 y = argv[0].toNumber(cx).f64;
|
||||
float64 x = argv[1].toNumber(cx).f64;
|
||||
return JSValue(fd::atan2(y, x));
|
||||
}
|
||||
static JSValue Math_ceil(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc == 0)
|
||||
return kNaNValue;
|
||||
return JSValue(fd::ceil(argv[0].toNumber(cx).f64));
|
||||
}
|
||||
static JSValue Math_cos(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc == 0)
|
||||
return kNaNValue;
|
||||
return JSValue(fd::cos(argv[0].toNumber(cx).f64));
|
||||
}
|
||||
static JSValue Math_exp(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc == 0)
|
||||
return kNaNValue;
|
||||
return JSValue(fd::exp(argv[0].toNumber(cx).f64));
|
||||
}
|
||||
static JSValue Math_floor(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc == 0)
|
||||
return kNaNValue;
|
||||
else
|
||||
return JSValue(fd::floor(argv[0].toNumber(cx).f64));
|
||||
}
|
||||
static JSValue Math_log(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc == 0)
|
||||
return kNaNValue;
|
||||
return JSValue(fd::log(argv[0].toNumber(cx).f64));
|
||||
}
|
||||
static JSValue Math_max(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc == 0)
|
||||
return kNaNValue;
|
||||
float64 result = argv[0].toNumber(cx).f64;
|
||||
for (uint32 i = 1; i < argc; ++i) {
|
||||
float64 arg = argv[i].toNumber(cx).f64;
|
||||
if (arg > result)
|
||||
result = arg;
|
||||
}
|
||||
return JSValue(result);
|
||||
}
|
||||
static JSValue Math_min(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc == 0)
|
||||
return kNaNValue;
|
||||
float64 result = argv[0].toNumber(cx).f64;
|
||||
for (uint32 i = 1; i < argc; ++i) {
|
||||
float64 arg = argv[i].toNumber(cx).f64;
|
||||
if (arg < result)
|
||||
result = arg;
|
||||
}
|
||||
return JSValue(result);
|
||||
}
|
||||
static JSValue Math_pow(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc < 1)
|
||||
return kNaNValue;
|
||||
return JSValue(fd::pow(argv[0].toNumber(cx).f64, argv[1].toNumber(cx).f64));
|
||||
}
|
||||
static JSValue Math_random(Context * /*cx*/, const JSValue& /*thisValue*/, JSValue * /*argv*/, uint32 /*argc*/)
|
||||
{
|
||||
return JSValue(42.0);
|
||||
}
|
||||
static JSValue Math_round(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc == 0)
|
||||
return kNaNValue;
|
||||
float64 x = argv[0].toNumber(cx).f64;
|
||||
return JSValue( fd::copysign( fd::floor(x + 0.5), x ) );
|
||||
}
|
||||
static JSValue Math_sin(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc == 0)
|
||||
return kNaNValue;
|
||||
return JSValue(fd::sin(argv[0].toNumber(cx).f64));
|
||||
}
|
||||
static JSValue Math_sqrt(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc == 0)
|
||||
return kNaNValue;
|
||||
return JSValue(fd::sqrt(argv[0].toNumber(cx).f64));
|
||||
}
|
||||
static JSValue Math_tan(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
if (argc == 0)
|
||||
return kNaNValue;
|
||||
return JSValue(fd::tan(argv[0].toNumber(cx).f64));
|
||||
}
|
||||
|
||||
|
||||
struct {
|
||||
char *name;
|
||||
float64 value;
|
||||
} MathObjectConstants[M_CONSTANTS_COUNT] = {
|
||||
{ "E", M_E },
|
||||
{ "LOG2E", M_LOG2E },
|
||||
{ "LOG10E", M_LOG10E },
|
||||
{ "LN2", M_LN2 },
|
||||
{ "LN10", M_LN10 },
|
||||
{ "PI", M_PI },
|
||||
{ "SQRT2", M_SQRT2 },
|
||||
{ "SQRT1_2",M_SQRT1_2 }
|
||||
};
|
||||
|
||||
struct MathObjectFunctionDef {
|
||||
char *name;
|
||||
JSFunction::NativeCode *imp;
|
||||
} MathObjectFunctions[] = {
|
||||
{ "abs", Math_abs },
|
||||
{ "acos", Math_acos },
|
||||
{ "asin", Math_asin },
|
||||
{ "atan", Math_atan },
|
||||
{ "atan2", Math_atan2 },
|
||||
{ "ceil", Math_ceil },
|
||||
{ "cos", Math_cos },
|
||||
{ "exp", Math_exp },
|
||||
{ "floor", Math_floor },
|
||||
{ "log", Math_log },
|
||||
{ "max", Math_max },
|
||||
{ "min", Math_min },
|
||||
{ "pow", Math_pow },
|
||||
{ "random", Math_random },
|
||||
{ "round", Math_round },
|
||||
{ "sin", Math_sin },
|
||||
{ "sqrt", Math_sqrt },
|
||||
{ "tan", Math_tan },
|
||||
};
|
||||
|
||||
void initMathObject(Context *cx, JSObject *mathObj)
|
||||
{
|
||||
uint32 i;
|
||||
for (i = 0; i < M_CONSTANTS_COUNT; i++)
|
||||
mathObj->defineVariable(cx, widenCString(MathObjectConstants[i].name),
|
||||
(NamespaceList *)(NULL), Number_Type, JSValue(MathObjectConstants[i].value));
|
||||
|
||||
for (i = 0; i < sizeof(MathObjectFunctions) / sizeof(MathObjectFunctionDef); i++) {
|
||||
JSFunction *f = new JSFunction(MathObjectFunctions[i].imp, Number_Type);
|
||||
mathObj->defineVariable(cx, widenCString(MathObjectFunctions[i].name),
|
||||
(NamespaceList *)(NULL), Number_Type, JSValue(f));
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
}
|
||||
}
|
||||
@@ -1,41 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
namespace JavaScript {
|
||||
namespace JS2Runtime {
|
||||
|
||||
void initMathObject(Context *cx, JSObject *mathObj);
|
||||
|
||||
|
||||
}
|
||||
}
|
||||
@@ -1,444 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifdef _WIN32
|
||||
// Turn off warnings about identifiers too long in browser information
|
||||
#pragma warning(disable: 4786)
|
||||
#pragma warning(disable: 4711)
|
||||
#pragma warning(disable: 4710)
|
||||
#endif
|
||||
|
||||
#include <algorithm>
|
||||
|
||||
#include "parser.h"
|
||||
#include "numerics.h"
|
||||
#include "js2runtime.h"
|
||||
|
||||
#include "jsstring.h"
|
||||
|
||||
namespace JavaScript {
|
||||
namespace JS2Runtime {
|
||||
|
||||
|
||||
JSValue String_Constructor(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
|
||||
{
|
||||
JSValue thatValue = thisValue;
|
||||
if (thatValue.isNull())
|
||||
thatValue = String_Type->newInstance(cx);
|
||||
ASSERT(thatValue.isObject());
|
||||
JSObject *thisObj = thatValue.object;
|
||||
ASSERT(dynamic_cast<JSStringInstance *>(thisObj));
|
||||
JSStringInstance *strInst = (JSStringInstance *)thisObj;
|
||||
|
||||
if (argc > 0)
|
||||
thisObj->mPrivate = (void *)(new String(*argv[0].toString(cx).string));
|
||||
else
|
||||
thisObj->mPrivate = (void *)(new String(widenCString("")));
|
||||
strInst->mLength = ((String *)(thisObj->mPrivate))->size();
|
||||
return thatValue;
|
||||
}
|
||||
|
||||
JSValue String_fromCharCode(Context *cx, const JSValue& /*thisValue*/, JSValue *argv, uint32 argc)
|
||||
{
|
||||
String *resultStr = new String();
|
||||
resultStr->reserve(argc);
|
||||
for (uint32 i = 0; i < argc; i++)
|
||||
*resultStr += (char16)(argv[i].toUInt16(cx).f64);
|
||||
|
||||
return JSValue(resultStr);
|
||||
}
|
||||
|
||||
static JSValue String_toString(Context * /*cx*/, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
|
||||
{
|
||||
ASSERT(thisValue.isObject());
|
||||
JSObject *thisObj = thisValue.object;
|
||||
return JSValue((String *)thisObj->mPrivate);
|
||||
}
|
||||
|
||||
struct MatchResult {
|
||||
bool failure;
|
||||
uint32 endIndex;
|
||||
String **captures;
|
||||
};
|
||||
|
||||
static void splitMatch(const String *S, uint32 q, const String *R, MatchResult &result)
|
||||
{
|
||||
result.failure = true;
|
||||
result.captures = NULL;
|
||||
|
||||
uint32 r = R->size();
|
||||
uint32 s = S->size();
|
||||
if ((q + r) > s)
|
||||
return;
|
||||
for (uint32 i = 0; i < r; i++) {
|
||||
if ((*S)[q + i] != (*R)[i])
|
||||
return;
|
||||
}
|
||||
result.endIndex = q + r;
|
||||
result.failure = false;
|
||||
}
|
||||
|
||||
static JSValue String_split(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
|
||||
{
|
||||
ContextStackReplacement csr(cx);
|
||||
|
||||
ASSERT(thisValue.isObject());
|
||||
JSValue S = thisValue.toString(cx);
|
||||
|
||||
JSArrayInstance *A = (JSArrayInstance *)Array_Type->newInstance(cx);
|
||||
uint32 lim;
|
||||
JSValue separatorV = (argc > 0) ? argv[0] : kUndefinedValue;
|
||||
JSValue limitV = (argc > 1) ? argv[1] : kUndefinedValue;
|
||||
|
||||
if (limitV.isUndefined())
|
||||
lim = (uint32)(two32minus1);
|
||||
else
|
||||
lim = (uint32)(limitV.toUInt32(cx).f64);
|
||||
|
||||
uint32 s = S.string->size();
|
||||
uint32 p = 0;
|
||||
|
||||
// XXX if separatorV.isRegExp() -->
|
||||
|
||||
const String *R = separatorV.toString(cx).string;
|
||||
|
||||
if (lim == 0)
|
||||
return JSValue(A);
|
||||
|
||||
if (separatorV.isUndefined()) {
|
||||
A->setProperty(cx, widenCString("0"), NULL, S);
|
||||
return JSValue(A);
|
||||
}
|
||||
|
||||
if (s == 0) {
|
||||
MatchResult z;
|
||||
splitMatch(S.string, 0, R, z);
|
||||
if (!z.failure)
|
||||
return JSValue(A);
|
||||
A->setProperty(cx, widenCString("0"), NULL, S);
|
||||
return JSValue(A);
|
||||
}
|
||||
|
||||
while (true) {
|
||||
uint32 q = p;
|
||||
step11:
|
||||
if (q == s) {
|
||||
String *T = new String(*S.string, p, (s - p));
|
||||
JSValue v(T);
|
||||
A->setProperty(cx, *numberToString(A->mLength), NULL, v);
|
||||
return JSValue(A);
|
||||
}
|
||||
MatchResult z;
|
||||
splitMatch(S.string, q, R, z);
|
||||
if (z.failure) {
|
||||
q = q + 1;
|
||||
goto step11;
|
||||
}
|
||||
uint32 e = z.endIndex;
|
||||
if (e == p) {
|
||||
q = q + 1;
|
||||
goto step11;
|
||||
}
|
||||
String *T = new String(*S.string, p, (q - p));
|
||||
JSValue v(T);
|
||||
A->setProperty(cx, *numberToString(A->mLength), NULL, v);
|
||||
if (A->mLength == lim)
|
||||
return JSValue(A);
|
||||
p = e;
|
||||
// step 20 --> 27, handle captures array (we know it's empty for non regexp)
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
static JSValue String_valueOf(Context * /*cx*/, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
|
||||
{
|
||||
ASSERT(thisValue.isObject());
|
||||
if (thisValue.isString())
|
||||
return thisValue;
|
||||
else
|
||||
throw Exception(Exception::typeError, "String.valueOf called on");
|
||||
return kUndefinedValue;
|
||||
}
|
||||
|
||||
static JSValue String_charAt(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
|
||||
{
|
||||
ASSERT(thisValue.isObject());
|
||||
const String *str = thisValue.toString(cx).string;
|
||||
|
||||
uint32 pos = 0;
|
||||
if (argc > 0)
|
||||
pos = (uint32)(argv[0].toInt32(cx).f64);
|
||||
|
||||
if ((pos < 0) || (pos >= str->size()))
|
||||
return JSValue(new String()); // have an empty string kValue somewhere?
|
||||
else
|
||||
return JSValue(new String(1, (*str)[pos]));
|
||||
|
||||
}
|
||||
|
||||
static JSValue String_charCodeAt(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
|
||||
{
|
||||
ASSERT(thisValue.isObject());
|
||||
const String *str = thisValue.toString(cx).string;
|
||||
|
||||
uint32 pos = 0;
|
||||
if (argc > 0)
|
||||
pos = (uint32)(argv[0].toInt32(cx).f64);
|
||||
|
||||
if ((pos < 0) || (pos >= str->size()))
|
||||
return kNaNValue;
|
||||
else
|
||||
return JSValue((float64)(*str)[pos]);
|
||||
}
|
||||
|
||||
static JSValue String_concat(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
|
||||
{
|
||||
ASSERT(thisValue.isObject());
|
||||
const String *str = thisValue.toString(cx).string;
|
||||
String *result = new String(*str);
|
||||
|
||||
for (uint32 i = 0; i < argc; i++) {
|
||||
*result += *argv[i].toString(cx).string;
|
||||
}
|
||||
|
||||
return JSValue(result);
|
||||
}
|
||||
|
||||
static JSValue String_indexOf(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
|
||||
{
|
||||
ASSERT(thisValue.isObject());
|
||||
if (argc == 0)
|
||||
return JSValue(-1.0);
|
||||
|
||||
const String *str = thisValue.toString(cx).string;
|
||||
const String *searchStr = argv[0].toString(cx).string;
|
||||
uint32 pos = 0;
|
||||
|
||||
if (argc > 1) {
|
||||
int32 arg1 = (int32)(argv[1].toInt32(cx).f64);
|
||||
if (arg1 < 0)
|
||||
pos = 0;
|
||||
else
|
||||
if (toUInt32(arg1) >= str->size())
|
||||
pos = str->size();
|
||||
else
|
||||
pos = toUInt32(arg1);
|
||||
}
|
||||
pos = str->find(*searchStr, pos);
|
||||
if (pos == String::npos)
|
||||
return JSValue(-1.0);
|
||||
return JSValue((float64)pos);
|
||||
}
|
||||
|
||||
static JSValue String_lastIndexOf(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
|
||||
{
|
||||
ASSERT(thisValue.isObject());
|
||||
if (argc == 0)
|
||||
return JSValue(-1.0);
|
||||
|
||||
const String *str = thisValue.toString(cx).string;
|
||||
const String *searchStr = argv[0].toString(cx).string;
|
||||
uint32 pos = 0;
|
||||
|
||||
if (argc > 1) {
|
||||
float64 fpos = argv[1].toNumber(cx).f64;
|
||||
if (fpos != fpos)
|
||||
pos = str->size();
|
||||
else {
|
||||
int32 arg1 = (int32)(fpos);
|
||||
if (arg1 < 0)
|
||||
pos = 0;
|
||||
else
|
||||
if (toUInt32(arg1) >= str->size())
|
||||
pos = str->size();
|
||||
else
|
||||
pos = toUInt32(arg1);
|
||||
}
|
||||
}
|
||||
pos = str->rfind(*searchStr, pos);
|
||||
if (pos == String::npos)
|
||||
return JSValue(-1.0);
|
||||
return JSValue((float64)pos);
|
||||
}
|
||||
|
||||
static JSValue String_localeCompare(Context * /*cx*/, const JSValue& /*thisValue*/, JSValue * /*argv*/, uint32 /*argc*/)
|
||||
{
|
||||
return kUndefinedValue;
|
||||
}
|
||||
|
||||
static JSValue String_toLowerCase(Context *cx, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
|
||||
{
|
||||
ASSERT(thisValue.isObject());
|
||||
JSValue S = thisValue.toString(cx);
|
||||
|
||||
String *result = new String(*S.string);
|
||||
for (String::iterator i = result->begin(), end = result->end(); i != end; i++)
|
||||
*i = toLower(*i);
|
||||
|
||||
return JSValue(result);
|
||||
}
|
||||
|
||||
static JSValue String_toUpperCase(Context *cx, const JSValue& thisValue, JSValue * /*argv*/, uint32 /*argc*/)
|
||||
{
|
||||
ASSERT(thisValue.isObject());
|
||||
JSValue S = thisValue.toString(cx);
|
||||
|
||||
String *result = new String(*S.string);
|
||||
for (String::iterator i = result->begin(), end = result->end(); i != end; i++)
|
||||
*i = toUpper(*i);
|
||||
|
||||
return JSValue(result);
|
||||
}
|
||||
|
||||
static JSValue String_slice(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
|
||||
{
|
||||
ASSERT(thisValue.isObject());
|
||||
const String *sourceString = thisValue.toString(cx).string;
|
||||
|
||||
uint32 sourceLength = sourceString->size();
|
||||
uint32 start, end;
|
||||
|
||||
if (argc > 0) {
|
||||
int32 arg0 = (int32)(argv[0].toInt32(cx).f64);
|
||||
if (arg0 < 0) {
|
||||
arg0 += sourceLength;
|
||||
if (arg0 < 0)
|
||||
start = 0;
|
||||
else
|
||||
start = toUInt32(arg0);
|
||||
}
|
||||
else {
|
||||
if (toUInt32(arg0) < sourceLength)
|
||||
start = toUInt32(arg0);
|
||||
else
|
||||
start = sourceLength;
|
||||
}
|
||||
}
|
||||
else
|
||||
start = 0;
|
||||
|
||||
if (argc > 1) {
|
||||
int32 arg1 = (int32)(argv[1].toInt32(cx).f64);
|
||||
if (arg1 < 0) {
|
||||
arg1 += sourceLength;
|
||||
if (arg1 < 0)
|
||||
end = 0;
|
||||
else
|
||||
end = toUInt32(arg1);
|
||||
}
|
||||
else {
|
||||
if (toUInt32(arg1) < sourceLength)
|
||||
end = toUInt32(arg1);
|
||||
else
|
||||
end = sourceLength;
|
||||
}
|
||||
}
|
||||
else
|
||||
end = sourceLength;
|
||||
|
||||
if (start > end)
|
||||
return JSValue(new String());
|
||||
return JSValue(new String(sourceString->substr(start, end - start)));
|
||||
}
|
||||
|
||||
static JSValue String_substring(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc)
|
||||
{
|
||||
ASSERT(thisValue.isObject());
|
||||
const String *sourceString = thisValue.toString(cx).string;
|
||||
|
||||
uint32 sourceLength = sourceString->size();
|
||||
uint32 start, end;
|
||||
|
||||
if (argc > 0) {
|
||||
int32 arg0 = (int32)(argv[0].toInt32(cx).f64);
|
||||
if (arg0 < 0)
|
||||
start = 0;
|
||||
else
|
||||
if (toUInt32(arg0) < sourceLength)
|
||||
start = toUInt32(arg0);
|
||||
else
|
||||
start = sourceLength;
|
||||
}
|
||||
else
|
||||
start = 0;
|
||||
|
||||
if (argc > 1) {
|
||||
int32 arg1 = (int32)(argv[1].toInt32(cx).f64);
|
||||
if (arg1 < 0)
|
||||
end = 0;
|
||||
else
|
||||
if (toUInt32(arg1) < sourceLength)
|
||||
end = toUInt32(arg1);
|
||||
else
|
||||
end = sourceLength;
|
||||
}
|
||||
else
|
||||
end = sourceLength;
|
||||
|
||||
if (start > end) {
|
||||
uint32 t = start;
|
||||
start = end;
|
||||
end = t;
|
||||
}
|
||||
|
||||
return JSValue(new String(sourceString->substr(start, end - start)));
|
||||
}
|
||||
|
||||
|
||||
Context::PrototypeFunctions *getStringProtos()
|
||||
{
|
||||
Context::ProtoFunDef stringProtos[] =
|
||||
{
|
||||
{ "toString", String_Type, 0, String_toString },
|
||||
{ "valueof", String_Type, 0, String_valueOf },
|
||||
{ "charAt", String_Type, 1, String_charAt },
|
||||
{ "charCodeAt", Number_Type, 1, String_charCodeAt },
|
||||
{ "concat", String_Type, 1, String_concat },
|
||||
{ "indexOf", Number_Type, 1, String_indexOf },
|
||||
{ "lastIndexOf", Number_Type, 1, String_lastIndexOf },
|
||||
{ "localeCompare", Number_Type, 1, String_localeCompare },
|
||||
{ "slice", String_Type, 2, String_slice },
|
||||
{ "split", Array_Type, 2, String_split },
|
||||
{ "substring", String_Type, 2, String_substring },
|
||||
{ "toSource", String_Type, 0, String_toString },
|
||||
{ "toLocaleUpperCase", String_Type, 0, String_toUpperCase }, // (sic)
|
||||
{ "toLocaleLowerCase", String_Type, 0, String_toLowerCase }, // (sic)
|
||||
{ "toUpperCase", String_Type, 0, String_toUpperCase },
|
||||
{ "toLowerCase", String_Type, 0, String_toLowerCase },
|
||||
{ NULL }
|
||||
};
|
||||
return new Context::PrototypeFunctions(&stringProtos[0]);
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
@@ -1,45 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
namespace JavaScript {
|
||||
namespace JS2Runtime {
|
||||
|
||||
|
||||
extern JSValue String_Constructor(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc);
|
||||
extern JSValue String_fromCharCode(Context *cx, const JSValue& thisValue, JSValue *argv, uint32 argc);
|
||||
|
||||
Context::PrototypeFunctions *getStringProtos();
|
||||
|
||||
|
||||
}
|
||||
}
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,782 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifndef jstypes_h
|
||||
#define jstypes_h
|
||||
|
||||
#include "utilities.h"
|
||||
#include "gc_allocator.h"
|
||||
#include "parser.h"
|
||||
#include <vector>
|
||||
#include <map>
|
||||
#include <stack>
|
||||
|
||||
|
||||
/* forward declare classes from JavaScript::ICG */
|
||||
namespace JavaScript {
|
||||
namespace ICG {
|
||||
class ICodeModule;
|
||||
} /* namespace ICG */
|
||||
namespace Interpreter {
|
||||
class Context;
|
||||
struct Activation;
|
||||
} /* namespace Interpreter */
|
||||
} /* namespace JavaScript */
|
||||
|
||||
namespace JavaScript {
|
||||
namespace JSTypes {
|
||||
|
||||
using ICG::ICodeModule;
|
||||
using Interpreter::Context;
|
||||
|
||||
class JSObject;
|
||||
class JSArray;
|
||||
class JSString;
|
||||
class JSFunction;
|
||||
class JSScope;
|
||||
class JSType;
|
||||
class Context;
|
||||
|
||||
typedef uint32 Register;
|
||||
|
||||
|
||||
/**
|
||||
* All JavaScript data types.
|
||||
*/
|
||||
struct JSValue {
|
||||
union {
|
||||
int8 i8;
|
||||
uint8 u8;
|
||||
int16 i16;
|
||||
uint16 u16;
|
||||
int32 i32;
|
||||
uint32 u32;
|
||||
int64 i64;
|
||||
uint64 u64;
|
||||
float32 f32;
|
||||
float64 f64;
|
||||
JSObject* object;
|
||||
JSArray* array;
|
||||
JSFunction *function;
|
||||
JSString *string;
|
||||
JSType *type;
|
||||
bool boolean;
|
||||
};
|
||||
|
||||
/* These are the ECMA types, for use in 'toPrimitive' calls */
|
||||
enum ECMA_type {
|
||||
Undefined, Null, Boolean, Number, Object, String,
|
||||
NoHint
|
||||
};
|
||||
|
||||
typedef enum {
|
||||
i8_tag, u8_tag,
|
||||
i16_tag, u16_tag,
|
||||
i32_tag, u32_tag,
|
||||
i64_tag, u64_tag,
|
||||
f32_tag, f64_tag,
|
||||
integer_tag,
|
||||
object_tag, array_tag, function_tag, string_tag, boolean_tag, type_tag,
|
||||
undefined_tag, null_tag,
|
||||
uninitialized_tag
|
||||
} Tag;
|
||||
Tag tag;
|
||||
|
||||
JSValue() : f64(0.0), tag(undefined_tag) {}
|
||||
explicit JSValue(int32 i32) : i32(i32), tag(i32_tag) {}
|
||||
explicit JSValue(uint32 u32) : u32(u32), tag(u32_tag) {}
|
||||
explicit JSValue(float64 f64) : f64(f64), tag(f64_tag) {}
|
||||
explicit JSValue(JSObject* object) : object(object), tag(object_tag) {}
|
||||
explicit JSValue(JSArray* array) : array(array), tag(array_tag) {}
|
||||
explicit JSValue(JSFunction* function) : function(function), tag(function_tag) {}
|
||||
explicit JSValue(JSString* string) : string(string), tag(string_tag) {}
|
||||
explicit JSValue(bool boolean) : boolean(boolean), tag(boolean_tag) {}
|
||||
explicit JSValue(JSType* type) : type(type), tag(type_tag) {}
|
||||
explicit JSValue(Tag tag) : tag(tag) {}
|
||||
|
||||
int32& operator=(int32 i32) { return (tag = i32_tag, this->i32 = i32); }
|
||||
uint32& operator=(uint32 u32) { return (tag = u32_tag, this->u32 = u32); }
|
||||
float64& operator=(float64 f64) { return (tag = f64_tag, this->f64 = f64); }
|
||||
JSObject*& operator=(JSObject* object) { return (tag = object_tag, this->object = object); }
|
||||
JSArray*& operator=(JSArray* array) { return (tag = array_tag, this->array = array); }
|
||||
JSFunction*& operator=(JSFunction* function) { return (tag = function_tag, this->function = function); }
|
||||
JSString*& operator=(JSString* string) { return (tag = string_tag, this->string = string); }
|
||||
bool& operator=(bool boolean) { return (tag = boolean_tag, this->boolean = boolean); }
|
||||
JSType*& operator=(JSType* type) { return (tag = type_tag, this->type = type); }
|
||||
|
||||
bool isPrimitive() const { return (tag == i32_tag) || (tag == u32_tag) || (tag == f64_tag) || (tag == boolean_tag) || (tag == string_tag); }
|
||||
bool isFunction() const { return (tag == function_tag); }
|
||||
bool isArray() const { return (tag == array_tag); }
|
||||
bool isObject() const { return ((tag == object_tag) || (tag == function_tag) || (tag == array_tag) || (tag == type_tag)); }
|
||||
bool isString() const { return (tag == string_tag); }
|
||||
bool isBoolean() const { return (tag == boolean_tag); }
|
||||
bool isNumber() const { return (tag == f64_tag) || (tag == integer_tag); }
|
||||
|
||||
/* this is correct wrt ECMA, The i32 & u32 kinds
|
||||
will have to be converted (to doubles?) anyway because
|
||||
we can't have overflow happening in generic arithmetic */
|
||||
|
||||
bool isInitialized() const { return (tag != uninitialized_tag); }
|
||||
bool isUndefined() const { return (tag == undefined_tag); }
|
||||
bool isNull() const { return (tag == null_tag); }
|
||||
bool isNaN() const;
|
||||
bool isNegativeInfinity() const;
|
||||
bool isPositiveInfinity() const;
|
||||
bool isNegativeZero() const;
|
||||
bool isPositiveZero() const;
|
||||
bool isType() const { return (tag == type_tag); }
|
||||
|
||||
JSValue toString(Context *cx) const { return (isString() ? *this : valueToString(cx, *this)); }
|
||||
JSValue toNumber() const { return (isNumber() ? *this : valueToNumber(*this)); }
|
||||
JSValue toInt32() const { return ((tag == i32_tag) ? *this : valueToInt32(*this)); }
|
||||
JSValue toUInt32() const { return ((tag == u32_tag) ? *this : valueToUInt32(*this)); }
|
||||
JSValue toBoolean(Context *cx) const { return ((tag == boolean_tag) ? *this : valueToBoolean(cx, *this)); }
|
||||
|
||||
JSValue toPrimitive(Context *cx, ECMA_type hint = NoHint) const;
|
||||
|
||||
JSValue convert(Context *cx, JSType *toType);
|
||||
|
||||
|
||||
static JSValue valueToString(Context *cx, const JSValue& value);
|
||||
static JSValue valueToNumber(const JSValue& value);
|
||||
static JSValue valueToInteger(const JSValue& value);
|
||||
static JSValue valueToInt32(const JSValue& value);
|
||||
static JSValue valueToUInt32(const JSValue& value);
|
||||
static JSValue valueToBoolean(Context *cx, const JSValue& value);
|
||||
|
||||
|
||||
const JSType *getType() const; // map from tag type to JS2 type
|
||||
bool isSameType(const JSValue &other) const
|
||||
{
|
||||
const JSType *thisType = getType();
|
||||
const JSType *otherType = other.getType();
|
||||
if (thisType == otherType)
|
||||
return true;
|
||||
if (isNumber() && other.isNumber())
|
||||
return true;
|
||||
return false;
|
||||
}
|
||||
|
||||
int operator==(const JSValue& value) const;
|
||||
};
|
||||
|
||||
Formatter& operator<<(Formatter& f, const JSValue& value);
|
||||
|
||||
typedef enum {
|
||||
None,
|
||||
Posate,
|
||||
Negate,
|
||||
Complement,
|
||||
Increment,
|
||||
Decrement,
|
||||
Const,
|
||||
Call,
|
||||
New,
|
||||
NewArgs,
|
||||
Index,
|
||||
IndexEqual,
|
||||
DeleteIndex,
|
||||
Plus,
|
||||
Minus,
|
||||
Multiply,
|
||||
Divide,
|
||||
Remainder,
|
||||
ShiftLeft,
|
||||
ShiftRight,
|
||||
UShiftRight,
|
||||
Less,
|
||||
LessEqual,
|
||||
In,
|
||||
Equal,
|
||||
SpittingImage,
|
||||
BitAnd,
|
||||
BitXor,
|
||||
BitOr,
|
||||
OperatorCount
|
||||
} Operator;
|
||||
|
||||
|
||||
#if defined(XP_MAC)
|
||||
// copied from default template parameters in map.
|
||||
//typedef gc_allocator<std::pair<const String, JSValue> > gc_map_allocator;
|
||||
//typedef gc_allocator<std::pair<const String, JSValue> > gc_map_allocator;
|
||||
#define gc_map_allocator(T) gc_allocator<std::pair<const String, T> >
|
||||
#elif defined(XP_UNIX)
|
||||
// FIXME: in libg++, they assume the map's allocator is a byte allocator,
|
||||
// which is wrapped in a simple_allocator. this is crap.
|
||||
typedef char _Char[1];
|
||||
//typedef gc_allocator<_Char> gc_map_allocator;
|
||||
#define gc_map_allocator(T) gc_allocator<JSTypes::_Char>
|
||||
#elif defined(_WIN32)
|
||||
// FIXME: MSVC++'s notion. this is why we had to add _Charalloc().
|
||||
//typedef gc_allocator<JSValue> gc_map_allocator;
|
||||
//typedef gc_allocator<JSContainer> gc_container_allocator;
|
||||
#define gc_map_allocator(T) gc_allocator<T>
|
||||
#endif
|
||||
|
||||
/**
|
||||
* GC-scannable array of values.
|
||||
*/
|
||||
typedef std::vector<JSValue, gc_allocator<JSValue> > JSValues;
|
||||
|
||||
|
||||
String getRegisterValue(const JSValues& registerList, Register reg);
|
||||
|
||||
extern const JSValue kUndefinedValue;
|
||||
extern const JSValue kNaNValue;
|
||||
extern const JSValue kTrueValue;
|
||||
extern const JSValue kFalseValue;
|
||||
extern const JSValue kNullValue;
|
||||
extern const JSValue kNegativeZero;
|
||||
extern const JSValue kPositiveZero;
|
||||
extern const JSValue kNegativeInfinity;
|
||||
extern const JSValue kPositiveInfinity;
|
||||
|
||||
// JS2 predefined types:
|
||||
extern JSType Object_Type;
|
||||
extern JSType Integer_Type;
|
||||
extern JSType Number_Type;
|
||||
extern JSType Character_Type;
|
||||
extern JSType String_Type;
|
||||
extern JSType Function_Type;
|
||||
extern JSType Array_Type;
|
||||
extern JSType Type_Type;
|
||||
extern JSType Boolean_Type;
|
||||
extern JSType Null_Type;
|
||||
extern JSType Void_Type;
|
||||
extern JSType None_Type;
|
||||
|
||||
// JS1X heritage classes as types:
|
||||
extern JSType Date_Type;
|
||||
|
||||
typedef std::map<String, JSValue, std::less<String>, gc_map_allocator(JSValue) > JSProperties;
|
||||
typedef std::map<String, JSFunction *, std::less<String> > FunctionMap;
|
||||
|
||||
/**
|
||||
* Basic behavior of all JS objects, mapping a name to a value,
|
||||
* with prototype-based inheritance.
|
||||
*/
|
||||
class JSObject : public gc_base {
|
||||
protected:
|
||||
JSProperties mProperties;
|
||||
FunctionMap *mGetter; // only allocated if the object has properties with getters or setters
|
||||
FunctionMap *mSetter;
|
||||
JSObject* mPrototype;
|
||||
JSType* mType;
|
||||
JSString* mClass; // this is the internal [[Class]] property
|
||||
|
||||
|
||||
void *mPrivate;
|
||||
|
||||
static JSObject *initJSObject();
|
||||
static JSString *ObjectString;
|
||||
static JSObject *ObjectPrototypeObject;
|
||||
|
||||
void init(JSObject* prototype) { mGetter = NULL; mSetter = NULL; mPrototype = prototype; mType = &Object_Type; mClass = ObjectString; }
|
||||
|
||||
public:
|
||||
JSObject() { init(ObjectPrototypeObject); }
|
||||
JSObject(JSValue &constructor) { init(constructor.object->getProperty(widenCString("prototype")).object); }
|
||||
JSObject(JSObject *prototype) { init(prototype); }
|
||||
|
||||
virtual ~JSObject()
|
||||
{
|
||||
if (mGetter) delete mGetter;
|
||||
if (mSetter) delete mSetter;
|
||||
}
|
||||
|
||||
void *getPrivate() { return mPrivate; }
|
||||
void setPrivate(void *underwear) { mPrivate = underwear; }
|
||||
|
||||
static void initObjectObject(JSScope *g);
|
||||
|
||||
bool hasProperty(const String& name)
|
||||
{
|
||||
return (mProperties.count(name) != 0);
|
||||
}
|
||||
|
||||
const JSValue& getProperty(const String& name)
|
||||
{
|
||||
JSProperties::const_iterator i = mProperties.find(name);
|
||||
if (i != mProperties.end())
|
||||
return i->second;
|
||||
if (mPrototype)
|
||||
return mPrototype->getProperty(name);
|
||||
return kUndefinedValue;
|
||||
}
|
||||
|
||||
JSValue& setProperty(const String& name, const JSValue& value)
|
||||
{
|
||||
return (mProperties[name] = value);
|
||||
}
|
||||
|
||||
void setGetter(const String& name, JSFunction *getter)
|
||||
{
|
||||
if (mGetter == NULL)
|
||||
mGetter = new FunctionMap();
|
||||
mProperties[name] = kUndefinedValue;
|
||||
(*mGetter)[name] = getter;
|
||||
}
|
||||
|
||||
void setSetter(const String& name, JSFunction *setter)
|
||||
{
|
||||
if (mSetter == NULL)
|
||||
mSetter = new FunctionMap();
|
||||
mProperties[name] = kUndefinedValue;
|
||||
(*mSetter)[name] = setter;
|
||||
}
|
||||
|
||||
JSFunction *getter(const String& name)
|
||||
{
|
||||
if (hasProperty(name)) {
|
||||
if (mGetter) {
|
||||
FunctionMap::iterator g = mGetter->find(name);
|
||||
if (g != mGetter->end())
|
||||
return g->second;
|
||||
}
|
||||
}
|
||||
else
|
||||
if (mPrototype)
|
||||
return mPrototype->getter(name);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
JSFunction *setter(const String& name)
|
||||
{
|
||||
if (hasProperty(name)) {
|
||||
if (mSetter) {
|
||||
FunctionMap::iterator s = mSetter->find(name);
|
||||
if (s != mSetter->end())
|
||||
return s->second;
|
||||
}
|
||||
}
|
||||
else
|
||||
if (mPrototype)
|
||||
return mPrototype->setter(name);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
const JSValue& deleteProperty(const String& name)
|
||||
{
|
||||
JSProperties::iterator i = mProperties.find(name);
|
||||
if (i != mProperties.end()) {
|
||||
mProperties.erase(i);
|
||||
return kTrueValue;
|
||||
}
|
||||
if (mPrototype)
|
||||
return mPrototype->deleteProperty(name);
|
||||
return kFalseValue;
|
||||
}
|
||||
|
||||
void setPrototype(JSObject* prototype)
|
||||
{
|
||||
mPrototype = prototype;
|
||||
}
|
||||
|
||||
JSObject* getPrototype()
|
||||
{
|
||||
return mPrototype;
|
||||
}
|
||||
|
||||
JSType* getType()
|
||||
{
|
||||
return mType;
|
||||
}
|
||||
|
||||
JSString* getClass()
|
||||
{
|
||||
return mClass;
|
||||
}
|
||||
|
||||
void setClass(JSString* s)
|
||||
{
|
||||
mClass = s;
|
||||
}
|
||||
|
||||
virtual void printProperties(Formatter& f);
|
||||
};
|
||||
|
||||
Formatter& operator<<(Formatter& f, JSObject& obj);
|
||||
|
||||
/**
|
||||
* Private representation of a JavaScript array.
|
||||
*/
|
||||
class JSArray : public JSObject {
|
||||
static JSObject* ArrayPrototypeObject;
|
||||
static JSString* ArrayString;
|
||||
|
||||
JSValues elements;
|
||||
uint32 top;
|
||||
public:
|
||||
|
||||
static JSFunction *Array_length_getter;
|
||||
static void initArrayObject(JSScope *g);
|
||||
|
||||
JSArray() : JSObject(ArrayPrototypeObject), elements(1) { setClass(ArrayString); top = 0; }
|
||||
JSArray(uint32 size) : JSObject(ArrayPrototypeObject), elements(size) { setClass(ArrayString); top = size; }
|
||||
JSArray(const JSValues &v) : JSObject(ArrayPrototypeObject), elements(v) { setClass(ArrayString); }
|
||||
|
||||
uint32 length()
|
||||
{
|
||||
return top;
|
||||
}
|
||||
|
||||
JSValue& operator[](const JSValue& index)
|
||||
{
|
||||
// for now, we can only handle f64 index values.
|
||||
uint32 n = (uint32)index.f64;
|
||||
// obviously, a sparse representation might be better.
|
||||
uint32 size = elements.size();
|
||||
if (n >= size) expand(n, size);
|
||||
markHiEnd(n);
|
||||
return elements[n];
|
||||
}
|
||||
|
||||
JSValue& operator[](uint32 n)
|
||||
{
|
||||
// obviously, a sparse representation might be better.
|
||||
uint32 size = elements.size();
|
||||
if (n >= size) expand(n, size);
|
||||
markHiEnd(n);
|
||||
return elements[n];
|
||||
}
|
||||
|
||||
void resize(uint32 size)
|
||||
{
|
||||
elements.resize(size);
|
||||
top = size;
|
||||
}
|
||||
|
||||
private:
|
||||
|
||||
void markHiEnd(uint32 index)
|
||||
{
|
||||
if ((index + 1) > top) top = index + 1;
|
||||
}
|
||||
|
||||
void expand(uint32 n, uint32 size)
|
||||
{
|
||||
do {
|
||||
size *= 2;
|
||||
} while (n >= size);
|
||||
elements.resize(size);
|
||||
}
|
||||
};
|
||||
|
||||
#if defined(XP_UNIX)
|
||||
// bastring.cc defines a funky operator new that assumes a byte-allocator.
|
||||
typedef string_char_traits<char16> JSCharTraits;
|
||||
typedef gc_allocator<_Char> JSStringAllocator;
|
||||
#else
|
||||
typedef std::char_traits<char16> JSCharTraits;
|
||||
typedef gc_allocator<char16> JSStringAllocator;
|
||||
#endif
|
||||
|
||||
typedef std::basic_string<char16, JSCharTraits, JSStringAllocator> JSStringBase;
|
||||
|
||||
/**
|
||||
* Garbage collectable UNICODE string.
|
||||
*/
|
||||
class JSString : public JSStringBase, public gc_base {
|
||||
public:
|
||||
JSString() {}
|
||||
explicit JSString(const JSStringBase& str) : JSStringBase(str) {}
|
||||
explicit JSString(const JSStringBase* str) : JSStringBase(*str) {}
|
||||
explicit JSString(const String& str);
|
||||
explicit JSString(const String* str);
|
||||
explicit JSString(const char* str);
|
||||
|
||||
operator String();
|
||||
|
||||
void append(const char* str);
|
||||
void append(const JSStringBase* str);
|
||||
};
|
||||
|
||||
class JSException : public gc_base {
|
||||
public:
|
||||
JSException(String mess) : value(JSValue(new JSString(mess))) { }
|
||||
JSException(char *mess) : value(JSValue(new JSString(mess))) { }
|
||||
JSException(JSValue v) : value(v) { }
|
||||
JSValue value;
|
||||
};
|
||||
|
||||
inline Formatter& operator<<(Formatter& f, const JSString& str)
|
||||
{
|
||||
printString(f, str.begin(), str.end());
|
||||
return f;
|
||||
}
|
||||
|
||||
/**
|
||||
* Private representation of a JS function. This simply
|
||||
* holds a reference to the iCode module that is the
|
||||
* compiled code of the function.
|
||||
*/
|
||||
class JSFunction : public JSObject {
|
||||
protected:
|
||||
static JSString* FunctionString;
|
||||
static JSObject* FunctionPrototypeObject;
|
||||
ICodeModule* mICode;
|
||||
typedef JavaScript::gc_traits_finalizable<JSFunction> traits;
|
||||
typedef gc_allocator<JSFunction, traits> allocator;
|
||||
public:
|
||||
static void initFunctionObject(JSScope *g);
|
||||
|
||||
JSFunction() : mICode(0) {}
|
||||
|
||||
JSFunction(ICodeModule* iCode)
|
||||
: JSObject(FunctionPrototypeObject),
|
||||
mICode(iCode)
|
||||
{
|
||||
setClass(FunctionString);
|
||||
}
|
||||
virtual ~JSFunction();
|
||||
|
||||
virtual JSValue getThis() { return kNullValue; }
|
||||
virtual JSFunction *getFunky() { return this; }
|
||||
|
||||
void* operator new(size_t) { return allocator::allocate(1); }
|
||||
ICodeModule* getICode() { return mICode; }
|
||||
virtual bool isNative() { return false; }
|
||||
};
|
||||
|
||||
class JSBoundThis : public JSFunction {
|
||||
typedef JavaScript::gc_traits_finalizable<JSBoundThis> traits;
|
||||
typedef gc_allocator<JSBoundThis, traits> allocator;
|
||||
public:
|
||||
JSBoundThis(JSValue aThis, JSFunction *aFunc) : mBoundThis(aThis), mFunction(aFunc) { }
|
||||
JSValue mBoundThis;
|
||||
JSFunction *mFunction;
|
||||
|
||||
virtual ~JSBoundThis() { mICode = NULL; }
|
||||
virtual JSValue getThis() { return mBoundThis; }
|
||||
virtual JSFunction *getFunky() { return mFunction; }
|
||||
void* operator new(size_t) { return allocator::allocate(1); }
|
||||
};
|
||||
|
||||
class JSNativeFunction : public JSFunction {
|
||||
typedef JavaScript::gc_traits_finalizable<JSNativeFunction> traits;
|
||||
typedef gc_allocator<JSNativeFunction, traits> allocator;
|
||||
public:
|
||||
typedef JSValue (*JSCode)(Context *cx, const JSValues& argv);
|
||||
JSCode mCode;
|
||||
JSNativeFunction(JSCode code) : mCode(code) {}
|
||||
virtual bool isNative() { return true; }
|
||||
void* operator new(size_t) { return allocator::allocate(1); }
|
||||
};
|
||||
|
||||
class JSUnaryOperator : public JSFunction {
|
||||
typedef JavaScript::gc_traits_finalizable<JSUnaryOperator> traits;
|
||||
typedef gc_allocator<JSUnaryOperator, traits> allocator;
|
||||
public:
|
||||
typedef JSValue (*JSUnaryCode)(Context *cx, const JSValue& arg1);
|
||||
JSUnaryCode mCode;
|
||||
JSUnaryOperator(JSUnaryCode code) : mCode(code) {}
|
||||
virtual bool isNative() { return true; }
|
||||
void* operator new(size_t) { return allocator::allocate(1); }
|
||||
};
|
||||
|
||||
class JSBinaryOperator : public JSFunction {
|
||||
typedef JavaScript::gc_traits_finalizable<JSBinaryOperator> traits;
|
||||
typedef gc_allocator<JSBinaryOperator, traits> allocator;
|
||||
public:
|
||||
typedef JSValue (*JSBinaryCode)(Context *cx, const JSValue& arg1, const JSValue& arg2);
|
||||
JSBinaryCode mCode;
|
||||
JSBinaryOperator(JSBinaryCode code) : mCode(code) {}
|
||||
virtual bool isNative() { return true; }
|
||||
void* operator new(size_t) { return allocator::allocate(1); }
|
||||
};
|
||||
|
||||
class JSClosure : public JSFunction {
|
||||
Interpreter::Activation *mActivation;
|
||||
JSClosure *mPrevious;
|
||||
typedef JavaScript::gc_traits_finalizable<JSClosure> traits;
|
||||
typedef gc_allocator<JSClosure, traits> allocator;
|
||||
public:
|
||||
JSClosure(ICodeModule* iCode, Interpreter::Activation *activation, JSClosure *previous)
|
||||
: JSFunction(iCode), mActivation(activation), mPrevious(previous) {}
|
||||
|
||||
JSClosure* getPrevious() { return mPrevious; }
|
||||
Interpreter::Activation* getActivation() { return mActivation; }
|
||||
void* operator new(size_t) { return allocator::allocate(1); }
|
||||
};
|
||||
|
||||
/**
|
||||
* Provides a set of nested scopes.
|
||||
*/
|
||||
class JSScope : public JSObject {
|
||||
protected:
|
||||
JSScope* mParent;
|
||||
JSProperties mTypes;
|
||||
public:
|
||||
JSScope(JSScope* parent = 0, JSObject* prototype = 0)
|
||||
: mParent(parent)
|
||||
{
|
||||
if (prototype)
|
||||
setPrototype(prototype);
|
||||
}
|
||||
|
||||
JSScope* getParent()
|
||||
{
|
||||
return mParent;
|
||||
}
|
||||
|
||||
bool isDefined(const String& name)
|
||||
{
|
||||
if (hasProperty(name))
|
||||
return true;
|
||||
if (mParent)
|
||||
return mParent->isDefined(name);
|
||||
return false;
|
||||
}
|
||||
|
||||
const JSValue& getVariable(const String& name)
|
||||
{
|
||||
const JSValue& ret = getProperty(name);
|
||||
if (ret.isUndefined() && mParent)
|
||||
return mParent->getVariable(name);
|
||||
return ret;
|
||||
}
|
||||
|
||||
JSValue& setVariable(const String& name, const JSValue& value)
|
||||
{
|
||||
return (mProperties[name] = value);
|
||||
}
|
||||
|
||||
JSValue& defineVariable(const String& name, JSType* type, const JSValue& value)
|
||||
{
|
||||
if (type != &Object_Type)
|
||||
mTypes[name] = type;
|
||||
return (mProperties[name] = value);
|
||||
}
|
||||
|
||||
JSValue& defineVariable(const String& name, JSType* type)
|
||||
{
|
||||
if (type != &Object_Type)
|
||||
mTypes[name] = type;
|
||||
return (mProperties[name] = kUndefinedValue);
|
||||
}
|
||||
|
||||
void setType(const String& name, JSType* type)
|
||||
{
|
||||
// only type variables that are defined in this scope.
|
||||
JSProperties::iterator i = mProperties.find(name);
|
||||
if (i != mProperties.end())
|
||||
mTypes[name] = type;
|
||||
else
|
||||
if (mParent)
|
||||
mParent->setType(name, type);
|
||||
}
|
||||
|
||||
JSType* getType(const String& name)
|
||||
{
|
||||
JSType* result = &Object_Type;
|
||||
// only consider types for variables defined in this scope.
|
||||
JSProperties::const_iterator i = mProperties.find(name);
|
||||
if (i != mProperties.end()) {
|
||||
i = mTypes.find(name);
|
||||
if (i != mTypes.end())
|
||||
result = i->second.type;
|
||||
} else {
|
||||
// see if variable is defined in parent scope.
|
||||
if (mParent)
|
||||
result = mParent->getType(name);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
JSValue& defineFunction(const String& name, ICodeModule* iCode)
|
||||
{
|
||||
JSValue value(new JSFunction(iCode));
|
||||
return defineVariable(name, &Function_Type, value);
|
||||
}
|
||||
|
||||
JSValue& defineNativeFunction(const String& name, JSNativeFunction::JSCode code)
|
||||
{
|
||||
JSValue value(new JSNativeFunction(code));
|
||||
return defineVariable(name, &Function_Type, value);
|
||||
}
|
||||
};
|
||||
|
||||
class JSType : public JSObject {
|
||||
protected:
|
||||
String mName;
|
||||
JSType *mBaseType;
|
||||
|
||||
// The constructor is an implementation of the [[Construct]] mechanism
|
||||
JSFunction *mConstructor;
|
||||
// The invokor is an implementation of the [[Call]] mechanism
|
||||
JSFunction *mInvokor;
|
||||
public:
|
||||
JSType() { }
|
||||
JSType(const String &name, JSType *baseType) : mName(name), mBaseType(baseType), mConstructor(NULL), mInvokor(NULL)
|
||||
{
|
||||
mType = &Type_Type;
|
||||
}
|
||||
|
||||
JSType(const String &name, JSType *baseType, JSFunction *constructor, JSFunction *invokor = NULL)
|
||||
: mName(name), mBaseType(baseType), mConstructor(constructor), mInvokor(invokor)
|
||||
{
|
||||
mType = &Type_Type;
|
||||
}
|
||||
|
||||
enum { NoRelation = 0x7FFFFFFF };
|
||||
|
||||
const String& getName() const { return mName; }
|
||||
|
||||
bool isSubTypeOf(const JSType *other) const;
|
||||
|
||||
int32 distance(const JSType *other) const;
|
||||
|
||||
JSFunction *getConstructor() const { return mConstructor; }
|
||||
JSFunction *getInvokor() const { return mInvokor; }
|
||||
};
|
||||
|
||||
class JSBoolean : public JSObject {
|
||||
protected:
|
||||
bool mValue;
|
||||
static JSObject* BooleanPrototypeObject;
|
||||
static JSString* BooleanString;
|
||||
public:
|
||||
JSBoolean(bool value) : JSObject(BooleanPrototypeObject), mValue(value) { setClass(BooleanString); }
|
||||
|
||||
static void initBooleanObject(JSScope *g);
|
||||
|
||||
bool getValue() { return mValue; }
|
||||
};
|
||||
|
||||
|
||||
} /* namespace JSTypes */
|
||||
} /* namespace JavaScript */
|
||||
|
||||
|
||||
#endif /* jstypes_h */
|
||||
@@ -1,95 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#include <cstdlib>
|
||||
#include <cstring>
|
||||
#include "utilities.h"
|
||||
|
||||
#ifdef WIN32
|
||||
#include <windows.h>
|
||||
#endif
|
||||
|
||||
#ifdef XP_MAC
|
||||
#include <cstdarg>
|
||||
#include <Types.h>
|
||||
#endif
|
||||
|
||||
namespace JS = JavaScript;
|
||||
|
||||
|
||||
|
||||
|
||||
//
|
||||
// Input
|
||||
//
|
||||
|
||||
|
||||
|
||||
//
|
||||
// Output
|
||||
//
|
||||
|
||||
|
||||
|
||||
//
|
||||
// Static Initializers
|
||||
//
|
||||
|
||||
|
||||
#ifndef _WIN32
|
||||
static void jsNewHandler()
|
||||
{
|
||||
std::bad_alloc outOfMemory;
|
||||
throw outOfMemory;
|
||||
}
|
||||
|
||||
|
||||
struct InitUtilities
|
||||
{
|
||||
InitUtilities() {std::set_new_handler(&jsNewHandler);}
|
||||
};
|
||||
#else
|
||||
#include <new.h>
|
||||
static int jsNewHandler(size_t)
|
||||
{
|
||||
std::bad_alloc outOfMemory;
|
||||
throw outOfMemory;
|
||||
}
|
||||
|
||||
|
||||
struct InitUtilities
|
||||
{
|
||||
InitUtilities() {_set_new_handler(&jsNewHandler);}
|
||||
};
|
||||
#endif
|
||||
InitUtilities initUtilities;
|
||||
@@ -1,133 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express oqr
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifndef kitchensink_h___
|
||||
#define kitchensink_h___
|
||||
|
||||
#include <memory>
|
||||
#include <new>
|
||||
#include <string>
|
||||
#include <iterator>
|
||||
#include <algorithm>
|
||||
#include <cstdio>
|
||||
#include <cstdarg>
|
||||
|
||||
#include "stlcfg.h"
|
||||
#include "systemtypes.h"
|
||||
#include "strings.h"
|
||||
#include "mem.h"
|
||||
|
||||
|
||||
namespace JavaScript {
|
||||
|
||||
//
|
||||
// Alignment
|
||||
//
|
||||
|
||||
template<typename T>
|
||||
struct AlignmentHelper {
|
||||
char ch;
|
||||
T t;
|
||||
};
|
||||
#define ALIGNMENT_OF(T) offsetof(JavaScript::AlignmentHelper<T>, t)
|
||||
|
||||
|
||||
|
||||
// Assign zero to n elements starting at first.
|
||||
// This is equivalent ot fill_n(first, n, 0) but may be more efficient.
|
||||
template<class ForwardIterator, class Size>
|
||||
inline void zero_n(ForwardIterator first, Size n)
|
||||
{
|
||||
while (n) {
|
||||
*first = 0;
|
||||
++first;
|
||||
--n;
|
||||
}
|
||||
}
|
||||
|
||||
//
|
||||
// Linked Lists
|
||||
//
|
||||
|
||||
// In some cases it is desirable to manipulate ordinary C-style linked lists as though
|
||||
// they were STL-like sequences. These classes define STL forward iterators that walk
|
||||
// through singly-linked lists of objects threaded through fields named 'next'. The type
|
||||
// parameter E must be a class that has a member named 'next' whose type is E* or const E*.
|
||||
|
||||
template <class E>
|
||||
class ListIterator: public std::iterator<std::forward_iterator_tag, E> {
|
||||
E *element;
|
||||
|
||||
public:
|
||||
ListIterator() {}
|
||||
explicit ListIterator(E *e): element(e) {}
|
||||
|
||||
E &operator*() const {return *element;}
|
||||
E *operator->() const {return element;}
|
||||
ListIterator &operator++() {element = element->next; return *this;}
|
||||
ListIterator operator++(int) {ListIterator i(*this); element = element->next; return i;}
|
||||
friend bool operator==(const ListIterator &i, const ListIterator &j) {return i.element == j.element;}
|
||||
friend bool operator!=(const ListIterator &i, const ListIterator &j) {return i.element != j.element;}
|
||||
};
|
||||
|
||||
|
||||
template <class E>
|
||||
#ifndef _WIN32 // Microsoft VC6 bug: std::iterator should support five template arguments
|
||||
class ConstListIterator: public std::iterator<std::forward_iterator_tag, E, ptrdiff_t, const E*, const E&> {
|
||||
#else
|
||||
class ConstListIterator: public std::iterator<std::forward_iterator_tag, E, ptrdiff_t> {
|
||||
#endif
|
||||
const E *element;
|
||||
|
||||
public:
|
||||
ConstListIterator() {}
|
||||
ConstListIterator(const ListIterator<E> &i): element(&*i) {}
|
||||
explicit ConstListIterator(const E *e): element(e) {}
|
||||
|
||||
const E &operator*() const {return *element;}
|
||||
const E *operator->() const {return element;}
|
||||
ConstListIterator &operator++() {element = element->next; return *this;}
|
||||
ConstListIterator operator++(int) {ConstListIterator i(*this); element = element->next; return i;}
|
||||
friend bool operator==(const ConstListIterator &i, const ConstListIterator &j) {return i.element == j.element;}
|
||||
friend bool operator!=(const ConstListIterator &i, const ConstListIterator &j) {return i.element != j.element;}
|
||||
};
|
||||
|
||||
|
||||
//
|
||||
// Input
|
||||
//
|
||||
|
||||
|
||||
}
|
||||
|
||||
#endif /* kitchensink_h___ */
|
||||
@@ -1,717 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#include "numerics.h"
|
||||
#include "lexer.h"
|
||||
|
||||
namespace JS = JavaScript;
|
||||
|
||||
|
||||
// Create a new Lexer for lexing the provided source code. The Lexer will
|
||||
// intern identifiers, keywords, and regular expressions in the designated
|
||||
// world.
|
||||
JS::Lexer::Lexer(World &world, const String &source, const String &sourceLocation, uint32 initialLineNum):
|
||||
world(world), reader(source, sourceLocation, initialLineNum)
|
||||
{
|
||||
nextToken = tokens;
|
||||
nTokensFwd = 0;
|
||||
#ifdef DEBUG
|
||||
nTokensBack = 0;
|
||||
#endif
|
||||
lexingUnit = false;
|
||||
}
|
||||
|
||||
|
||||
// Skip past the next token, which must have been either peeked or read and then unread.
|
||||
// skip is faster than get but must not be called if the next token has not been seen yet.
|
||||
void JS::Lexer::skip()
|
||||
{
|
||||
ASSERT(nTokensFwd);
|
||||
if (++nextToken == tokens + tokenBufferSize)
|
||||
nextToken = tokens;
|
||||
--nTokensFwd;
|
||||
DEBUG_ONLY(++nTokensBack);
|
||||
}
|
||||
|
||||
|
||||
// Get and return the next token. The token remains valid until the next
|
||||
// call to this Lexer. If the Reader reached the end of file, return a
|
||||
// Token whose Kind is end. The caller may alter the value of this Token
|
||||
// (in particular, take control over the auto_ptr's data), but if it does so,
|
||||
// the caller is not allowed to unget this Token.
|
||||
//
|
||||
// If preferRegExp is true, a / will be preferentially interpreted as
|
||||
// starting a regular expression; otherwise, a / will be preferentially
|
||||
// interpreted as division or /=.
|
||||
const JS::Token &JS::Lexer::get(bool preferRegExp)
|
||||
{
|
||||
const Token &t = peek(preferRegExp);
|
||||
if (++nextToken == tokens + tokenBufferSize)
|
||||
nextToken = tokens;
|
||||
--nTokensFwd;
|
||||
DEBUG_ONLY(++nTokensBack);
|
||||
return t;
|
||||
}
|
||||
|
||||
|
||||
// Peek at the next token using the given preferRegExp setting. If that
|
||||
// token's kind matches the given kind, consume that token and return it.
|
||||
// Otherwise, do not consume that token and return nil.
|
||||
const JS::Token *JS::Lexer::eat(bool preferRegExp, Token::Kind kind)
|
||||
{
|
||||
const Token &t = peek(preferRegExp);
|
||||
if (t.kind != kind)
|
||||
return 0;
|
||||
if (++nextToken == tokens + tokenBufferSize)
|
||||
nextToken = tokens;
|
||||
--nTokensFwd;
|
||||
DEBUG_ONLY(++nTokensBack);
|
||||
return &t;
|
||||
}
|
||||
|
||||
|
||||
// Return the next token without consuming it.
|
||||
//
|
||||
// If preferRegExp is true, a / will be preferentially interpreted as
|
||||
// starting a regular expression; otherwise, a / will be preferentially
|
||||
// interpreted as division or /=. A subsequent call to peek or get will
|
||||
// return the same token; that call must be presented with the same value
|
||||
// for preferRegExp.
|
||||
const JS::Token &JS::Lexer::peek(bool preferRegExp)
|
||||
{
|
||||
// Use an already looked-up token if there is one.
|
||||
if (nTokensFwd) {
|
||||
ASSERT(savedPreferRegExp[nextToken - tokens] == preferRegExp);
|
||||
} else {
|
||||
lexToken(preferRegExp);
|
||||
nTokensFwd = 1;
|
||||
#ifdef DEBUG
|
||||
savedPreferRegExp[nextToken - tokens] = preferRegExp;
|
||||
if (nTokensBack == tokenLookahead) {
|
||||
nTokensBack = tokenLookahead-1;
|
||||
if (tokenGuard)
|
||||
(nextToken >= tokens+tokenLookahead ?
|
||||
nextToken-tokenLookahead :
|
||||
nextToken+tokenBufferSize-tokenLookahead)->valid = false;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
return *nextToken;
|
||||
}
|
||||
|
||||
|
||||
#ifdef DEBUG
|
||||
// Change the setting of preferRegExp for an already peeked token.
|
||||
// The token must not be one for which that setting mattered.
|
||||
//
|
||||
// THIS IS A DANGEROUS FUNCTION!
|
||||
// Use it only if you can be prove that the already peeked token does not
|
||||
// start with a slash.
|
||||
void JS::Lexer::redesignate(bool preferRegExp)
|
||||
{
|
||||
if (nTokensFwd) {
|
||||
ASSERT(savedPreferRegExp[nextToken - tokens] != preferRegExp);
|
||||
ASSERT(!(nextToken->hasKind(Token::regExp) ||
|
||||
nextToken->hasKind(Token::divide) ||
|
||||
nextToken->hasKind(Token::divideEquals)));
|
||||
savedPreferRegExp[nextToken - tokens] = preferRegExp;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
// Unread the last token. This call may be called to unread at most
|
||||
// tokenBufferSize tokens at a time (where a peek also counts as temporarily
|
||||
// reading and unreading one token). When a token that has been unread is
|
||||
// peeked or read again, the same value must be passed in preferRegExp as for
|
||||
// the first time that token was read or peeked.
|
||||
void JS::Lexer::unget()
|
||||
{
|
||||
ASSERT(nTokensBack--);
|
||||
nTokensFwd++;
|
||||
if (nextToken == tokens)
|
||||
nextToken = tokens + tokenBufferSize;
|
||||
--nextToken;
|
||||
}
|
||||
|
||||
|
||||
// Report a syntax error at the backUp-th last character read by the Reader.
|
||||
// In other words, if backUp is 0, the error is at the next character to be
|
||||
// read by the Reader; if backUp is 1, the error is at the last character
|
||||
// read by the Reader, and so forth.
|
||||
void JS::Lexer::syntaxError(const char *message, uint backUp)
|
||||
{
|
||||
reader.unget(backUp);
|
||||
reader.error(Exception::syntaxError, widenCString(message), reader.getPos());
|
||||
}
|
||||
|
||||
|
||||
// Get the next character from the reader, skipping any Unicode format-control
|
||||
// (Cf) characters.
|
||||
inline char16 JS::Lexer::getChar()
|
||||
{
|
||||
char16 ch = reader.get();
|
||||
if (char16Value(ch) >= firstFormatChar)
|
||||
ch = internalGetChar(ch);
|
||||
return ch;
|
||||
}
|
||||
|
||||
|
||||
// Helper for getChar()
|
||||
char16 JS::Lexer::internalGetChar(char16 ch)
|
||||
{
|
||||
while (isFormat(ch))
|
||||
ch = reader.get();
|
||||
return ch;
|
||||
}
|
||||
|
||||
|
||||
// Peek the next character from the reader, skipping any Unicode
|
||||
// format-control (Cf) characters, which are read and discarded.
|
||||
inline char16 JS::Lexer::peekChar()
|
||||
{
|
||||
char16 ch = reader.peek();
|
||||
if (char16Value(ch) >= firstFormatChar)
|
||||
ch = internalPeekChar(ch);
|
||||
return ch;
|
||||
}
|
||||
|
||||
|
||||
// Helper for peekChar()
|
||||
char16 JS::Lexer::internalPeekChar(char16 ch)
|
||||
{
|
||||
while (isFormat(ch)) {
|
||||
reader.get();
|
||||
ch = reader.peek();
|
||||
}
|
||||
return ch;
|
||||
}
|
||||
|
||||
|
||||
// Peek the next character from the reader, skipping any Unicode
|
||||
// format-control (Cf) characters, which are read and discarded. If the
|
||||
// peeked character matches ch, read that character and return true;
|
||||
// otherwise return false. ch must not be null.
|
||||
bool JS::Lexer::testChar(char16 ch)
|
||||
{
|
||||
ASSERT(ch); // If ch were null, it could match the eof null.
|
||||
char16 ch2 = peekChar();
|
||||
if (ch == ch2) {
|
||||
reader.get();
|
||||
return true;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
// A backslash has been read. Read the rest of the escape code.
|
||||
// Return the interpreted escaped character. Throw an exception if the
|
||||
// escape is not valid. If unicodeOnly is true, allow only \uxxxx escapes.
|
||||
char16 JS::Lexer::lexEscape(bool unicodeOnly)
|
||||
{
|
||||
char16 ch = getChar();
|
||||
int nDigits;
|
||||
|
||||
if (!unicodeOnly || ch == 'u')
|
||||
switch (ch) {
|
||||
case '0':
|
||||
// Make sure that the next character isn't a digit.
|
||||
ch = peekChar();
|
||||
if (!isASCIIDecimalDigit(ch))
|
||||
return 0x00;
|
||||
// Point to the next character in the error message
|
||||
getChar();
|
||||
break;
|
||||
|
||||
case 'b':
|
||||
return 0x08;
|
||||
case 'f':
|
||||
return 0x0C;
|
||||
case 'n':
|
||||
return 0x0A;
|
||||
case 'r':
|
||||
return 0x0D;
|
||||
case 't':
|
||||
return 0x09;
|
||||
case 'v':
|
||||
return 0x0B;
|
||||
|
||||
case 'x':
|
||||
nDigits = 2;
|
||||
goto lexHex;
|
||||
case 'u':
|
||||
nDigits = 4;
|
||||
lexHex:
|
||||
{
|
||||
uint32 n = 0;
|
||||
while (nDigits--) {
|
||||
ch = getChar();
|
||||
uint digit;
|
||||
if (!isASCIIHexDigit(ch, digit))
|
||||
goto error;
|
||||
n = (n << 4) | digit;
|
||||
}
|
||||
return static_cast<char16>(n);
|
||||
}
|
||||
default:
|
||||
if (!reader.getEof(ch)) {
|
||||
CharInfo chi(ch);
|
||||
if (!isAlphanumeric(chi) && !isLineBreak(chi))
|
||||
return ch;
|
||||
}
|
||||
}
|
||||
error:
|
||||
syntaxError("Bad escape code");
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
// Read an identifier into s. The initial value of s is ignored and cleared.
|
||||
// Return true if an escape code has been encountered.
|
||||
// If allowLeadingDigit is true, allow the first character of s to be a digit,
|
||||
// just like any continuing identifier character.
|
||||
bool JS::Lexer::lexIdentifier(String &s, bool allowLeadingDigit)
|
||||
{
|
||||
reader.beginRecording(s);
|
||||
bool hasEscape = false;
|
||||
|
||||
while (true) {
|
||||
char16 ch = getChar();
|
||||
char16 ch2 = ch;
|
||||
if (ch == '\\') {
|
||||
ch2 = lexEscape(true);
|
||||
hasEscape = true;
|
||||
}
|
||||
CharInfo chi2(ch2);
|
||||
|
||||
if (!(allowLeadingDigit ? isIdContinuing(chi2) :
|
||||
isIdLeading(chi2))) {
|
||||
if (ch == '\\')
|
||||
syntaxError("Identifier escape expands into non-identifier character");
|
||||
else
|
||||
reader.unget();
|
||||
break;
|
||||
}
|
||||
reader.recordChar(ch2);
|
||||
allowLeadingDigit = true;
|
||||
}
|
||||
reader.endRecording();
|
||||
return hasEscape;
|
||||
}
|
||||
|
||||
|
||||
// Read a numeric literal into nextToken->chars and nextToken->value.
|
||||
// Return true if the numeric literal is followed by a unit, but don't read
|
||||
// the unit yet.
|
||||
bool JS::Lexer::lexNumeral()
|
||||
{
|
||||
int hasDecimalPoint = 0;
|
||||
String &s = nextToken->chars;
|
||||
uint digit;
|
||||
|
||||
reader.beginRecording(s);
|
||||
char16 ch = getChar();
|
||||
if (ch == '0') {
|
||||
reader.recordChar('0');
|
||||
ch = getChar();
|
||||
if ((ch&~0x20) == 'X') {
|
||||
size_t pos = reader.getPos();
|
||||
char16 ch2 = getChar();
|
||||
if (isASCIIHexDigit(ch2, digit)) {
|
||||
reader.recordChar(ch);
|
||||
do {
|
||||
reader.recordChar(ch2);
|
||||
ch2 = getChar();
|
||||
} while (isASCIIHexDigit(ch2, digit));
|
||||
ch = ch2;
|
||||
} else
|
||||
reader.setPos(pos);
|
||||
goto done;
|
||||
} else if (isASCIIDecimalDigit(ch)) {
|
||||
syntaxError("Numeric constant syntax error");
|
||||
}
|
||||
}
|
||||
while (isASCIIDecimalDigit(ch) || ch == '.' && !hasDecimalPoint++) {
|
||||
reader.recordChar(ch);
|
||||
ch = getChar();
|
||||
}
|
||||
if ((ch&~0x20) == 'E') {
|
||||
size_t pos = reader.getPos();
|
||||
char16 ch2 = getChar();
|
||||
char16 sign = 0;
|
||||
if (ch2 == '+' || ch2 == '-') {
|
||||
sign = ch2;
|
||||
ch2 = getChar();
|
||||
}
|
||||
if (isASCIIDecimalDigit(ch2)) {
|
||||
reader.recordChar(ch);
|
||||
if (sign)
|
||||
reader.recordChar(sign);
|
||||
do {
|
||||
reader.recordChar(ch2);
|
||||
ch2 = getChar();
|
||||
} while (isASCIIDecimalDigit(ch2));
|
||||
ch = ch2;
|
||||
} else
|
||||
reader.setPos(pos);
|
||||
}
|
||||
|
||||
done:
|
||||
// At this point the reader is just past the character ch, which
|
||||
// is the first non-formatting character that is not part of the
|
||||
// number.
|
||||
reader.endRecording();
|
||||
const char16 *sBegin = s.data();
|
||||
const char16 *sEnd = sBegin + s.size();
|
||||
const char16 *numEnd;
|
||||
nextToken->value = stringToDouble(sBegin, sEnd, numEnd);
|
||||
ASSERT(numEnd == sEnd);
|
||||
reader.unget();
|
||||
ASSERT(ch == reader.peek());
|
||||
return isIdContinuing(ch) || ch == '\\';
|
||||
}
|
||||
|
||||
|
||||
// Read a string literal into s. The initial value of s is ignored and
|
||||
// cleared. The opening quote has already been read into separator.
|
||||
void JS::Lexer::lexString(String &s, char16 separator)
|
||||
{
|
||||
char16 ch;
|
||||
|
||||
reader.beginRecording(s);
|
||||
while ((ch = reader.get()) != separator) {
|
||||
CharInfo chi(ch);
|
||||
if (!isFormat(chi)) {
|
||||
if (ch == '\\')
|
||||
ch = lexEscape(false);
|
||||
else if (reader.getEof(ch) || isLineBreak(chi))
|
||||
syntaxError("Unterminated string literal");
|
||||
reader.recordChar(ch);
|
||||
}
|
||||
}
|
||||
reader.endRecording();
|
||||
}
|
||||
|
||||
|
||||
// Read a regular expression literal. Store the regular expression in
|
||||
// nextToken->id and the flags in nextToken->chars.
|
||||
// The opening slash has already been read.
|
||||
void JS::Lexer::lexRegExp()
|
||||
{
|
||||
String s;
|
||||
char16 prevCh = 0;
|
||||
|
||||
reader.beginRecording(s);
|
||||
while (true) {
|
||||
char16 ch = getChar();
|
||||
CharInfo chi(ch);
|
||||
if (reader.getEof(ch) || isLineBreak(chi))
|
||||
syntaxError("Unterminated regular expression literal");
|
||||
if (prevCh == '\\') {
|
||||
reader.recordChar(ch);
|
||||
// Ignore slashes and backslashes immediately after a backslash
|
||||
prevCh = 0;
|
||||
} else if (ch != '/') {
|
||||
reader.recordChar(ch);
|
||||
prevCh = ch;
|
||||
} else
|
||||
break;
|
||||
}
|
||||
reader.endRecording();
|
||||
nextToken->id = &world.identifiers[s];
|
||||
|
||||
lexIdentifier(nextToken->chars, true);
|
||||
}
|
||||
|
||||
|
||||
// Read a token from the Reader and store it at *nextToken.
|
||||
// If the Reader reached the end of file, store a Token whose Kind is end.
|
||||
void JS::Lexer::lexToken(bool preferRegExp)
|
||||
{
|
||||
Token &t = *nextToken;
|
||||
t.lineBreak = false;
|
||||
t.id = 0;
|
||||
// Don't really need to waste time clearing this string here
|
||||
//clear(t.chars);
|
||||
Token::Kind kind;
|
||||
|
||||
if (lexingUnit) {
|
||||
lexIdentifier(t.chars, false);
|
||||
ASSERT(t.chars.size());
|
||||
kind = Token::unit; // unit
|
||||
lexingUnit = false;
|
||||
} else {
|
||||
next:
|
||||
char16 ch = reader.get();
|
||||
if (reader.getEof(ch)) {
|
||||
endOfInput:
|
||||
t.pos = reader.getPos() - 1;
|
||||
kind = Token::end;
|
||||
} else {
|
||||
char16 ch2;
|
||||
CharInfo chi(ch);
|
||||
|
||||
switch (cGroup(chi)) {
|
||||
case CharInfo::FormatGroup:
|
||||
case CharInfo::WhiteGroup:
|
||||
goto next;
|
||||
|
||||
case CharInfo::IdGroup:
|
||||
t.pos = reader.getPos() - 1;
|
||||
readIdentifier:
|
||||
{
|
||||
reader.unget();
|
||||
String s;
|
||||
bool hasEscape = lexIdentifier(s, false);
|
||||
t.id = &world.identifiers[s];
|
||||
kind = hasEscape ? Token::identifier : t.id->tokenKind;
|
||||
}
|
||||
break;
|
||||
|
||||
case CharInfo::NonIdGroup:
|
||||
case CharInfo::IdContinueGroup:
|
||||
t.pos = reader.getPos() - 1;
|
||||
switch (ch) {
|
||||
case '(':
|
||||
kind = Token::openParenthesis; // (
|
||||
break;
|
||||
case ')':
|
||||
kind = Token::closeParenthesis; // )
|
||||
break;
|
||||
case '[':
|
||||
kind = Token::openBracket; // [
|
||||
break;
|
||||
case ']':
|
||||
kind = Token::closeBracket; // ]
|
||||
break;
|
||||
case '{':
|
||||
kind = Token::openBrace; // {
|
||||
break;
|
||||
case '}':
|
||||
kind = Token::closeBrace; // }
|
||||
break;
|
||||
case ',':
|
||||
kind = Token::comma; // ,
|
||||
break;
|
||||
case ';':
|
||||
kind = Token::semicolon; // ;
|
||||
break;
|
||||
case '.':
|
||||
kind = Token::dot; // .
|
||||
ch2 = getChar();
|
||||
if (isASCIIDecimalDigit(ch2)) {
|
||||
reader.setPos(t.pos);
|
||||
goto number; // decimal point
|
||||
} else if (ch2 == '.') {
|
||||
kind = Token::doubleDot; // ..
|
||||
if (testChar('.'))
|
||||
kind = Token::tripleDot;// ...
|
||||
} else
|
||||
reader.unget();
|
||||
break;
|
||||
case ':':
|
||||
kind = Token::colon; // :
|
||||
if (testChar(':'))
|
||||
kind = Token::doubleColon; // ::
|
||||
break;
|
||||
case '#':
|
||||
kind = Token::pound; // #
|
||||
break;
|
||||
case '@':
|
||||
kind = Token::at; // @
|
||||
break;
|
||||
case '?':
|
||||
kind = Token::question; // ?
|
||||
break;
|
||||
|
||||
case '~':
|
||||
kind = Token::complement; // ~
|
||||
break;
|
||||
case '!':
|
||||
kind = Token::logicalNot; // !
|
||||
if (testChar('=')) {
|
||||
kind = Token::notEqual; // !=
|
||||
if (testChar('='))
|
||||
kind = Token::notIdentical; // !==
|
||||
}
|
||||
break;
|
||||
|
||||
case '*':
|
||||
kind = Token::times; // * *=
|
||||
tryAssignment:
|
||||
if (testChar('='))
|
||||
kind = Token::Kind(kind + Token::timesEquals - Token::times);
|
||||
break;
|
||||
|
||||
case '/':
|
||||
kind = Token::divide; // /
|
||||
ch = getChar();
|
||||
if (ch == '/') { // // comment
|
||||
do {
|
||||
ch = reader.get();
|
||||
if (reader.getEof(ch))
|
||||
goto endOfInput;
|
||||
} while (!isLineBreak(ch));
|
||||
goto endOfLine;
|
||||
} else if (ch == '*') { // /*comment*/
|
||||
ch = 0;
|
||||
do {
|
||||
ch2 = ch;
|
||||
ch = getChar();
|
||||
if (isLineBreak(ch)) {
|
||||
reader.beginLine();
|
||||
t.lineBreak = true;
|
||||
} else if (reader.getEof(ch))
|
||||
syntaxError("Unterminated /* comment");
|
||||
} while (ch != '/' || ch2 != '*');
|
||||
goto next;
|
||||
} else {
|
||||
reader.unget();
|
||||
if (preferRegExp) { // Regular expression
|
||||
kind = Token::regExp;
|
||||
lexRegExp();
|
||||
} else
|
||||
goto tryAssignment; // /=
|
||||
}
|
||||
break;
|
||||
|
||||
case '%':
|
||||
kind = Token::modulo; // %
|
||||
goto tryAssignment; // %=
|
||||
|
||||
case '+':
|
||||
kind = Token::plus; // +
|
||||
if (testChar('+'))
|
||||
kind = Token::increment; // ++
|
||||
else
|
||||
goto tryAssignment; // +=
|
||||
break;
|
||||
|
||||
case '-':
|
||||
kind = Token::minus; // -
|
||||
ch = getChar();
|
||||
if (ch == '-')
|
||||
kind = Token::decrement; // --
|
||||
else if (ch == '>')
|
||||
kind = Token::arrow; // ->
|
||||
else {
|
||||
reader.unget();
|
||||
goto tryAssignment; // -=
|
||||
}
|
||||
break;
|
||||
|
||||
case '&':
|
||||
kind = Token::bitwiseAnd; // & && &= &&=
|
||||
logical:
|
||||
if (testChar(ch))
|
||||
kind = Token::Kind(kind - Token::bitwiseAnd + Token::logicalAnd);
|
||||
goto tryAssignment;
|
||||
case '^':
|
||||
kind = Token::bitwiseXor; // ^ ^^ ^= ^^=
|
||||
goto logical;
|
||||
case '|':
|
||||
kind = Token::bitwiseOr; // | || |= ||=
|
||||
goto logical;
|
||||
|
||||
case '=':
|
||||
kind = Token::assignment; // =
|
||||
if (testChar('=')) {
|
||||
kind = Token::equal; // ==
|
||||
if (testChar('='))
|
||||
kind = Token::identical; // ===
|
||||
}
|
||||
break;
|
||||
|
||||
case '<':
|
||||
kind = Token::lessThan; // <
|
||||
if (testChar('<')) {
|
||||
kind = Token::leftShift; // <<
|
||||
goto tryAssignment; // <<=
|
||||
}
|
||||
comparison:
|
||||
if (testChar('=')) // <= >=
|
||||
kind = Token::Kind(kind + Token::lessThanOrEqual - Token::lessThan);
|
||||
break;
|
||||
case '>':
|
||||
kind = Token::greaterThan; // >
|
||||
if (testChar('>')) {
|
||||
kind = Token::rightShift; // >>
|
||||
if (testChar('>'))
|
||||
kind = Token::logicalRightShift; // >>>
|
||||
goto tryAssignment; // >>= >>>=
|
||||
}
|
||||
goto comparison;
|
||||
|
||||
case '\\':
|
||||
goto readIdentifier; // An identifier that starts with an escape
|
||||
|
||||
case '\'':
|
||||
case '"':
|
||||
kind = Token::string; // 'string' "string"
|
||||
lexString(t.chars, ch);
|
||||
break;
|
||||
|
||||
case '0':
|
||||
case '1':
|
||||
case '2':
|
||||
case '3':
|
||||
case '4':
|
||||
case '5':
|
||||
case '6':
|
||||
case '7':
|
||||
case '8':
|
||||
case '9':
|
||||
reader.unget(); // Number
|
||||
number:
|
||||
kind = Token::number;
|
||||
lexingUnit = lexNumeral();
|
||||
break;
|
||||
|
||||
default:
|
||||
syntaxError("Bad character");
|
||||
}
|
||||
break;
|
||||
|
||||
case CharInfo::LineBreakGroup:
|
||||
endOfLine:
|
||||
reader.beginLine();
|
||||
t.lineBreak = true;
|
||||
goto next;
|
||||
}
|
||||
}
|
||||
}
|
||||
t.kind = kind;
|
||||
#ifdef DEBUG
|
||||
t.valid = true;
|
||||
#endif
|
||||
}
|
||||
@@ -1,105 +0,0 @@
|
||||
/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*-
|
||||
*
|
||||
* The contents of this file are subject to the Netscape Public
|
||||
* License Version 1.1 (the "License"); you may not use this file
|
||||
* except in compliance with the License. You may obtain a copy of
|
||||
* the License at http://www.mozilla.org/NPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS
|
||||
* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
||||
* implied. See the License for the specific language governing
|
||||
* rights and limitations under the License.
|
||||
*
|
||||
* The Original Code is the JavaScript 2 Prototype.
|
||||
*
|
||||
* The Initial Developer of the Original Code is Netscape
|
||||
* Communications Corporation. Portions created by Netscape are
|
||||
* Copyright (C) 1998 Netscape Communications Corporation. All
|
||||
* Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
*
|
||||
* Alternatively, the contents of this file may be used under the
|
||||
* terms of the GNU Public License (the "GPL"), in which case the
|
||||
* provisions of the GPL are applicable instead of those above.
|
||||
* If you wish to allow use of your version of this file only
|
||||
* under the terms of the GPL and not to allow others to use your
|
||||
* version of this file under the NPL, indicate your decision by
|
||||
* deleting the provisions above and replace them with the notice
|
||||
* and other provisions required by the GPL. If you do not delete
|
||||
* the provisions above, a recipient may use your version of this
|
||||
* file under either the NPL or the GPL.
|
||||
*/
|
||||
|
||||
#ifndef lexer_h___
|
||||
#define lexer_h___
|
||||
|
||||
#include "utilities.h"
|
||||
#include "formatter.h"
|
||||
#include "reader.h"
|
||||
#include "token.h"
|
||||
#include "world.h"
|
||||
|
||||
namespace JavaScript
|
||||
{
|
||||
class Lexer {
|
||||
enum {tokenLookahead = 2}; // Number of tokens that can be simultaneously live
|
||||
#ifdef DEBUG
|
||||
enum {tokenGuard = 10}; // Number of invalid tokens added to circular token buffer to catch references to old tokens
|
||||
#else
|
||||
enum {tokenGuard = 0}; // Number of invalid tokens added to circular token buffer to catch references to old tokens
|
||||
#endif
|
||||
// Token lookahead buffer size
|
||||
enum {tokenBufferSize = tokenLookahead + tokenGuard};
|
||||
|
||||
Token tokens[tokenBufferSize]; // Circular buffer of recently read or lookahead tokens
|
||||
Token *nextToken; // Address of next Token in the circular buffer to be returned by get()
|
||||
int nTokensFwd; // Net number of Tokens on which unget() has been called; these Tokens are ahead of nextToken
|
||||
#ifdef DEBUG
|
||||
int nTokensBack; // Number of Tokens on which unget() can be called; these Tokens are beind nextToken
|
||||
bool savedPreferRegExp[tokenBufferSize]; // Circular buffer of saved values of preferRegExp to get() calls
|
||||
#endif
|
||||
bool lexingUnit; // True if lexing a unit identifier immediately following a number
|
||||
public:
|
||||
World &world;
|
||||
Reader reader;
|
||||
|
||||
Lexer(World &world, const String &source, const String &sourceLocation, uint32 initialLineNum = 1);
|
||||
|
||||
void skip();
|
||||
const Token &get(bool preferRegExp);
|
||||
const Token *eat(bool preferRegExp, Token::Kind kind);
|
||||
const Token &peek(bool preferRegExp);
|
||||
void redesignate(bool preferRegExp);
|
||||
void unget();
|
||||
size_t getPos() const;
|
||||
|
||||
private:
|
||||
void syntaxError(const char *message, uint backUp = 1);
|
||||
char16 getChar();
|
||||
char16 internalGetChar(char16 ch);
|
||||
char16 peekChar();
|
||||
char16 internalPeekChar(char16 ch);
|
||||
bool testChar(char16 ch);
|
||||
|
||||
char16 lexEscape(bool unicodeOnly);
|
||||
bool lexIdentifier(String &s, bool allowLeadingDigit);
|
||||
bool lexNumeral();
|
||||
void lexString(String &s, char16 separator);
|
||||
void lexRegExp();
|
||||
void lexToken(bool preferRegExp);
|
||||
};
|
||||
|
||||
|
||||
#ifndef DEBUG
|
||||
inline void Lexer::redesignate(bool) {} // See description for the DEBUG version inside lexer.cpp
|
||||
#endif
|
||||
|
||||
// Return the position of the first character of the next token, which must have been peeked.
|
||||
inline size_t Lexer::getPos() const
|
||||
{
|
||||
ASSERT(nTokensFwd);
|
||||
return nextToken->getPos();
|
||||
}
|
||||
}
|
||||
#endif /* lexer_h___ */
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user