aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xconfigure18
-rw-r--r--configure.ac2
-rw-r--r--configure.ac.pamphlet2
-rw-r--r--src/ChangeLog20
-rw-r--r--src/algebra/outform.spad.pamphlet2
-rw-r--r--src/interp/c-util.boot13
-rw-r--r--src/interp/compiler.boot36
-rw-r--r--src/interp/fnewmeta.lisp10
-rw-r--r--src/interp/i-spec1.boot1
-rw-r--r--src/interp/metalex.lisp2
-rw-r--r--src/interp/newaux.lisp3
-rw-r--r--src/interp/parse.boot8
12 files changed, 93 insertions, 24 deletions
diff --git a/configure b/configure
index e2cdba05..bfa3d76e 100755
--- a/configure
+++ b/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.63 for OpenAxiom 1.4.0-2009-07-12.
+# Generated by GNU Autoconf 2.63 for OpenAxiom 1.4.0-2009-07-13.
#
# Report bugs to <open-axiom-bugs@lists.sf.net>.
#
@@ -745,8 +745,8 @@ SHELL=${CONFIG_SHELL-/bin/sh}
# Identity of this package.
PACKAGE_NAME='OpenAxiom'
PACKAGE_TARNAME='openaxiom'
-PACKAGE_VERSION='1.4.0-2009-07-12'
-PACKAGE_STRING='OpenAxiom 1.4.0-2009-07-12'
+PACKAGE_VERSION='1.4.0-2009-07-13'
+PACKAGE_STRING='OpenAxiom 1.4.0-2009-07-13'
PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net'
ac_unique_file="src/Makefile.pamphlet"
@@ -1502,7 +1502,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures OpenAxiom 1.4.0-2009-07-12 to adapt to many kinds of systems.
+\`configure' configures OpenAxiom 1.4.0-2009-07-13 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1572,7 +1572,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2009-07-12:";;
+ short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2009-07-13:";;
esac
cat <<\_ACEOF
@@ -1675,7 +1675,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OpenAxiom configure 1.4.0-2009-07-12
+OpenAxiom configure 1.4.0-2009-07-13
generated by GNU Autoconf 2.63
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
@@ -1689,7 +1689,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by OpenAxiom $as_me 1.4.0-2009-07-12, which was
+It was created by OpenAxiom $as_me 1.4.0-2009-07-13, which was
generated by GNU Autoconf 2.63. Invocation command line was
$ $0 $@
@@ -17704,7 +17704,7 @@ exec 6>&1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by OpenAxiom $as_me 1.4.0-2009-07-12, which was
+This file was extended by OpenAxiom $as_me 1.4.0-2009-07-13, which was
generated by GNU Autoconf 2.63. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -17767,7 +17767,7 @@ Report bugs to <bug-autoconf@gnu.org>."
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_version="\\
-OpenAxiom config.status 1.4.0-2009-07-12
+OpenAxiom config.status 1.4.0-2009-07-13
configured by $0, generated by GNU Autoconf 2.63,
with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"
diff --git a/configure.ac b/configure.ac
index fa635c7d..3b9d3a6d 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,6 +1,6 @@
sinclude(config/open-axiom.m4)
sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.4.0-2009-07-12],
+AC_INIT([OpenAxiom], [1.4.0-2009-07-13],
[open-axiom-bugs@lists.sf.net])
AC_CONFIG_AUX_DIR(config)
diff --git a/configure.ac.pamphlet b/configure.ac.pamphlet
index a0a18dbd..3be646ca 100644
--- a/configure.ac.pamphlet
+++ b/configure.ac.pamphlet
@@ -1141,7 +1141,7 @@ information:
<<Autoconf init>>=
sinclude(config/open-axiom.m4)
sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.4.0-2009-07-12],
+AC_INIT([OpenAxiom], [1.4.0-2009-07-13],
[open-axiom-bugs@lists.sf.net])
@
diff --git a/src/ChangeLog b/src/ChangeLog
index cac7aa68..37e87fe7 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,23 @@
+2009-07-13 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/metalex.lisp: "break" is now a keyword.
+ * interp/fnewmeta.lisp (PARSE-Jump): New.
+ * interp/compiler.boot (compAtom): Dipatch compilation of "break"
+ and "iterate" to...
+ (compBreak): ... here
+ (compIterate): and here.
+ (jumpFromLoop): New.
+ (compRepeatOrCollect): Initialize $lookKind, $iterateCount, and
+ $breakCount. Set exit point for loop bodies with 'iterate'
+ expressions.
+ * interp/parse.boot (parseAtom): Remove.
+ (parseTran): Adjust.
+ * algebra/outform.spad.pamphlet: Tidy.
+ * interp/c-util.boot ($loopKind): Declare.
+ ($repeatBodyLabel): Likewise.
+ ($iterateCount): Likewise.
+ ($breakCount): Likewise.
+
2009-07-12 Gabriel Dos Reis <gdr@cse.tamu.edu>
* algebra/mkfunc.spad.pamphlet
diff --git a/src/algebra/outform.spad.pamphlet b/src/algebra/outform.spad.pamphlet
index be457105..0ac9ba49 100644
--- a/src/algebra/outform.spad.pamphlet
+++ b/src/algebra/outform.spad.pamphlet
@@ -153,7 +153,7 @@ NumberFormats(): NFexports == NFimplementation where
-- Coefficient of 10**(i+2)
d := n rem 10
n := n quo 10
- zero? d => "iterate"
+ zero? d => iterate
m0:String := concat(new(i,plen),concat("I",new(i,pren)))
mm := concat([m0 for j in 1..d]$List(String))
-- strictly speaking the blank is gratuitous
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 3d050c51..34c1ce25 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -49,6 +49,19 @@ module c_-util where
$scanIfTrue := false
+++ If within a loop, which kind? (list comprehension or plain old loop)
+$loopKind := nil
+
+++ If within a loop, the program point for the start of the body.
+$repeatBodyLabel := nil
+
+++ The number of occurrance of `iterate' in a (plain old) loop.
+$iterateCount := nil
+
+++ The number of occurrance of `break' in a (plain old) loop.
+$breakCount := 0
+
+
+++ If non nil, holds compiled value of 'Rep' of the current domain.
$Representation := nil
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 2eb63a11..13cb5951 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -397,6 +397,8 @@ transImplementation(op,map,fn) ==
["call",fn]
compAtom(x,m,e) ==
+ x = "break" => compBreak(x,m,e)
+ x = "iterate" => compIterate(x,m,e)
T:= compAtomWithModemap(x,m,e,get(x,"modemap",e)) => T
x="nil" =>
T:=
@@ -1085,6 +1087,31 @@ compLeave(["leave",level,x],m,e) ==
modifyModeStack(m',index)
[["TAGGEDexit",index,u],m,e]
+jumpFromLoop(kind,key) ==
+ null $exitModeStack or kind ^= $loopKind =>
+ stackAndThrow('"You can use %1b only in %2b loop",[key,kind])
+ false
+ true
+
+compBreak: (%Symbol,%Mode,%Env) -> %Maybe %Triple
+compBreak(x,m,e) ==
+ x ^= "break" or not jumpFromLoop("REPEAT",x) => nil
+ index:= #$exitModeStack-1-$leaveLevelStack.0
+ $breakCount := $breakCount + 1
+ u := coerce(["$NoValue",$Void,e],$exitModeStack.index) or return nil
+ u := coerce(u,m) or return nil
+ modifyModeStack(u.mode,index)
+ [["TAGGEDexit",index,u],m,e]
+
+compIterate: (%Symbol,%Mode,%Env) -> %Maybe %Triple
+compIterate(x,m,e) ==
+ x ^= "iterate" or not jumpFromLoop("REPEAT",x) => nil
+ $iterateCount := $iterateCount + 1
+ -- We don't really produce a value; but we cannot adequately convey
+ -- that to the current 'EXIT' structure. So, pretend we have an
+ -- undefined value, which is a good enough approximation.
+ [["THROW","$loopBodyTag",nil],m,e]
+
--% return
compReturn: (%Form,%Mode,%Env) -> %Maybe %Triple
@@ -2272,6 +2299,9 @@ compRepeatOrCollect(form,m,e) ==
,e) where
fn(form,$exitModeStack,$leaveLevelStack,$formalArgList,e) ==
$until: local := nil
+ $loopKind: local := nil
+ $iterateCount: local := 0
+ $breakCount: local := 0
oldEnv := e
aggr := nil
[repeatOrCollect,:itl,body]:= form
@@ -2293,9 +2323,15 @@ compRepeatOrCollect(form,m,e) ==
return nil
-- If we're doing a collect, and the type isn't conformable
-- then we've boobed. JHD 26.July.1990
+ -- ??? we hve a plain old loop; the return type should be Void
+ $loopKind := repeatOrCollect
$NoValueMode
[body',m',e']:=
compOrCroak(body,bodyMode,e) or return nil
+ -- Massage the loop body if we have a structured jump.
+ if $iterateCount > 0 then
+ bodyTag := quoteForm GENSYM()
+ body' := ["CATCH",bodyTag,NSUBST(bodyTag,"$loopBodyTag",body')]
if $until then
[untilCode,.,e']:= comp($until,$Boolean,e')
itl':= substitute(["UNTIL",untilCode],'$until,itl')
diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp
index 0e248f83..7df80102 100644
--- a/src/interp/fnewmeta.lisp
+++ b/src/interp/fnewmeta.lisp
@@ -113,7 +113,7 @@
;; Return: 'return' Expression +(return #1) ;
-;; Exit: 'exit' (Expression / +\$NoValue) +(exit #1) ;
+;; Exit: 'exit' Expression +(exit #1) ;
;; Leave: 'leave' ( Expression / +\$NoValue )
;; ('from' Label +(leaveFrom #1 #1) / +(leave #1)) ;
@@ -571,13 +571,19 @@
(PUSH-REDUCTION '|PARSE-Return|
(CONS '|return| (CONS (POP-STACK-1) NIL)))))
+(DEFUN |PARSE-Jump| ()
+ (LET ((S (CURRENT-SYMBOL)))
+ (AND S
+ (ACTION (ADVANCE-TOKEN))
+ (PUSH-REDUCTION '|PARSE-Jump| S))))
+
(DEFUN |PARSE-Exit| ()
(AND (MATCH-ADVANCE-STRING "exit")
(MUST (OR (|PARSE-Expression|)
(PUSH-REDUCTION '|PARSE-Exit| '|$NoValue|)))
(PUSH-REDUCTION '|PARSE-Exit|
- (CONS '|exit| (CONS (POP-STACK-1) NIL)))))
+ (CONS '|exit| (CONS (POP-STACK-1) NIL)))))
(DEFUN |PARSE-Leave| ()
diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot
index 2ef75f07..20c43c79 100644
--- a/src/interp/i-spec1.boot
+++ b/src/interp/i-spec1.boot
@@ -45,7 +45,6 @@ $specialOps := '(
_[_|_|_] %Macro %MLambda %Import %Export %Inline %With %Add %Match)
$repeatLabel := NIL
-$breakCount := 0
$anonymousMapCounter := 0
++ List of free variables in the current function
diff --git a/src/interp/metalex.lisp b/src/interp/metalex.lisp
index 27b82522..0aaf9d70 100644
--- a/src/interp/metalex.lisp
+++ b/src/interp/metalex.lisp
@@ -573,7 +573,7 @@ empty (if File-Closed (return nil))
'(|or| |and| |isnt| |is| |when| |where| |forall| |exist|
|has| |with| |add| |case| |in| |by| |pretend| |mod|
|exquo| |div| |quo| |else| |rem| |then| |suchthat|
- |if| |yield| |iterate| |from| |exit| |leave| |return|
+ |if| |yield| |iterate| |break| |from| |exit| |leave| |return|
|not| |unless| |repeat| |until| |while| |for| |import| |inline|)
"Alphabetic literal strings occurring in the New Meta code constitute
diff --git a/src/interp/newaux.lisp b/src/interp/newaux.lisp
index db00f018..60475d2e 100644
--- a/src/interp/newaux.lisp
+++ b/src/interp/newaux.lisp
@@ -156,8 +156,9 @@
(|return| 202 201 (|PARSE-Return|))
(|leave| 202 201 (|PARSE-Leave|))
(|exit| 202 201 (|PARSE-Exit|))
+ (|break| 202 201 (|PARSE-Jump|))
+ (|iterate| 202 201 (|PARSE-Jump|))
(|from|)
- (|iterate|)
(|yield|)
(|if| 130 0 (|PARSE-Conditional|)) ; was 130
(|case| 130 190 (|PARSE-Match|))
diff --git a/src/interp/parse.boot b/src/interp/parse.boot
index 2a93222d..e656c023 100644
--- a/src/interp/parse.boot
+++ b/src/interp/parse.boot
@@ -70,7 +70,7 @@ parseTransform x ==
parseTran: %ParseForm -> %Form
parseTran x ==
- atom x => parseAtom x
+ atom x => x
[op,:argl]:= x
u := g(op) where g op == (op is ["elt",op,x] => g x; op)
u="construct" =>
@@ -87,12 +87,6 @@ parseType t ==
parseTypeList l ==
mapInto(l, function parseType)
-parseAtom: %Atom -> %Form
-parseAtom x ==
- -- next line for compatibility with new compiler
- x = "break" => parseLeave ["leave","$NoValue"]
- x
-
parseTranList: %List -> %List
parseTranList l ==
atom l => parseTran l
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-03 01:21:16 +0000