aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog6
-rw-r--r--src/interp/br-data.boot4
-rw-r--r--src/interp/br-saturn.boot2
-rw-r--r--src/interp/buildom.boot4
-rw-r--r--src/interp/c-util.boot2
-rw-r--r--src/interp/cattable.boot2
-rw-r--r--src/interp/compiler.boot5
-rw-r--r--src/interp/define.boot6
-rw-r--r--src/interp/functor.boot2
-rw-r--r--src/interp/g-util.boot19
-rw-r--r--src/interp/i-map.boot2
-rw-r--r--src/interp/sys-driver.boot1
12 files changed, 40 insertions, 15 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index f1c3cafa..1b7689a5 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
+2013-07-01 Gabriel Dos Reis <gdr@integrable-solutions.net>
+
+ * interp/g-util.boot (relativeDirname): New. Abstract differences
+ between Common Lisp semantics and traditional semantics (GCL).
+ * interp/c-util.boot (moveLibdirByCopy): Use it.
+
2013-06-30 Gabriel Dos Reis <gdr@integrable-solutions.net>
* lisp/core.lisp.in (maxIndex): Provide function definition for
diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot
index 3c44428f..acdd25da 100644
--- a/src/interp/br-data.boot
+++ b/src/interp/br-data.boot
@@ -127,7 +127,7 @@ buildLibdbString [x,:u] ==
libConstructorSig [conname,:argl] ==
[[.,:sig],:.] := substitute("T","T$",getConstructorModemap conname)
- formals := take(#argl,$FormalMapVariableList)
+ formals := formalVarList #argl
sig := applySubst(pairList($TriangleVariableList,formals),sig)
keys := [g(f,sig,i) for f in formals for i in 1..] where
g(x,u,i) == --does x appear in any but i-th element of u?
@@ -636,7 +636,7 @@ transKCatAlist(conform,domname,s) == main where
--no domname, so look for special argument combinations
acc := nil
KDR conform =>
- farglist := take(#rest conform,$FormalMapVariableList)
+ farglist := formalVarList #rest conform
for pair in s repeat --pair has form [con,[conargs,:pred],...]]
leftForm := getConstructorForm first pair
for (ap := [args,:pred]) in rest pair repeat
diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot
index 6f55c992..9559cee7 100644
--- a/src/interp/br-saturn.boot
+++ b/src/interp/br-saturn.boot
@@ -1235,7 +1235,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate,
--RDJ: this next line is necessary until compiler bug is fixed
--that forgets to substitute #variables for t#variables;
--check the signature for SegmentExpansionCategory, e.g.
- tvarlist := take(# $conargs,$TriangleVariableList)
+ tvarlist := tvarList # $conargs
$signature := applySubst(pairList(tvarlist,$FormalMapVariableList),$signature)
$sig :=
which = '"attribute" or which = '"constructor" => sig
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index 8ecf95f6..6858bfaf 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -589,7 +589,7 @@ mkMappingFunList(nam,mapForm,e) ==
++ Build an inline function for constructing records of length `n'.
mkRecordFun n ==
- args := take(n,$FormalMapVariableList)
+ args := formalVarList n
op :=
n < 2 => '%list
n = 2 => '%pair
@@ -611,7 +611,7 @@ eltRecordFun(n,i) ==
["XLAM",["#1","#2"],formalRecordField(n,i)]
seteltRecordFun(n,i) ==
- args := take(3,$FormalMapVariableList)
+ args := formalVarList 3
field := formalRecordField(n,i)
body :=
n > 2 => ['%store,field,"#3"]
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index cf5b8a5a..e91871b4 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1801,7 +1801,7 @@ cleanParameterList! parms ==
moveLibdirByCopy lib ==
checkMkdir libDirname lib
for src in directoryEntries libStationaryDirname lib repeat
- dst := makeFilePath(directory <- [&RELATIVE, libDirname lib],
+ dst := makeFilePath(directory <- relativeDirname libDirname lib,
name <- filePathName src, type <- filePathType src)
copyFile(filePathString src,filePathString dst)
removeFile libStationaryDirname lib = 0 => libDirname lib
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index 7cb1dc0d..21e61c26 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -381,7 +381,7 @@ categoryParts(conform,category,:options) == main where
if addCtor? then
res := [listSort(function GLESSEQP,$conslist),:res]
if getConstructorKindFromDB conname is "category" then
- tvl := take(#rest conform,$TriangleVariableList)
+ tvl := tvarList #rest conform
res := applySubst(pairList(tvl,$FormalMapVariableList),res)
res
build(item,pred) ==
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index e070e214..e9a97c6f 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -334,7 +334,8 @@ compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) ==
return [['%function,x],m,e]
x is ["+->",:.] => compLambda(x,m,oldE)
if string? x then x := makeSymbol x
- for m in sl for v in (vl:= take(#sl,$FormalMapVariableList)) repeat
+ vl := formalVarList #sl
+ for m in sl for v in vl repeat
[.,.,e]:= compMakeDeclaration(v,m,e)
(vl ~= nil) and not hasFormalMapVariable(x, vl) =>
[u,.,.] := comp([x,:vl],m',e) or return nil
@@ -1356,7 +1357,7 @@ compHas(pred is ["has",a,b],m,e) ==
compHasFormat(db,pred is ["has",olda,b],e) ==
argl := $form.args
- formals := take(#argl,$FormalMapVariableList)
+ formals := formalVarList #argl
a := applySubst(pairList(formals,argl),olda)
[a,.,e] := comp(a,$EmptyMode,e) or return nil
a := applySubst(pairList(argl,formals),a)
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 187c3768..580b22a8 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -673,7 +673,7 @@ explodeIfs x == main where --called by getParentsFor
getParentsFor db ==
constructorForm := dbConstructorForm db
n := #constructorForm.args
- s1 := pairList(take(n,$TriangleVariableList),$FormalMapVariableList)
+ s1 := pairList($TriangleVariableList,formalVarList n)
s2 := pairList($FormalMapVariableList,constructorForm.args)
[:explodeIfs applySubst(s2,applySubst(s1,x)) for x in folks dbCategory db]
@@ -998,7 +998,7 @@ compDefineCategory1(db,df is ['DEF,form,sig,body],m,e,fal) ==
makeCategoryPredicates db ==
n := dbArity db
- sl := pairList(take(n,$TriangleVariableList),take(n,rest $FormalMapVariableList))
+ sl := pairList($TriangleVariableList,formalVarList n)
fn(dbCategory db,sl,nil) where
fn(u,sl,pl) ==
u is ['Join,:.,a] => fn(a,sl,pl)
@@ -1132,7 +1132,7 @@ compDefineCategory2(db,form,signature,body,m,e,$formalArgList) ==
-- 3. replace arguments by $1,..., substitute into body,
-- and introduce declarations into environment
- sargl := take(# form.args, $TriangleVariableList)
+ sargl := tvarList #form.args
$functorForm:= $form:= [$op,:sargl]
$formalArgList:= [:sargl,:$formalArgList]
formalBody := dbSubstituteFormals(db,body)
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 5aac19c4..ec61ffd0 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -354,7 +354,7 @@ DescendCodeAdd(db,base,flag) ==
modemap := get(base.op,'modemap,$CategoryFrame)
modemap = nil =>
if getmode(base.op,$e) is ["Mapping",target,:formalArgModes]
- then formalArgs := take(#formalArgModes,$FormalMapVariableList)
+ then formalArgs := formalVarList #formalArgModes
--argument substitution if parameterized?
else keyedSystemError("S2OR0001",[base.op])
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 271279ec..3115c8f7 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -1,6 +1,6 @@
-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2012, Gabriel Dos Reis.
+-- Copyright (C) 2007-2013, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -48,6 +48,8 @@ module g_-util where
spliceSeqArgs: %List %Code -> %Code
mkSeq: %List %Code -> %Code
usesVariable?: (%Code,%Symbol) -> %Boolean
+ formalVarList: %Short -> %List %Symbol
+ tvarList: %Short -> %List %Symbol
--%
@@ -262,6 +264,11 @@ isSharpVarWithNum x ==
ok := digit? d => c := 10*c + DIG2FIX d
if ok then c else nil
+formalVarList n ==
+ take(n,$FormalMapVariableList)
+
+tvarList n ==
+ take(n,$TriangleVariableList)
mkBuffer v ==
[copyVector v,:#v]
@@ -294,6 +301,16 @@ bufferToVector buf ==
v
+++ Return the name of a relative path for a directory
+++ given by the string `s', GCL does not implement
+++ Common Lisp semantics, so we have a special version for it.
+relativeDirname s ==
+)if %hasFeature &GCL and not %hasFeature &COMMON_-LISP
+ [s]
+)else
+ [&RELATIVE,s]
+)endif
+
--% Sub-domains information handlers
++ If `dom' is a subdomain, return its immediate super-domain.
diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot
index ba4e1277..89eefa93 100644
--- a/src/interp/i-map.boot
+++ b/src/interp/i-map.boot
@@ -302,7 +302,7 @@ makePattern(args,pred) ==
pred is ["=","#1",n] => n
addPatternPred("#1",pred)
u:= canMakeTuple(nargs,pred) => u
- addPatternPred(["tuple",:take(nargs,$FormalMapVariableList)],pred)
+ addPatternPred(["tuple",:formalVarList nargs],pred)
addPatternPred(arg,pred) ==
pred=true => arg
diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot
index 6933a27f..275d14af 100644
--- a/src/interp/sys-driver.boot
+++ b/src/interp/sys-driver.boot
@@ -146,6 +146,7 @@ openDatabases() ==
restart() ==
)if %hasFeature KEYWORD::GCL
SYSTEM::GBC_-TIME 0
+ SYSTEM::USE_-FAST_-LINK false
)endif
if $openServerIfTrue then
os := openServer $SpadServerName