From edde1ab05981cf948483ba0407e3d8aa466f56c2 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Mon, 28 Nov 2011 03:49:34 +0000
Subject: 	* 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.

---
 src/interp/database.boot |  4 ++++
 src/interp/define.boot   | 41 ++++++++++++++++++++++++++++++++++++++---
 src/interp/functor.boot  | 34 +---------------------------------
 3 files changed, 43 insertions(+), 36 deletions(-)

(limited to 'src/interp')

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]]
-- 
cgit v1.2.3