aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog36
-rw-r--r--src/boot/translator.boot1
-rw-r--r--src/interp/compiler.boot4
-rw-r--r--src/interp/def.lisp2
-rw-r--r--src/interp/define.boot8
-rw-r--r--src/interp/fnewmeta.lisp2
-rw-r--r--src/interp/fortcall.boot6
-rw-r--r--src/interp/mark.boot6
-rw-r--r--src/interp/nruncomp.boot2
-rw-r--r--src/interp/nrunopt.boot2
-rw-r--r--src/interp/postpar.boot52
-rw-r--r--src/interp/trace.boot2
-rw-r--r--src/interp/wi1.boot4
-rw-r--r--src/testsuite/compiler/aw-420.spad8
14 files changed, 88 insertions, 47 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 4681b30a..42358c16 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,41 @@
2008-05-16 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ Fix AW/420
+ * interp/compiler.boot (compSetq1): Use %Comma, not Tuple.
+ (setqMultiple): Likewise.
+ * interp/def.lisp (DEF-IS2): Likewise.
+ * interp/define.boot (compAdd): Likewise.
+ * interp/fnewmeta.lisp (|PARSE-Enclosure|): Likewise.
+ * interp/fortcall.boot (lmultiToUnivariate): Likewise.
+ (functionAndJacobian): Likewise.
+ (vectorOfFunctions): Likewise.
+ * interp/mark.boot (markMultipleExplicit): Likewise.
+ (markInsertBodyParts): Likewise.
+ * interp/nruncomp.boot (NRTaddDeltaCode): Likewise.
+ * interp/nrunopt.boot (NRTextendsCategory1): Likewise.
+ * interp/postpar.boot (postTransform): Likewise.
+ (postTran): Likewise.
+ (postPretend): Likewise.
+ (postConstruct): Likewise.
+ (postBlockItem): Likewise.
+ (postCategory): Likewise.
+ (postForm): Likewise.
+ (postTransScripts): Likewise.
+ (postJoin): Likewise.
+ (postMapping): Likewise.
+ (postCollect): Likewise.
+ (postInSeq): Likewise.
+ (postType): Likewise.
+ (post%Comma): Rename from postTuple.
+ (unComma): Rename from unTuple.
+ (comma2Tuple): Remove.
+ * interp/trace.boot (traceSpad2Cmd): Use %Comma, not Tuple.
+ * interp/wi1.boot (compSetq1): Likewise.
+ (setqMultiple):Likewise.
+ * boot/translator.boot (compileBootHandler): Give up if
+ translation to Lisp contained errors.
+ * testsuite/compiler/aw-420.spad: New.
+
* interp/Makefile.pamphlet: Simplify.
2008-05-15 Gabriel Dos Reis <gdr@cs.tamu.edu>
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index ec6d6eab..3864dcca 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -808,6 +808,7 @@ translateBootFile(progname, options, file) ==
compileBootHandler(progname, options, file) ==
intFile := BOOTTOCL(file, getIntermediateLispFile(file,options))
+ errorCount() ^= 0 => nil
intFile =>
objFile := compileLispHandler(progname, options, intFile)
DELETE_-FILE intFile
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 62d98f02..0f42b428 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -645,7 +645,7 @@ compSetq1(form,val,m,E) ==
compSetq(["LET",x,val],m,E')
form is [op,:l] =>
op="CONS" => setqMultiple(uncons form,val,m,E)
- op="Tuple" => setqMultiple(l,val,m,E)
+ op="%Comma" => setqMultiple(l,val,m,E)
setqSetelt(form,val,m,E)
compMakeDeclaration: (%Form,%Mode,%Env) -> %Maybe %Triple
@@ -706,7 +706,7 @@ assignError(val,m',form,m) ==
setqMultiple(nameList,val,m,e) ==
val is ["CONS",:.] and m=$NoValueMode =>
setqMultipleExplicit(nameList,uncons val,m,e)
- val is ["Tuple",:l] and m=$NoValueMode => setqMultipleExplicit(nameList,l,m,e)
+ val is ["%Comma",:l] and m=$NoValueMode => setqMultipleExplicit(nameList,l,m,e)
1 --create a gensym, %add to local environment, compile and assign rhs
g:= genVariable()
e:= addBinding(g,nil,e)
diff --git a/src/interp/def.lisp b/src/interp/def.lisp
index 9d684695..b6f7a920 100644
--- a/src/interp/def.lisp
+++ b/src/interp/def.lisp
@@ -386,7 +386,7 @@ foo defined inside of fum gets renamed as fum,foo.")
(defun DEF-IS2 (FORM STRUCT)
(let ($IS-EQLIST $IS-SPILL_LIST (FORM (DEFTRAN FORM)))
- (if (EQCAR STRUCT '|Tuple|)
+ (if (EQCAR STRUCT '|%Comma|)
(MOAN "you must use square brackets around right arg. to" '%b "is" '%d))
(let* ((X (DEF-IS-EQLIST (DEF-IS-REMDUP STRUCT)))
(CODE (if (IDENTP X)
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 6f7ad89f..5a2cb24e 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1221,7 +1221,7 @@ bootStrapError(functorForm,sourceFile) ==
compAdd: (%Form, %Mode, %Env) -> %Maybe %Triple
compAdd(['add,$addForm,capsule],m,e) ==
$bootStrapMode = true =>
- if $addForm is ['Tuple,:.] then code := nil
+ if $addForm is ["%Comma",:.] then code := nil
else [code,m,e]:= comp($addForm,m,e)
[['COND, _
['$bootStrapMode, _
@@ -1239,13 +1239,13 @@ compAdd(['add,$addForm,capsule],m,e) ==
[$addForm,.,e]:= compSubDomain1(domainForm,predicate,m,e)
else
$packagesUsed :=
- $addForm is ['Tuple,:u] => [:u,:$packagesUsed]
+ $addForm is ["%Comma",:u] => [:u,:$packagesUsed]
[$addForm,:$packagesUsed]
--+
$NRTaddForm := $addForm
[$addForm,.,e]:=
- $addForm is ['Tuple,:.] =>
- $NRTaddForm := ['Tuple,:[NRTgetLocalIndex x for x in rest $addForm]]
+ $addForm is ["%Comma",:.] =>
+ $NRTaddForm := ["%Comma",:[NRTgetLocalIndex x for x in rest $addForm]]
compOrCroak(compTuple2Record $addForm,$EmptyMode,e)
compOrCroak($addForm,$EmptyMode,e)
compCapsule(capsule,m,e)
diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp
index b7806f20..56420a92 100644
--- a/src/interp/fnewmeta.lisp
+++ b/src/interp/fnewmeta.lisp
@@ -801,7 +801,7 @@
(MUST (MATCH-ADVANCE-STRING ")")))
(AND (MATCH-ADVANCE-STRING ")")
(PUSH-REDUCTION '|PARSE-Enclosure|
- (CONS '|Tuple| NIL))))))
+ (CONS '|%Comma| NIL))))))
(AND (MATCH-ADVANCE-STRING "{")
(MUST (OR (AND (|PARSE-Expr| 6)
(MUST (MATCH-ADVANCE-STRING "}"))
diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot
index 402800b8..9d7d0d50 100644
--- a/src/interp/fortcall.boot
+++ b/src/interp/fortcall.boot
@@ -748,7 +748,7 @@ multiToUnivariate f ==
-- elements of a vector, and compile it.
(first f) ^= "+->" => error "in multiToUnivariate: not an AnonymousFunction"
if PAIRP CADR f then
- vars := CDADR f -- throw away 'Tuple at start of variable list
+ vars := CDADR f -- throw away '%Comma at start of variable list
else
vars := [CADR f]
body := COPY_-TREE CADDR f
@@ -765,7 +765,7 @@ functionAndJacobian f ==
-- evaluate function and jacobian values.
(first f) ^= "+->" => error "in functionAndJacobian: not an AnonymousFunction"
if PAIRP CADR f then
- vars := CDADR f -- throw away 'Tuple at start of variable list
+ vars := CDADR f -- throw away '%Comma at start of variable list
else
vars := [CADR f]
#(vars) ^= #(CDADDR f) =>
@@ -793,7 +793,7 @@ vectorOfFunctions f ==
-- evaluate function values.
(first f) ^= "+->" => error "in vectorOfFunctions: not an AnonymousFunction"
if PAIRP CADR f then
- vars := CDADR f -- throw away 'Tuple at start of variable list
+ vars := CDADR f -- throw away '%Comma at start of variable list
else
vars := [CADR f]
funBodies := COPY_-TREE CDADDR f
diff --git a/src/interp/mark.boot b/src/interp/mark.boot
index b8ae9716..a1266fb3 100644
--- a/src/interp/mark.boot
+++ b/src/interp/mark.boot
@@ -120,7 +120,7 @@ markCoerceChk x ==
markMultipleExplicit(nameList, valList, T) ==
tcheck T
[mkWi('setqMultipleExplicit, 'WI,
- ['LET, ['Tuple,:nameList], ['Tuple,:valList]],
+ ['LET, ["%Comma",:nameList], ["%Comma",:valList]],
T.expr), :CDR T]
markRetract(x,T) ==
@@ -1144,8 +1144,8 @@ markInsertBodyParts u ==
['SEQ,:[markInsertBodyParts y for y in l],
['exit,n,markInsertBodyParts x]]
u is [op,:l] and MEMQ(op,'(REPEAT COLLECT)) => markInsertRepeat u
- u is ['LET,['Tuple,:s],b] =>
- ['LET,['Tuple,:[markWrapPart x for x in s]],markInsertBodyParts b]
+ u is ['LET,["%Comma",:s],b] =>
+ ['LET,["%Comma",:[markWrapPart x for x in s]],markInsertBodyParts b]
--u is ['LET,a,b] and constructor? opOf b => u
u is ['LET,a,b] and a is [op,:.] =>
['LET,[markWrapPart x for x in a],markInsertBodyParts b]
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 5d9c811a..3fffd59f 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -86,7 +86,7 @@ NRTaddDeltaCode() ==
$template.i:= deltaTran(item,compItem)
$template.5 :=
$NRTaddForm =>
- $NRTaddForm is ['Tuple,:y] => NREVERSE y
+ $NRTaddForm is ["%Comma",:y] => NREVERSE y
NRTencode($NRTaddForm,$addForm)
nil
diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot
index 19ff1932..38aed65f 100644
--- a/src/interp/nrunopt.boot
+++ b/src/interp/nrunopt.boot
@@ -816,7 +816,7 @@ getExportCategory form ==
EQSUBSTLIST(argl,$FormalMapVariableList,target)
NRTextendsCategory1(domform,exCategory,addForm) ==
- addForm is ['Tuple,:r] =>
+ addForm is ["%Comma",:r] =>
and/[extendsCategory(domform,exCategory,x) for x in r]
extendsCategory(domform,exCategory,addForm)
diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot
index 634a7960..2697ab22 100644
--- a/src/interp/postpar.boot
+++ b/src/interp/postpar.boot
@@ -53,7 +53,7 @@ postTransform: %ParseTree -> %ParseForm
postTransform y ==
x:= y
u:= postTran x
- if u is ["Tuple",:l,[":",y,t]] and (and/[IDENTP x for x in l]) then u:=
+ if u is ["%Comma",:l,[":",y,t]] and (and/[IDENTP x for x in l]) then u:=
[":",["LISTOF",:l,y],t]
postTransformCheck u
u
@@ -86,7 +86,7 @@ postTran x ==
u:= postTran [b,:rest x]
[postTran op,:rest u]
op is ["Scripts",:.] =>
- postScriptsForm(op,"append"/[unTuple postTran y for y in rest x])
+ postScriptsForm(op,"append"/[unComma postTran y for y in rest x])
op^=(y:= postOp op) => [y,:postTranList rest x]
postForm x
@@ -153,9 +153,9 @@ postPretend t ==
postConstruct: %ParseTree -> %ParseForm
postConstruct u ==
u is ["construct",b] =>
- a:= (b is [",",:.] => comma2Tuple b; b)
+ a:= (b is [",",:.] => ["%Comma",:postFlatten(b,",")]; b)
a is ["SEGMENT",p,q] => ["construct",postTranSegment(p,q)]
- a is ["Tuple",:l] =>
+ a is ["%Comma",:l] =>
or/[x is [":",y] for x in l] => postMakeCons l
or/[x is ["SEGMENT",:.] for x in l] => tuple2List l
["construct",:postTranList l]
@@ -200,7 +200,7 @@ postBlockItemList l ==
postBlockItem: %ParseTree -> %ParseForm
postBlockItem x ==
x:= postTran x
- x is ["Tuple",:l,[":",y,t]] and (and/[IDENTP x for x in l]) =>
+ x is ["%Comma",:l,[":",y,t]] and (and/[IDENTP x for x in l]) =>
[":",["LISTOF",:l,y],t]
x
@@ -218,11 +218,7 @@ postCategory u ==
postComma: %ParseTree -> %ParseForm
postComma u ==
- postTuple comma2Tuple u
-
-comma2Tuple: %ParseTree -> %ParseForm
-comma2Tuple u ==
- ["Tuple",:postFlatten(u,",")]
+ post%Comma ["%Comma",:postFlatten(u,",")]
postDef: %ParseTree -> %ParseForm
postDef t ==
@@ -310,17 +306,17 @@ postForm u ==
true=> op
$BOOT => op
GETL(op,'Led) or GETL(op,'Nud) or op = 'IN => op
- numOfArgs:= (argl' is [["Tuple",:l]] => #l; 1)
+ numOfArgs:= (argl' is [["%Comma",:l]] => #l; 1)
INTERNL("*",STRINGIMAGE numOfArgs,PNAME op)
[op',:argl']
op is ["Scripts",:.] => [:postTran op,:postTranList argl]
u:= postTranList u
- if u is [["Tuple",:.],:.] then
+ if u is [["%Comma",:.],:.] then
postError ['" ",:bright u,
'"is illegal because tuples cannot be applied_!",'%l,
'" Did you misuse infix dot?"]
u
- x is [.,["Tuple",:y]] => [first x,:y]
+ x is [.,["%Comma",:y]] => [first x,:y]
x
postQuote: %ParseTree -> %ParseForm
@@ -352,7 +348,7 @@ postTranScripts a ==
a is [",",:b] =>
("append"/[fn postTran y for y in b]) where
fn x ==
- x is ["Tuple",:y] => y
+ x is ["%Comma",:y] => y
[x]
[postTran a]
@@ -377,14 +373,14 @@ postJoin ["Join",a,:l] ==
if l is [b] and b is [name,:.] and MEMQ(name,'(ATTRIBUTE SIGNATURE)) then l
:= [["CATEGORY",b]]
al:=
- a is ["Tuple",:c] => c
+ a is ["%Comma",:c] => c
[a]
["Join",:al,:l]
postMapping: %ParseTree -> %ParseForm
postMapping u ==
u isnt ["->",source,target] => u
- ["Mapping",postTran target,:unTuple postTran source]
+ ["Mapping",postTran target,:unComma postTran source]
postOp: %ParseTree -> %ParseForm
postOp x ==
@@ -417,7 +413,7 @@ postCollect t ==
finish(constructOp,itl,y) where
finish(op,itl,y) ==
y is [":",a] => ["REDUCE","append",0,[op,:itl,a]]
- y is ["Tuple",:l] =>
+ y is ["%Comma",:l] =>
newBody:=
or/[x is [":",y] for x in l] => postMakeCons l
or/[x is ["SEGMENT",:.] for x in l] => tuple2List l
@@ -452,7 +448,7 @@ postIn arg ==
postInSeq: %ParseTree -> %ParseForm
postInSeq seq ==
seq is ["SEGMENT",p,q] => postTranSegment(p,q)
- seq is ["Tuple",:l] => tuple2List l
+ seq is ["%Comma",:l] => tuple2List l
postTran seq
postTranSegment: (%ParseTree, %ParseTree) -> %ParseForm
@@ -531,15 +527,15 @@ postType: %ParseTree -> %ParseForm
postType typ ==
typ is ["->",source,target] =>
source="constant" => [[postTran target],"constant"]
- [["Mapping",postTran target,:unTuple postTran source]]
+ [["Mapping",postTran target,:unComma postTran source]]
typ is ["->",target] => [["Mapping",postTran target]]
[postTran typ]
-postTuple: %ParseTree -> %ParseForm
-postTuple u ==
- u is ["Tuple"] => u
- u is ["Tuple",:l,a] => (["Tuple",:postTranList rest u])
---u is ["Tuple",:l,a] => (--a:= postTran a; ["Tuple",:postTranList rest u])
+post%Comma: %ParseTree -> %ParseForm
+post%Comma u ==
+ u is ["%Comma"] => u
+ u is ["%Comma",:l,a] => (["%Comma",:postTranList rest u])
+--u is ["%Comma",:l,a] => (--a:= postTran a; ["%Comma",:postTranList rest u])
--RDJ: don't understand need for above statement that is commented out
postWhere: %ParseTree -> %ParseForm
@@ -590,9 +586,9 @@ isPackageType: %ParseForm -> %Boolean
isPackageType x ==
not CONTAINED("$",x)
-unTuple: %ParseForm -> %ParseForm
-unTuple x ==
- x is ["Tuple",:y] => y
+unComma: %ParseForm -> %ParseForm
+unComma x ==
+ x is ["%Comma",:y] => y
[x]
--% `^='
@@ -636,6 +632,6 @@ for x in [["with", :function postWith],_
["->", :function postMapping],_
["=>", :function postExit],_
["^=", :function postBootNotEqual],_
- ["Tuple", :function postTuple]] repeat
+ ["%Comma", :function post%Comma]] repeat
MAKEPROP(first x, "postTran", rest x)
diff --git a/src/interp/trace.boot b/src/interp/trace.boot
index d843d10f..f52892bb 100644
--- a/src/interp/trace.boot
+++ b/src/interp/trace.boot
@@ -75,7 +75,7 @@ $lastUntraced := NIL
trace l == traceSpad2Cmd l
traceSpad2Cmd l ==
- if l is ["Tuple", l1] then l := l1
+ if l is ["%Comma", l1] then l := l1
$mapSubNameAlist:= getMapSubNames(l)
trace1 augmentTraceNames(l,$mapSubNameAlist)
traceReply()
diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot
index 84476bc9..bcbf2bda 100644
--- a/src/interp/wi1.boot
+++ b/src/interp/wi1.boot
@@ -540,7 +540,7 @@ compSetq1(oform,val,m,E) ==
compSetq(["LET",x,val],m,E')
form is [op,:l] =>
op="CONS" => setqMultiple(uncons form,val,m,E)
- op="Tuple" => setqMultiple(l,val,m,E)
+ op="%Comma" => setqMultiple(l,val,m,E)
setqSetelt(oform,form,val,m,E)
setqSetelt(oform,[v,:s],val,m,E) ==
@@ -596,7 +596,7 @@ setqSingle(id,val,m,E) ==
setqMultiple(nameList,val,m,e) ==
val is ["CONS",:.] and m=$NoValueMode =>
setqMultipleExplicit(nameList,uncons val,m,e)
- val is ["Tuple",:l] and m=$NoValueMode => setqMultipleExplicit(nameList,l,m,e)
+ val is ["%Comma",:l] and m=$NoValueMode => setqMultipleExplicit(nameList,l,m,e)
--1. create a gensym, %add to local environment, compile and assign rhs
g:= genVariable()
e:= addBinding(g,nil,e)
diff --git a/src/testsuite/compiler/aw-420.spad b/src/testsuite/compiler/aw-420.spad
new file mode 100644
index 00000000..847416ea
--- /dev/null
+++ b/src/testsuite/compiler/aw-420.spad
@@ -0,0 +1,8 @@
+)abbrev domain MOO Moo
+Moo(): Public == Private where
+ Public ==> with
+ coerce: Tuple Type -> %
+ Private ==> add
+ Rep == Tuple Type
+ coerce(x: Tuple Type) == per x
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-07 22:05:24 +0000