diff options
| -rw-r--r-- | src/boot/tokens.boot | 1 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 10 | ||||
| -rw-r--r-- | src/interp/database.boot | 19 | ||||
| -rw-r--r-- | src/interp/define.boot | 6 |
4 files changed, 30 insertions, 6 deletions
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index c2d0c578..3a444433 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -283,6 +283,7 @@ for i in [ _ ["false", 'NIL] , _ ["fifth", "FIFTH"] , _ ["first", "CAR"] , _ + ["fileNameString", "FILE-NAMESTRING" ] , _ ["filePath", "PATHNAME"] , _ ["filePath?", "PATHNAMEP"] , _ ["filePathDirectory", "PATHNAME-DIRECTORY"] , _ 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] |