diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/interp/ChangeLog | 30 | ||||
| -rw-r--r-- | src/interp/Makefile.in | 4 | ||||
| -rw-r--r-- | src/interp/Makefile.pamphlet | 4 | ||||
| -rw-r--r-- | src/interp/i-analy.boot.pamphlet | 31 | ||||
| -rw-r--r-- | src/interp/i-intern.boot.pamphlet | 51 | ||||
| -rw-r--r-- | src/interp/i-object.boot | 120 |
6 files changed, 158 insertions, 82 deletions
diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog index 6730f98d..0606777a 100644 --- a/src/interp/ChangeLog +++ b/src/interp/ChangeLog @@ -1,3 +1,33 @@ +2007-10-20 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet (OBJS): Include i-object.$(FASLEXT). + (i-object.$(FASLEXT)): New rule. + * i-object.boot: New. + * i-analy.boot.pamphlet (getBasicMode): Move to i-object.boot. + (getBasicMode0): Likewise. + (getBasicObject): Likewise. + * i-intern.boot.pamphlet (mkObj): Likewise. + (mkObjWrap): Likewise. + (mkObjCode): Likewise. + (objNew): Likewise. + (objNewWrap): Likewise. + (objNewCode): Likewise. + (objSetVal): Likewise. + (objSetMode): Likewise. + (objVal): Likewise. + (objValUnwrap): Likewise. + (objMode): Likewise. + (objEnv): Likewise. + (objCodeVal): Likewise. + (objCodeMode): Likewise. + (asTupleNew): Likewise. + (asTupleNew0): Likewise. + (asTupleNewCode): Likewise. + (asTupleNewCode0): Likewise. + (asTupleSize): Likewise. + (asTupleAsVector): Likewise. + (asTupleAsList): Likewise. + 2007-10-16 Gabriel Dos Reis <gdr@cs.tamu.edu> * g-util.boot (isDomain): Merge with version in interop.boot.pamphlet. diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index a1f1d24c..2192c551 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -50,6 +50,7 @@ OBJS= vmlisp.$(FASLEXT) hash.$(FASLEXT) \ g-timer.$(FASLEXT) g-util.$(FASLEXT) \ ggreater.$(FASLEXT) \ hypertex.$(FASLEXT) i-analy.$(FASLEXT) \ + i-object.$(FASLEXT) \ i-code.$(FASLEXT) i-coerce.$(FASLEXT) \ i-coerfn.$(FASLEXT) i-eval.$(FASLEXT) \ i-funsel.$(FASLEXT) bookvol5.$(FASLEXT) \ @@ -437,6 +438,9 @@ rulesets.$(FASLEXT): rulesets.boot vmlisp.$(FASLEXT) i-output.$(FASLEXT): i-output.boot sys-macros.$(FASLEXT) $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $< +i-object.$(FASLEXT): i-object.boot sys-macros.$(FASLEXT) + $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $< + format.$(FASLEXT): format.boot macros.$(FASLEXT) $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $< diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index b1dfa937..bcf30250 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -319,6 +319,7 @@ OBJS= vmlisp.$(FASLEXT) hash.$(FASLEXT) \ g-timer.$(FASLEXT) g-util.$(FASLEXT) \ ggreater.$(FASLEXT) \ hypertex.$(FASLEXT) i-analy.$(FASLEXT) \ + i-object.$(FASLEXT) \ i-code.$(FASLEXT) i-coerce.$(FASLEXT) \ i-coerfn.$(FASLEXT) i-eval.$(FASLEXT) \ i-funsel.$(FASLEXT) bookvol5.$(FASLEXT) \ @@ -1612,6 +1613,9 @@ rulesets.$(FASLEXT): rulesets.boot vmlisp.$(FASLEXT) i-output.$(FASLEXT): i-output.boot sys-macros.$(FASLEXT) $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $< +i-object.$(FASLEXT): i-object.boot sys-macros.$(FASLEXT) + $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $< + format.$(FASLEXT): format.boot macros.$(FASLEXT) $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $< diff --git a/src/interp/i-analy.boot.pamphlet b/src/interp/i-analy.boot.pamphlet index ff2d62fa..ff751ace 100644 --- a/src/interp/i-analy.boot.pamphlet +++ b/src/interp/i-analy.boot.pamphlet @@ -48,37 +48,6 @@ --% Interpreter Analysis Functions ---% Basic Object Type Identification - -getBasicMode x == getBasicMode0(x,$useIntegerSubdomain) - -getBasicMode0(x,useIntegerSubdomain) == - -- if x is one of the basic types (Integer String Float Boolean) then - -- this function returns its type, and nil otherwise - x is nil => $EmptyMode - STRINGP x => $String - INTEGERP x => - useIntegerSubdomain => - x > 0 => $PositiveInteger - x = 0 => $NonNegativeInteger - $Integer - $Integer - FLOATP x => $DoubleFloat - (x='noBranch) or (x='noValue) => $NoValueMode - nil - -getBasicObject x == - INTEGERP x => - t := - not $useIntegerSubdomain => $Integer - x > 0 => $PositiveInteger - x = 0 => $NonNegativeInteger - $Integer - objNewWrap(x,t) - STRINGP x => objNewWrap(x,$String) - FLOATP x => objNewWrap(x,$DoubleFloat) - NIL - getMinimalVariableTower(var,t) == -- gets the minimal polynomial subtower of t that contains the -- given variable. Returns NIL if none. diff --git a/src/interp/i-intern.boot.pamphlet b/src/interp/i-intern.boot.pamphlet index 144aa0e5..46bd68c9 100644 --- a/src/interp/i-intern.boot.pamphlet +++ b/src/interp/i-intern.boot.pamphlet @@ -759,57 +759,6 @@ srcPosDisplay(sp) == sayBrightly [fillerSpaces(#s, '" "), dots, '"^"] true ---% Functions on interpreter objects - --- Interpreter objects used to be called triples because they had the --- structure [value, type, environment]. For many years, the environment --- was not used, so finally in January, 1990, the structure of objects --- was changed to be (type . value). This was chosen because it was the --- structure of objects of type Any. Sometimes the values are wrapped --- (see the function isWrapped to see what this means physically). --- Wrapped values are not actual values belonging to their types. An --- unwrapped value must be evaluated to get an actual value. A wrapped --- value must be unwrapped before being passed to a library function. --- Typically, an unwrapped value in the interpreter consists of LISP --- code, e.g., parts of a function that is being constructed. --- RSS 1/14/90 - --- These are the new structure functions. - -mkObj(val, mode) == CONS(mode,val) -- old names -mkObjWrap(val, mode) == CONS(mode,wrap val) -mkObjCode(val, mode) == ['CONS, MKQ mode,val ] - -objNew(val, mode) == CONS(mode,val) -- new names as of 10/14/93 -objNewWrap(val, mode) == CONS(mode,wrap val) -objNewCode(val, mode) == ['CONS, MKQ mode,val ] -objSetVal(obj,val) == RPLACD(obj,val) -objSetMode(obj,mode) == RPLACA(obj,mode) - -objVal obj == CDR obj -objValUnwrap obj == unwrap CDR obj -objMode obj == CAR obj -objEnv obj == $NE - -objCodeVal obj == CADDR obj -objCodeMode obj == CADR obj - - - - ---% Library compiler structures needed by the interpreter - --- Tuples and Crosses - -asTupleNew(size, listOfElts) == CONS(size, LIST2VEC listOfElts) -asTupleNew0(listOfElts) == CONS(#listOfElts, LIST2VEC listOfElts) - -asTupleNewCode(size, listOfElts) == ["asTupleNew", size, ['LIST, :listOfElts]] -asTupleNewCode0(listForm) == ["asTupleNew0", listForm] - -asTupleSize(at) == CAR at -asTupleAsVector(at) == CDR at -asTupleAsList(at) == VEC2LIST asTupleAsVector at @ \eject \begin{thebibliography}{99} diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot new file mode 100644 index 00000000..39b96214 --- /dev/null +++ b/src/interp/i-object.boot @@ -0,0 +1,120 @@ +-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +-- All rights reserved. +-- Copyright (C) 2007, Gabriel Dos Reis. +-- All rights reserved. +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- - Redistributions of source code must retain the above copyright +-- notice, this list of conditions and the following disclaimer. +-- +-- - Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in +-- the documentation and/or other materials provided with the +-- distribution. +-- +-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the +-- names of its contributors may be used to endorse or promote products +-- derived from this software without specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +import '"sys-macros" +)package "BOOT" + +--% Functions on interpreter objects + +-- Interpreter objects used to be called triples because they had the +-- structure [value, type, environment]. For many years, the environment +-- was not used, so finally in January, 1990, the structure of objects +-- was changed to be (type . value). This was chosen because it was the +-- structure of objects of type Any. Sometimes the values are wrapped +-- (see the function isWrapped to see what this means physically). +-- Wrapped values are not actual values belonging to their types. An +-- unwrapped value must be evaluated to get an actual value. A wrapped +-- value must be unwrapped before being passed to a library function. +-- Typically, an unwrapped value in the interpreter consists of LISP +-- code, e.g., parts of a function that is being constructed. +-- RSS 1/14/90 + +-- These are the new structure functions. + +mkObj(val, mode) == CONS(mode,val) -- old names +mkObjWrap(val, mode) == CONS(mode,wrap val) +mkObjCode(val, mode) == ['CONS, MKQ mode,val ] + +objNew(val, mode) == CONS(mode,val) -- new names as of 10/14/93 +objNewWrap(val, mode) == CONS(mode,wrap val) +objNewCode(val, mode) == ['CONS, MKQ mode,val ] +objSetVal(obj,val) == RPLACD(obj,val) +objSetMode(obj,mode) == RPLACA(obj,mode) + +objVal obj == CDR obj +objValUnwrap obj == unwrap CDR obj +objMode obj == CAR obj +objEnv obj == $NE + +objCodeVal obj == CADDR obj +objCodeMode obj == CADR obj + + +--% Library compiler structures needed by the interpreter + +-- Tuples and Crosses + +asTupleNew(size, listOfElts) == CONS(size, LIST2VEC listOfElts) +asTupleNew0(listOfElts) == CONS(#listOfElts, LIST2VEC listOfElts) + +asTupleNewCode(size, listOfElts) == ["asTupleNew", size, ['LIST, :listOfElts]] +asTupleNewCode0(listForm) == ["asTupleNew0", listForm] + +asTupleSize(at) == CAR at +asTupleAsVector(at) == CDR at +asTupleAsList(at) == VEC2LIST asTupleAsVector at + +--% Basic Object Type Identification + +++ If x is a literal of the basic types (Integer String DoubleFloat) then +++ this function returns its type, and nil otherwise. +getBasicMode x == getBasicMode0(x,$useIntegerSubdomain) + +++ Subroutine of getBasicMode. +getBasicMode0(x,useIntegerSubdomain) == + x is nil => $EmptyMode + STRINGP x => $String + INTEGERP x => + useIntegerSubdomain => + x > 0 => $PositiveInteger + x = 0 => $NonNegativeInteger + $Integer + $Integer + FLOATP x => $DoubleFloat + (x='noBranch) or (x='noValue) => $NoValueMode + nil + +++ If x is a literal of the basic types then returns +++ an interpreter object denoting x, and nil otherwise. +getBasicObject x == + INTEGERP x => + t := + not $useIntegerSubdomain => $Integer + x > 0 => $PositiveInteger + x = 0 => $NonNegativeInteger + $Integer + objNewWrap(x,t) + STRINGP x => objNewWrap(x,$String) + FLOATP x => objNewWrap(x,$DoubleFloat) + NIL + |