From c6efaa6ac903c17bd85eb51e672f80e9baa0ebc4 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Mon, 13 Jul 2009 22:36:51 +0000 Subject: * 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. --- configure | 18 +++++++++--------- configure.ac | 2 +- configure.ac.pamphlet | 2 +- src/ChangeLog | 20 ++++++++++++++++++++ src/algebra/outform.spad.pamphlet | 2 +- src/interp/c-util.boot | 13 +++++++++++++ src/interp/compiler.boot | 36 ++++++++++++++++++++++++++++++++++++ src/interp/fnewmeta.lisp | 10 ++++++++-- src/interp/i-spec1.boot | 1 - src/interp/metalex.lisp | 2 +- src/interp/newaux.lisp | 3 ++- src/interp/parse.boot | 8 +------- 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 . # @@ -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 ." _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: <>= 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 + + * 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 * 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 -- cgit v1.2.3