aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog25
-rw-r--r--src/interp/buildom.boot13
-rw-r--r--src/interp/c-util.boot21
-rw-r--r--src/interp/compiler.boot25
-rw-r--r--src/interp/define.boot48
-rw-r--r--src/interp/modemap.boot15
-rw-r--r--src/interp/pspad2.boot2
-rw-r--r--src/interp/sys-globals.boot6
8 files changed, 123 insertions, 32 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 83028dec..c52458b5 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,28 @@
+2008-01-27 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ Fix SF/1872551
+ * interp/c-util.boot (dollarIfRepHack): New.
+ (RepIfRepHack): Likewise.
+ (substituteDollarIfRepHack): Likewise.
+ (isSubset): Dollar is subset of Rep only in old semantics.
+ * interp/buildom.boot (mkMappingFunList): Substitute dollar for
+ Rep only when appropriate.
+ (mkRecordFunList): Likewise.
+ (mkNewUnionFunList): Likewise.
+ (mkUnionFunList): Likewise.
+ * interp/compiler.boot (compNoStacking): Likewise.
+ (compNoStacking1): Likewise.
+ (getConstructorFormOfMode): Likewise.
+ (isUnionMode): Likewise.
+ (coerce): Likewise.
+ (coerceSubset): Likewise.
+ * interp/modemap.boot (addModemap1): Likewise.
+ (isSuperDomain): Likewise.
+ * interp/define.boot (maybeInsertViewMorphisms): New.
+ (compCapsule): Use it.
+ (compCategoryItem): Don't allow exports of rep and per.
+ * interp/sys-globals.boot ($useRepresentationHack): New.
+
2008-01-26 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/database.boot: Tidy uses of $EmptyEnvironment.
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index 228ef863..cacced1b 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -270,7 +270,7 @@ mkMappingFunList(nam,mapForm,e) ==
sigFunAlist:=
[["_=",[["Boolean"],nam ,nam],["ELT",dc,6]],
["coerce",[$OutputForm,nam],["ELT",dc,7]]]
- [substitute(nam,dc,substitute("$",'Rep,sigFunAlist)),e]
+ [substitute(nam,dc,substituteDollarIfRepHack sigFunAlist),e]
mkRecordFunList(nam,["Record",:Alist],e) ==
len:= #Alist
@@ -294,11 +294,11 @@ mkRecordFunList(nam,["Record",:Alist],e) ==
for i in 0.. for [.,a,A] in Alist],:
[["copy",[nam,nam],["XLAM",["$1"],["RECORDCOPY",
"$1",len]]]]]
- [substitute(nam,dc,substitute("$","Rep",sigFunAlist)),e]
+ [substitute(nam,dc,substituteDollarIfRepHack sigFunAlist),e]
mkNewUnionFunList(name,form is ["Union",:listOfEntries],e) ==
dc := name
- if name = "Rep" then name := "$"
+ m := dollarIfRepHack name
--2. create coercions from subtypes to subUnion
cList:=
[["_=",[["Boolean"],name ,name],["ELT",dc,6]],
@@ -367,9 +367,6 @@ mkUnionFunList(op,form is ["Union",:listOfEntries],e) ==
p is ["EQCAR",x,n] =>
["XLAM",["#1"],["QEQCAR",x,n]]
["XLAM",["#1"],p]
- op:=
- op="Rep" => "$"
- op
- cList:= substitute(op,g,cList)
+ cList:= substitute(dollarIfRepHack op,g,cList)
[cList,e]
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 05a65bb7..d0e4f037 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -35,6 +35,23 @@
import '"g-util"
)package "BOOT"
+++ If using old `Rep' definition semantics, return `$' when m is `Rep'.
+++ Otherwise, return `m'.
+dollarIfRepHack m ==
+ m = "Rep" and $useRepresentationHack => "$"
+ m
+
+++ The inverse of the above.
+RepIfRepHack m ==
+ m = "$" and $useRepresentationHack => "Rep"
+ m
+
+++ If using old `Rep' definition semantics, return `$' is m is `Rep'.
+-- ??? Eventually this and the above should be merged and/or removed.
+substituteDollarIfRepHack m ==
+ $useRepresentationHack => substitute("$","Rep",m)
+ m
+
--% Debugging Functions
--CONTINUE() == continue()
@@ -340,7 +357,7 @@ isSomeDomainVariable s ==
IDENTP s and #(x:= PNAME s)>2 and x.(0)="#" and x.(1)="#"
isSubset(x,y,e) ==
- x="$" and y="Rep" or x=y or
+ ($useRepresentationHack and x="$" and y="Rep") or x=y or
LASSOC(opOf x,get(opOf y,"Subsets",e) or GETL(opOf y,"Subsets")) or
LASSOC(opOf x,get(opOf y,"SubDomain",e)) or
opOf(y)='Type or opOf(y)='Object
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 1fba5482..ed7554cb 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -104,14 +104,18 @@ comp(x,m,e) ==
compNoStacking(x,m,e) ==
T:= comp2(x,m,e) =>
- (m=$EmptyMode and T.mode=$Representation => [T.expr,"$",T.env]; T)
- --$Representation is bound in compDefineFunctor, set by doIt
- --this hack says that when something is undeclared, $ is
- --preferred to the underlying representation -- RDJ 9/12/83
+ $useRepresentationHack and m=$EmptyMode and T.mode=$Representation =>
+ [T.expr,"$",T.env]
+ T
+ --$Representation is bound in compDefineFunctor, set by doIt
+ --this hack says that when something is undeclared, $ is
+ --preferred to the underlying representation -- RDJ 9/12/83
+ --Now that `per' and `rep' are built in, we do the above
+ --hack only when `Rep' is defined the old way. -- gdr 2008/01/26
compNoStacking1(x,m,e,$compStack)
compNoStacking1(x,m,e,$compStack) ==
- u:= get(if m="$" then "Rep" else m,"value",e) =>
+ u:= get(RepIfRepHack m,"value",e) =>
(T:= comp2(x,u.expr,e) => [T.expr,m,T.env]; nil)
nil
@@ -511,7 +515,7 @@ checkCallingConvention(sigs,nargs) ==
getConstructorFormOfMode(m,e) ==
isConstructorForm m => m
- if m="$" then m:= "Rep"
+ m := RepIfRepHack m
atom m and get(m,"value",e) is [v,:.] =>
isConstructorForm v => v
@@ -1038,7 +1042,7 @@ getUnionMode(x,e) ==
isUnionMode(m,e) ==
m is ["Union",:.] => m
(m':= getmode(m,e)) is ["Mapping",["UnionCategory",:.]] => CADR m'
- v:= get(if m="$" then "Rep" else m,"value",e) =>
+ v:= get(RepIfRepHack m,"value",e) =>
(v.expr is ["Union",:.] => v.expr; nil)
nil
@@ -1180,7 +1184,8 @@ coerce(T,m) ==
$InteractiveMode =>
keyedSystemError("S2GE0016",['"coerce",
'"function coerce called from the interpreter."])
- rplac(CADR T,substitute("$",$Rep,CADR T))
+ if $useRepresentationHack then
+ rplac(CADR T,substitute("$",$Rep,CADR T))
T':= coerceEasy(T,m) => T'
T':= coerceSubset(T,m) => T'
T':= coerceHard(T,m) => T'
@@ -1204,7 +1209,7 @@ coerceEasy(T,m) ==
[T.expr,m,T.env]
coerceSubset([x,m,e],m') ==
- isSubset(m,m',e) or m="Rep" and m'="$" => [x,m',e]
+ isSubset(m,m',e) => [x,m',e]
m is ['SubDomain,=m',:.] => [x,m',e]
(pred:= LASSOC(opOf m',get(opOf m,'SubDomain,e))) and INTEGERP x and
-- obviously this is temporary
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 945b4cc4..0192427e 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -49,6 +49,46 @@ compDefine(form,m,e) ==
$packagesUsed: local
result:= compDefine1(form,m,e)
result
+
+++ We are about to process the body of a capsule. If the capsule defines
+++ `Rep' as a constant, then implicitly insert the view morphisms
+++ per: Rep -> %
+++ rep: % -> Rep
+++ as local functions. Note that we do not declare them as macros.
+maybeInsertViewMorphisms body ==
+ domainRep := nil
+ before := nil
+
+ while null domainRep for [stmt,:after] in tails body repeat
+ stmt isnt ["DEF",["Rep",:args],sig,nils,domainRep] =>
+ before := [stmt,:before]
+ if args then
+ userError [:bright '"Rep",'"cannot take arguments"]
+ if first sig then
+ userError [:bright '"Rep", "cannot have type sepcification"]
+
+ null domainRep => body
+ -- Make sure we don't implicitly convert from `Rep' to `%'.
+ $useRepresentationHack := false
+ -- Reject user-defined view morphisms
+ for stmt in after repeat
+ stmt is ["DEF",["rep",:.],:.]
+ or stmt is ["DEF",["per",:.],:.] =>
+ -- ??? We may actually want to stop processing now.
+ stackSemanticError(['"Cannot define",:bright per],nil)
+
+ -- OK, insert synthetized view morphisms
+ g := GENSYM()
+ repMorphism := ["DEF",["rep",g],[domainRep,"$"],[nil,nil],
+ ["pretend",g,domainRep]]
+ perMorphism := ["DEF",["per",g],["$",domainRep],[nil,nil],
+ ["pretend",g,"$"]]
+
+ -- Trick the rest of the compiler into believing that
+ -- that `Rep' was defined the old way, for the purpose of lookup.
+ [:reverse before, ["LET","Rep",domainRep],
+ :[repMorphism,perMorphism],:after]
+
compDefine1(form,m,e) ==
$insideExpressionIfTrue: local:= false
@@ -1180,7 +1220,8 @@ compCapsule(['CAPSULE,:itemList],m,e) ==
$bootStrapMode = true =>
[bootStrapError($functorForm, _/EDITFILE),m,e]
$insideExpressionIfTrue: local:= false
- compCapsuleInner(itemList,m,addDomain('_$,e))
+ $useRepresentationHack := true
+ compCapsuleInner(maybeInsertViewMorphisms itemList,m,addDomain('_$,e))
compSubDomain(["SubDomain",domainForm,predicate],m,e) ==
$addFormLhs: local:= domainForm
@@ -1503,6 +1544,9 @@ compCategoryItem(x,predl) ==
["SIGNATURE",op,:sig]:= x
null atom op =>
for y in op repeat compCategoryItem(["SIGNATURE",y,:sig],predl)
+ op in '(per rep) =>
+ stackSemanticError(['"cannot export signature for", :bright op],nil)
+ nil
--4. branch on a single type or a signature %with source and target
PUSH(MKQ [rest x,pred],$sigList)
diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot
index 1cdfdd2c..f2ae0fc5 100644
--- a/src/interp/modemap.boot
+++ b/src/interp/modemap.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -160,11 +160,7 @@ addEltModemap(op,mc,sig,pred,fn,e) ==
addModemap1(op,mc,sig,pred,fn,e) ==
--mc is the "mode of computation"; fn the "implementation"
- if mc='Rep then
--- if fn is [kind,'Rep,.] and
- -- save old sig for NRUNTIME
--- (kind = 'ELT or kind = 'CONST) then fn:=[kind,'Rep,sig]
- sig:= substitute("$",'Rep,sig)
+ if mc="Rep" then sig := substituteDollarIfRepHack sig
currentProplist:= getProplist(op,e) or nil
newModemapList:=
mkNewModemapList(mc,sig,pred,fn,LASSOC('modemap,currentProplist),e,nil)
@@ -220,7 +216,8 @@ mergeModemap(entry is [[mc,:sig],[pred,:.],:.],modemapList,e) ==
isSuperDomain(domainForm,domainForm',e) ==
isSubset(domainForm',domainForm,e) => true
- domainForm='Rep and domainForm'="$" => true --regard $ as a subdomain of Rep
+ --regard $ as a subdomain of Rep, only if using old style Rep
+ domainForm='Rep and domainForm'="$" => $useRepresentationHack
LASSOC(opOf domainForm',get(domainForm,"SubDomain",e))
--substituteForRep(entry is [[mc,:sig],:.],curModemapList) ==
@@ -255,13 +252,13 @@ substituteCategoryArguments(argl,catform) ==
--operations are not being redefined.
augModemapsFromCategoryRep(domainName,repDefn,functorBody,categoryForm,e) ==
[fnAlist,e]:= evalAndSub(domainName,domainName,domainName,categoryForm,e)
- [repFnAlist,e]:= evalAndSub('Rep,'Rep,repDefn,getmode(repDefn,e),e)
+ [repFnAlist,e]:= evalAndSub("Rep","Rep",repDefn,getmode(repDefn,e),e)
catform:= (isCategory categoryForm => categoryForm.(0); categoryForm)
compilerMessage ["Adding ",domainName," modemaps"]
e:= putDomainsInScope(domainName,e)
$base:= 4
for [lhs:=[op,sig,:.],cond,fnsel] in fnAlist repeat
- u:=assoc(SUBST('Rep,domainName,lhs),repFnAlist)
+ u:=assoc(SUBST("Rep",domainName,lhs),repFnAlist)
u and not AMFCR_,redefinedList(op,functorBody) =>
fnsel':=CADDR u
e:= addModemap(op,domainName,sig,cond,fnsel',e)
diff --git a/src/interp/pspad2.boot b/src/interp/pspad2.boot
index fd19e4fd..fc1fba2a 100644
--- a/src/interp/pspad2.boot
+++ b/src/interp/pspad2.boot
@@ -111,7 +111,7 @@ formatDeftranRepper([op,a],SEQflag) ==
b := formatDeftran(b,SEQflag)
t := formatDeftran(t,SEQflag)
a := ["::",b,t]
- op = 'per and t = "$" or op = 'rep and t = 'Rep => a
+ op = "per" and t = "$" or op = "rep" and t = "Rep" => a
[op,a]
a is ['SEQ,:r] => ['SEQ,:[formatSeqRepper(op,x) for x in r]]
a is ['IF,p,b,c] =>
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index cc7242d2..777b890f 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -440,3 +440,9 @@ $compilingInputFile := false
++
$minivectorNames := []
+
+++ True if the input file uses old semantics of `Rep',
+++ e.g. implicit equivalent Rep <-> % with capsules.
+++ This semenatics is in effect only when `Rep' is defined
+++ through assignment.
+$useRepresentationHack := true
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 09:50:09 +0000