diff options
-rw-r--r-- | src/ChangeLog | 21 | ||||
-rw-r--r-- | src/algebra/color.spad.pamphlet | 2 | ||||
-rw-r--r-- | src/algebra/files.spad.pamphlet | 2 | ||||
-rw-r--r-- | src/algebra/fnla.spad.pamphlet | 1 | ||||
-rw-r--r-- | src/algebra/newpoint.spad.pamphlet | 1 | ||||
-rw-r--r-- | src/interp/i-analy.boot | 4 | ||||
-rw-r--r-- | src/interp/i-coerce.boot | 2 | ||||
-rw-r--r-- | src/interp/i-eval.boot | 2 | ||||
-rw-r--r-- | src/interp/i-funsel.boot | 4 | ||||
-rw-r--r-- | src/interp/i-intern.boot | 2 | ||||
-rw-r--r-- | src/interp/i-map.boot | 28 | ||||
-rw-r--r-- | src/interp/i-output.boot | 4 | ||||
-rw-r--r-- | src/interp/i-spec1.boot | 4 | ||||
-rw-r--r-- | src/interp/i-syscmd.boot | 4 | ||||
-rw-r--r-- | src/interp/i-toplev.boot | 2 | ||||
-rw-r--r-- | src/interp/patches.lisp | 7 | ||||
-rw-r--r-- | src/interp/trace.boot | 2 |
17 files changed, 55 insertions, 37 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 5f3c34e5..78650627 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,24 @@ +2008-10-13 Gabriel Dos Reis <gdr@cs.tamu.edu> + + Don't step over Common Lisp MAP. + * interp/i-analy.boot (bottomUp): Change MAP to %Map. + (isEltable): Likewise. + * interp/i-coerce.boot (retract): Likewise. + * interp/i-eval.boot (getArgValue): Likewise. + * interp/i-funsel.boot (selectLocalMms): Likewise. + * interp/i-intern.boot (getValueFromEnvironment): Likewise. + * interp/i-map.boot (mkAuxiliaryName): Likewise. + (augmentMap): Likewise. + (displayMap): Likewise. + (putBodyInEnd): Likewise. + (expandRecursiveBody): Likewise. + * interp/i-output.boot (outputTran): Likewise. + * interp/i-spec1.boot (declare): Likewise. + * interp/i-syscmd.boot (displayMacro): Likewise. + * interp/i-toplev.boot (interpret2): Likewise. + * interp/patches.lisp (MAP): Remove. + * interp/trace.boot (isUncompiledMap): Likewise. + 2008-10-12 Gabriel Dos Reis <gdr@cs.tamu.edu> Add support for Lisp declarations in generated Lisp code. diff --git a/src/algebra/color.spad.pamphlet b/src/algebra/color.spad.pamphlet index 5db08528..54c5e403 100644 --- a/src/algebra/color.spad.pamphlet +++ b/src/algebra/color.spad.pamphlet @@ -184,6 +184,8 @@ Palette(): Exports == Implementation where ++ indicated color c. Implementation ==> add + import I + import C Rep := Record(shadeField:I, hueField:C) dark c == [1,c] diff --git a/src/algebra/files.spad.pamphlet b/src/algebra/files.spad.pamphlet index 34cd7937..630b19af 100644 --- a/src/algebra/files.spad.pamphlet +++ b/src/algebra/files.spad.pamphlet @@ -34,7 +34,7 @@ IOMode(): Public == Private where Private == add input == _$InputIOMode$Lisp output == _$OutputIOMode$Lisp - bothWays == _$BothWaysIOode$Lisp + bothWays == _$BothWaysIOmode$Lisp x = y == EQ(x,y)$Lisp coerce m == m = input => outputForm 'input diff --git a/src/algebra/fnla.spad.pamphlet b/src/algebra/fnla.spad.pamphlet index e56534e4..3be85585 100644 --- a/src/algebra/fnla.spad.pamphlet +++ b/src/algebra/fnla.spad.pamphlet @@ -63,6 +63,7 @@ Commutator: Export == Implement where ++ mkcomm(i,j) \undocumented{} Implement == add + import OSI P := Record(left:%,right:%) Rep := Union(OSI,P) x,y: % diff --git a/src/algebra/newpoint.spad.pamphlet b/src/algebra/newpoint.spad.pamphlet index 9842394b..bd2b658e 100644 --- a/src/algebra/newpoint.spad.pamphlet +++ b/src/algebra/newpoint.spad.pamphlet @@ -102,6 +102,7 @@ SubSpaceComponentProperty() : Exports == Implementation where ++ copy(x) \undocumented Implementation ==> add + import B Rep := Record(closed:B, solid:B) closed? p == p.closed solid? p == p.solid diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot index cbf3e34a..39b4bf2e 100644 --- a/src/interp/i-analy.boot +++ b/src/interp/i-analy.boot @@ -241,7 +241,7 @@ bottomUp t == -- see if we are calling a declared user map -- if so, push down the declared types as targets on the args - if opVal and (objVal opVal is ['MAP,:.]) and + if opVal and (objVal opVal is ["%Map",:.]) and (getMode op is ['Mapping,:ms]) and (nargs + 1= #ms) then for m in rest ms for x in argl repeat putTarget(x,m) @@ -832,7 +832,7 @@ isEltable(op,argl,numArgs) == ZEROP numArgs => true not(m := objMode(v)) => nil m is ['Mapping, :.] => nil - objVal(v) is ['MAP, :mapDef] and numMapArgs(mapDef) > 0 => nil + objVal(v) is ["%Map",:mapDef] and numMapArgs(mapDef) > 0 => nil true m := getMode op => ZEROP numArgs => true diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot index 9a2b078e..35a0e23b 100644 --- a/src/interp/i-coerce.boot +++ b/src/interp/i-coerce.boot @@ -91,7 +91,7 @@ retract object == STRINGP type => 'failed type = $EmptyMode => 'failed val := objVal object - not isWrapped val and val isnt ['MAP,:.] => 'failed + not isWrapped val and val isnt ["%Map",:.] => 'failed type' := equiType(type) (ans := retract1 objNew(val,equiType(type))) = 'failed => ans objNew(objVal ans,eqType objMode ans) diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot index ed5da634..cf3028f3 100644 --- a/src/interp/i-eval.boot +++ b/src/interp/i-eval.boot @@ -290,7 +290,7 @@ getArgValue1(a,t) == -- creates a value for a, coercing to t t' := getValue(a) => (m := getMode a) and (m is ['Mapping,:ml]) and (m = t) and - objValUnwrap(t') is ['MAP,:.] => + objValUnwrap(t') is ["%Map",:.] => getMappingArgValue(a,t,m) t' := coerceOrRetract(t',t) t' and getValueNormalForm t' diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index 01137aca..a5e90b39 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -549,7 +549,7 @@ selectLocalMms(op,name,types,tar) == -- partial rewrite, looks now for exact local modemap mmS:= getLocalMms(name,types,tar) => mmS obj := getValue op - obj and (objVal obj is ['MAP,:mapDef]) and + obj and (objVal obj is ["%Map",:mapDef]) and analyzeMap(op,types,mapDef,tar) and getLocalMms(name,types,tar) -- next defn may be better, test when more time. RSS 3/11/94 @@ -565,7 +565,7 @@ selectLocalMms(op,name,types,tar) == -- matchingMms => nreverse matchingMms -- -- obj := getValue op --- obj and (objVal obj is ['MAP,:mapDef]) and +-- obj and (objVal obj is ["%Map",:mapDef]) and -- analyzeMap(op,types,mapDef,tar) and getLocalMms(name,types,tar) getLocalMms(name,types,tar) == diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot index 11ff1a4a..20a066fd 100644 --- a/src/interp/i-intern.boot +++ b/src/interp/i-intern.boot @@ -399,7 +399,7 @@ getValueFromSpecificEnvironment(id,mode,e) == systemErrorHere '"getValueFromSpecificEnvironment" v := objValUnwrap u mode isnt ['Mapping,:mapSig] => v - v isnt ['MAP,:.] => v + v isnt ["%Map",:.] => v v' := coerceInt(u,mode) null v' => throwKeyedMsg("S2IC0002",[objMode u,mode]) objValUnwrap v' diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index 6ae29170..be2c923e 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -76,11 +76,11 @@ mkAuxiliaryName(name) == INTERNL(STRINGIMAGE name,'";AUX") --% Adding a function definition -isMapExpr x == x is ['MAP,:.] +isMapExpr x == x is ["%Map",:.] isMap x == y := get(x,'value,$InteractiveFrame) => - objVal y is ['MAP,:.] => x + objVal y is ["%Map",:.] => x addDefMap(['DEF,lhs,mapsig,.,rhs],pred) == -- Create a new map, add to an existing one, or define a variable @@ -200,13 +200,13 @@ augmentMap(op,args,pred,body,oldMap) == newMap --just delete rule if body is entry:= [pattern,:body] resultMap:= - newMap is ["MAP",:tail] => ["MAP",:tail,entry] - ["MAP",entry] + newMap is ["%Map",:tail] => ["%Map",:tail,entry] + ["%Map",entry] resultMap deleteMap(op,pattern,map) == - map is ["MAP",:tail] => - newMap:= ['MAP,:[x for x in tail | w]] where w() == + map is ["%Map",:tail] => + newMap:= ["%Map",:[x for x in tail | w]] where w() == x is [=pattern,:replacement] => sayDroppingFunctions(op,[x]) true null rest newMap => nil @@ -397,7 +397,7 @@ outputFormat(x,m) == objValUnwrap T displaySingleRule($op,pattern,replacement) == - mathprint ['MAP,[pattern,:replacement]] + mathprint ["%Map",[pattern,:replacement]] displayMap(headingIfTrue,$op,map) == mathprint @@ -565,7 +565,7 @@ rewriteMap(op,opName,argl) == putBodyInEnv(opName, numArgs) == val := get(opName, 'value, $e) - val is [.,'MAP, :bod] => + val is [.,"%Map", :bod] => $e := putHist(opName, 'mapBody, combineMapParts mapDefsWithCorrectArgCount(numArgs, bod), $e) 'failed @@ -779,7 +779,7 @@ mapRecurDepth(opName,opList,body) == 0 op in opList => argc op=opName => 1 + argc - (obj := get(op,'value,$e)) and objVal obj is ['MAP,:mapDef] => + (obj := get(op,'value,$e)) and objVal obj is ["%Map",:mapDef] => mapRecurDepth(opName,[op,:opList],getMapBody(op,mapDef)) + argc argc @@ -882,12 +882,12 @@ nonRecursivePart(opName, funBody) == expandRecursiveBody(alreadyExpanded, body) == -- replaces calls to other maps with their bodies atom body => - (obj := get(body,'value,$e)) and objVal obj is ['MAP,:mapDef] and + (obj := get(body,'value,$e)) and objVal obj is ["%Map",:mapDef] and ((numMapArgs mapDef) = 0) => getMapBody(body,mapDef) body body is [op,:argl] => not (op in alreadyExpanded) => - (obj := get(op,'value,$e)) and objVal obj is ['MAP,:mapDef] => + (obj := get(op,'value,$e)) and objVal obj is ["%Map",:mapDef] => newBody:= getMapBody(op,mapDef) for arg in argl for var in $FormalMapVariableList repeat newBody:=MSUBST(arg,var,newBody) @@ -1133,7 +1133,7 @@ getLocalVars(op,body) == -- are "maps". -- -- The structure of maps: --- (MAP (pattern . rewrite) ...) where +-- (%Map (pattern . rewrite) ...) where -- pattern has forms: arg-pattern -- (tuple arg-pattern ...) -- rewrite has forms: (WRAPPED . value) --don't re-evaluate @@ -1143,8 +1143,8 @@ getLocalVars(op,body) == -- -- When assigning values to a map, each new value must have a type -- which is consistent with those already assigned. Initially, type --- of MAP is $EmptyMode. When the map is first assigned a value, the --- type of the MAP is RPLACDed to be (Mapping target source ..). +-- of %Map is $EmptyMode. When the map is first assigned a value, the +-- type of the %Map is RPLACDed to be (Mapping target source ..). -- When the map is next assigned, the type of both source and target -- is upgraded to be consistent with those values already computed. -- Of course, if new and old source and target are identical, nothing diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index e7c1d62b..c31616c1 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -502,7 +502,7 @@ outputTran x == c is ['COLLECT,:m,d] and d is ['construct,e] and e is ['COLLECT,:.] => outputTran ['COLLECT,:m,e] x is ['LIST,:l] => outputTran ['BRACKET,['AGGLST,:l]] - x is ['MAP,:l] => outputMapTran l + x is ["%Map",:l] => outputMapTran l x is ['brace, :l] => ['BRACE, ['AGGLST,:[outputTran y for y in l]]] x is ["return",l] => ["return",outputTran l] @@ -1641,7 +1641,7 @@ outputOp x == [newop,:[outputOp y for y in args]] x ---% MAP PRINTER (FROM EV BOOT) +--% %Map PRINTER (FROM EV BOOT) printMap u == printBasic specialChar 'lbrk diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot index 93c383f7..cec4db2b 100644 --- a/src/interp/i-spec1.boot +++ b/src/interp/i-spec1.boot @@ -1142,7 +1142,7 @@ declare(var,mode) == throwKeyedMsg("S2IS0017",[var,mode]) -- validate that the new declaration has the defined # of args mapval := objVal get(var,'value,$e) - -- mapval looks like '(MAP (args . defn)) + -- mapval looks like '(%Map (args . defn)) margs := CAADR mapval -- if one args, margs is not a pair, just #1 or NIL -- otherwise it looks like (tuple #1 #2 ...) @@ -1166,7 +1166,7 @@ declare(var,mode) == declareMap(var,mode) == -- declare a Mapping property - (v:=get(var,'value,$e)) and objVal(v) isnt ['MAP,:.] => + (v:=get(var,'value,$e)) and objVal(v) isnt ["%Map",:.] => throwKeyedMsg("S2IS0019",[var]) isPartialMode mode => throwKeyedMsg("S2IM0004",NIL) putHist(var,'mode,mode,$e) diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index d45895b2..21abc32b 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -942,7 +942,7 @@ displayMacro name == null args => nil null rest args => first args ["tuple",:args] - mathprint ['MAP,[args,:body]] + mathprint ["%Map",[args,:body]] displayWorkspaceNames() == imacs := getInterpMacroNames() @@ -1103,7 +1103,7 @@ displayType($op,u,omitVariableNameIfTrue) == displayValue($op,u,omitVariableNameIfTrue) == null u => sayMSG [" Value of ",fixObjectForPrinting PNAME $op,'": (none)"] expr := objValUnwrap(u) - expr is [op,:.] and (op = 'MAP) or objMode(u) = $EmptyMode => + expr is [op,:.] and (op = "%Map") or objMode(u) = $EmptyMode => displayRule($op,expr) label:= omitVariableNameIfTrue => diff --git a/src/interp/i-toplev.boot b/src/interp/i-toplev.boot index 6af0a9e7..af7a4de8 100644 --- a/src/interp/i-toplev.boot +++ b/src/interp/i-toplev.boot @@ -338,7 +338,7 @@ interpret2(object,m1,posnForm) == x := objVal object m := objMode object m=$EmptyMode => - x is [op,:.] and op in '(MAP STREAM) => objNew(x,m1) + x is [op,:.] and op in '(%Map STREAM) => objNew(x,m1) m1 = $EmptyMode => objNew(x,m) systemErrorHere '"interpret2" m1 => diff --git a/src/interp/patches.lisp b/src/interp/patches.lisp index 056ac23a..2c25a1fd 100644 --- a/src/interp/patches.lisp +++ b/src/interp/patches.lisp @@ -136,13 +136,6 @@ ;; (eval-when (eval load compile) (shadow 'delete)) ;; (define-function 'boot::delete #'|delete|) -;; following code is to mimic def of MAP in NEWSPAD LISP -;; i.e. MAP in boot package is a self evaluating form -;; #-:CCL (eval-when (eval load compile) (shadow 'map)) -;; #-:CCL (defmacro map (&rest args) `'(map ,@args)) -(eval-when (eval load compile) (shadow 'map)) -(defmacro map (&rest args) `'(map ,@args)) - ;; following are defined in spadtest.boot and stantest.boot (defun |installStandardTestPackages| () ()) (defun |spadtestValueHook| (val type) ()) diff --git a/src/interp/trace.boot b/src/interp/trace.boot index c8db20e7..6d487e1f 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -387,7 +387,7 @@ rassocSub(x,subs) == isUncompiledMap(x) == y:= get(x,'value,$InteractiveFrame) => - (CAAR y) = 'MAP and null get(x,'localModemap,$InteractiveFrame) + (CAAR y) = "%Map" and null get(x,'localModemap,$InteractiveFrame) isInterpOnlyMap(map) == x:= get(map,'localModemap,$InteractiveFrame) => |