aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-11-28 03:49:34 +0000
committerdos-reis <gdr@axiomatics.org>2011-11-28 03:49:34 +0000
commitedde1ab05981cf948483ba0407e3d8aa466f56c2 (patch)
treecd1f136dc9d95a72acede7cf242a84a3b3d0d3eb /src
parentcc6921eeffcee91d76d322303884e808e4851345 (diff)
downloadopen-axiom-edde1ab05981cf948483ba0407e3d8aa466f56c2.tar.gz
* interp/database.boot (dbDefaultPackage?): New.
* interp/define.boot (compDefine1): Avoid encodeItem when symbolName is meant. (mkRepititionAssoc): Move from functor.boot (encodeItem): Likewise. (getCaps): Likewise. Tidy. (encodeFunctionName): Likewise.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog10
-rw-r--r--src/interp/database.boot4
-rw-r--r--src/interp/define.boot41
-rw-r--r--src/interp/functor.boot34
4 files changed, 53 insertions, 36 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 93e454fe..cbe923fa 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,15 @@
2011-11-27 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/database.boot (dbDefaultPackage?): New.
+ * interp/define.boot (compDefine1): Avoid encodeItem when
+ symbolName is meant.
+ (mkRepititionAssoc): Move from functor.boot
+ (encodeItem): Likewise.
+ (getCaps): Likewise. Tidy.
+ (encodeFunctionName): Likewise.
+
+2011-11-27 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/define.boot (assignCapsuleFunctionSlot): Slot original
signature too.
* interp/nruncomp.boot (genDeltaEntry): Likewise.
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 648ce919..e4c71bf6 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -815,3 +815,7 @@ loadDBIfNecessary db ==
ctor := dbConstructor db
dbLoaded? db => db
loadDB db
+
+++ Return true if this DB is for a category default package.
+macro dbDefaultPackage? db ==
+ isDefaultPackageName dbConstructor db
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 3207d072..7d60c85c 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -819,7 +819,7 @@ compDefine1(form,m,e) ==
$form = nil => stackAndThrow ['"bad == form ",form]
db := constructorDB $op
newPrefix :=
- $prefix => makeSymbol strconc(encodeItem $prefix,'",",encodeItem $op)
+ $prefix => makeSymbol strconc(symbolName $prefix,'",",symbolName $op)
dbAbbreviation db
compDefineCapsuleFunction(db,form,m,e,newPrefix,$formalArgList)
@@ -1810,6 +1810,41 @@ processDefinitionParameters(form,signature,e) ==
e := addDomain(domain,e)
e
+mkRepititionAssoc l ==
+ mkRepfun(l,1) where
+ mkRepfun(l,n) ==
+ null l => nil
+ l is [x] => [[n,:x]]
+ l is [x, =x,:l'] => mkRepfun(rest l,n+1)
+ [[n,:first l],:mkRepfun(rest l,1)]
+
+encodeItem x ==
+ x is [op,:argl] => getCaps op
+ ident? x => symbolName x
+ STRINGIMAGE x
+
+getCaps x ==
+ s := symbolName x
+ clist := [c for i in 0..maxIndex s | upperCase? (c := stringChar(s,i))]
+ clist = nil => '"__"
+ strconc/[charString first clist,
+ :[charString charDowncase u for u in rest clist]]
+
+encodeFunctionName(db,fun,signature,count) ==
+ if dbDefaultPackage? db then
+ signature := substitute('$,first dbParameters db,signature)
+ reducedSig := mkRepititionAssoc [:signature.source,signature.target]
+ encodedSig :=
+ (strconc/[encodedPair for [n,:x] in reducedSig]) where
+ encodedPair() ==
+ n=1 => encodeItem x
+ strconc(toString n,encodeItem x)
+ encodedName:= makeSymbol strconc(symbolName dbAbbreviation db,'";",
+ symbolName fun,'";",encodedSig,'";",toString count)
+ dbCapsuleDefinitions(db) :=
+ [[encodedName,signature],:dbCapsuleDefinitions db]
+ encodedName
+
compDefineCapsuleFunction(db,df is ['DEF,form,signature,body],
m,$e,$prefix,$formalArgList) ==
e := $e
@@ -1861,8 +1896,8 @@ compDefineCapsuleFunction(db,df is ['DEF,form,signature,body],
-- object if the operation is both local and exported.
if or/[mm.mmDC is '$ for mm in get($op,'modemap,e)] then
userError ['"%b",$op,'"%d",'" is local and exported"]
- makeSymbol strconc(encodeItem $prefix,'";",encodeItem $op)
- encodeFunctionName(db,$op,signature,'";",$suffix)
+ makeSymbol strconc(symbolName $prefix,'";",symbolName $op)
+ encodeFunctionName(db,$op,signature,$suffix)
if n ~= nil and not $insideCategoryPackageIfTrue then
updateCapsuleDirectory([n,:op'],pred)
-- Let the backend know about this function's type
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 5a71aaf7..26ffe49b 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -757,27 +757,13 @@ mkOperatorEntry(opSig is [op,sig,:flag],pred,count) ==
--% Code for encoding function names inside package or domain
-encodeFunctionName(db,fun,signature,sep,count) ==
- signature':= MSUBST("$",dbConstructorForm db,signature)
- reducedSig:= mkRepititionAssoc [:rest signature',first signature']
- encodedSig:=
- (strconc/[encodedPair for [n,:x] in reducedSig]) where
- encodedPair() ==
- n=1 => encodeItem x
- strconc(toString n,encodeItem x)
- encodedName:= makeSymbol strconc(symbolName dbAbbreviation db,'";",
- encodeItem fun,'";",encodedSig,sep,toString count)
- dbCapsuleDefinitions(db) :=
- [[encodedName,signature'],:dbCapsuleDefinitions db]
- encodedName
-
++ Return the linkage name of the local operation named `op'.
encodeLocalFunctionName op ==
prefix :=
$prefix => $prefix
$functorForm => symbolName dbAbbreviation constructorDB $functorForm.op
stackAndThrow('"There is no context for local function %1b",[op])
- makeSymbol strconc(prefix,'";",encodeItem op)
+ makeSymbol strconc(prefix,'";",symbolName op)
splitEncodedFunctionName(encodedName, sep) ==
-- [encodedPackage, encodedItem, encodedSig, sequenceNo] or nil
@@ -795,21 +781,3 @@ splitEncodedFunctionName(encodedName, sep) ==
s4 := subString(encodedName, p3+1)
[s1, s2, s3, s4]
-mkRepititionAssoc l ==
- mkRepfun(l,1) where
- mkRepfun(l,n) ==
- null l => nil
- l is [x] => [[n,:x]]
- l is [x, =x,:l'] => mkRepfun(rest l,n+1)
- [[n,:first l],:mkRepfun(rest l,1)]
-
-encodeItem x ==
- x is [op,:argl] => getCaps op
- ident? x => symbolName x
- STRINGIMAGE x
-
-getCaps x ==
- s:= STRINGIMAGE x
- clist:= [c for i in 0..maxIndex s | upperCase? (c:= s.i)]
- null clist => '"__"
- strconc/[first clist,:[L_-CASE u for u in rest clist]]