aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authorGabriel Dos Reis <gdr@axiomatics.org>2016-01-12 20:59:14 -0800
committerGabriel Dos Reis <gdr@axiomatics.org>2016-01-12 20:59:14 -0800
commite27fcd9e3bcb44ae147bbea76abaeba4e3876b89 (patch)
tree4dbc4a71bb51a8c2615c42fcd89a632b41cf2372 /src/interp
parent3103b372fce33f563a2a96ec1876365e2d7a3668 (diff)
downloadopen-axiom-e27fcd9e3bcb44ae147bbea76abaeba4e3876b89.tar.gz
Share more code between various parts of the compiler.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/c-util.boot10
-rw-r--r--src/interp/database.boot19
-rw-r--r--src/interp/define.boot6
3 files changed, 29 insertions, 6 deletions
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 9e56bb12..cd030a21 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -51,6 +51,8 @@ module c_-util where
currentDB: %Env -> %Maybe %Database
-- functor data manipulation
dbInfovec: %Symbol -> %Maybe %FunctorData
+ makeDefaultPackageParameters: %Database -> %List %Symbol
+ makeDefaultPackageAbbreviation: %Database -> %Symbol
--% Accessors of domain and category objects
@@ -235,6 +237,14 @@ $SetCategory ==
--%
+makeDefaultPackageParameters db ==
+ parms := dbConstructorForm(db).args
+ dollar := first setDifference('(S A B C D E F G H I),parms)
+ [dollar,:parms]
+
+makeDefaultPackageAbbreviation db ==
+ makeSymbol strconc(symbolName dbAbbreviation db,'"-")
+
dbInfovec name ==
getConstructorKindFromDB name is "category" => nil
loadLibIfNotLoaded(name)
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 01034700..aa460332 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -808,12 +808,18 @@ makeInitialDB [form,kind,abbrev,srcfile] ==
dbSourceFile(db) := srcfile
setAutoLoadProperty form.op
+makeDefaultPackageForm db ==
+ [makeDefaultPackageName symbolName dbConstructor db,
+ :makeDefaultPackageParameters db]
+
printInitdbInfo(path,dbfile) == main(path,dbfile) where
main(path,dbfile) ==
for x in parseSpadFile path repeat
- x is ['DEF,lhs,:.] => fn(lhs,path,dbfile)
- x is ["where",['DEF,lhs,:.],:.] => fn(lhs,path,dbfile)
- fn(lhs,path,dbfile) ==
+ x is ['DEF,lhs,.,rhs] =>
+ fn(lhs,rhs,fileNameString path,dbfile)
+ x is ["where",['DEF,lhs,.,rhs],:.] =>
+ fn(lhs,rhs,fileNameString path,dbfile)
+ fn(lhs,rhs,path,dbfile) ==
if lhs isnt [.,:.] then lhs := [lhs]
db := constructorDB lhs.op
db = nil => nil
@@ -822,6 +828,13 @@ printInitdbInfo(path,dbfile) == main(path,dbfile) where
data := [[lhs.op,:args],dbConstructorKind db,dbAbbreviation db,path]
prettyPrint(['makeInitialDB,quote data],dbfile)
writeNewline dbfile
+ -- If this is a category with defaults, write out the data for
+ -- associated package.
+ dbConstructorKind db isnt 'category or rhs isnt ['add,:.] => nil
+ data := [makeDefaultPackageForm db,'package,
+ makeDefaultPackageAbbreviation db,path]
+ prettyPrint(['makeInitialDB,quote data],dbfile)
+ writeNewline dbfile
printAllInitdbInfo(srcdir,dbfile) ==
paths := DIRECTORY strconc(ensureTrailingSlash srcdir,'"*.spad")
diff --git a/src/interp/define.boot b/src/interp/define.boot
index de919848..a1c1765f 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1023,14 +1023,14 @@ mkCategoryPackage(db,cat,def,e) ==
[op,:argl] := dbConstructorForm db
packageName:= makeDefaultPackageName symbolName op
dbConstructorDefault(db) := packageName
- packageAbb := makeSymbol strconc(symbolName dbAbbreviation db,'"-")
+ packageAbb := makeDefaultPackageAbbreviation db
$options:local := []
-- This stops the next line from becoming confused
abbreviationsSpad2Cmd ['package,packageAbb,packageName]
-- This is a little odd, but the parser insists on calling
-- domains, rather than packages
- nameForDollar := first setDifference('(S A B C D E F G H I),argl)
- packageArgl := [nameForDollar,:argl]
+ packageArgl := makeDefaultPackageParameters db
+ nameForDollar := first packageArgl
capsuleDefAlist := fn(def,nil) where fn(x,oplist) ==
x isnt [.,:.] => oplist
x is ['DEF,y,:.] => [opOf y,:oplist]