diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/ChangeLog | 6 | ||||
-rw-r--r-- | src/interp/br-data.boot | 4 | ||||
-rw-r--r-- | src/interp/br-saturn.boot | 2 | ||||
-rw-r--r-- | src/interp/buildom.boot | 4 | ||||
-rw-r--r-- | src/interp/c-util.boot | 2 | ||||
-rw-r--r-- | src/interp/cattable.boot | 2 | ||||
-rw-r--r-- | src/interp/compiler.boot | 5 | ||||
-rw-r--r-- | src/interp/define.boot | 6 | ||||
-rw-r--r-- | src/interp/functor.boot | 2 | ||||
-rw-r--r-- | src/interp/g-util.boot | 19 | ||||
-rw-r--r-- | src/interp/i-map.boot | 2 | ||||
-rw-r--r-- | src/interp/sys-driver.boot | 1 |
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 |