diff options
Diffstat (limited to 'src/boot/ast.boot')
| -rw-r--r-- | src/boot/ast.boot | 58 |
1 files changed, 29 insertions, 29 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 0f55e523..8de1ae5c 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -146,8 +146,8 @@ quote x == bfGenSymbol: () -> %Symbol bfGenSymbol()== - $GenVarCounter:=$GenVarCounter+1 - INTERN(CONCAT ('"bfVar#",STRINGIMAGE $GenVarCounter)) + $GenVarCounter := $GenVarCounter+1 + INTERN strconc('"bfVar#",STRINGIMAGE $GenVarCounter) bfColon: %Thing -> %List bfColon x== @@ -156,8 +156,8 @@ bfColon x== bfColonColon: (%Symbol,%Symbol) -> %Symbol bfColonColon(package, name) == %hasFeature KEYWORD::CLISP and package in '(EXT FFI) => - FIND_-SYMBOL(SYMBOL_-NAME name,package) - INTERN(SYMBOL_-NAME name, package) + FIND_-SYMBOL(PNAME name,package) + INTERN(PNAME name, package) bfSymbol: %Thing -> %Thing bfSymbol x== @@ -491,7 +491,7 @@ defSheepAndGoats(x)== argl = nil => opassoc := [[op,:body]] [opassoc,[],[]] - op1 := INTERN CONCAT(PNAME $op,'",",PNAME op) + op1 := INTERN strconc(PNAME $op,'",",PNAME op) opassoc := [[op,:op1]] defstack := [[op1,args,body]] [opassoc,defstack,[]] @@ -525,7 +525,7 @@ bfLET1(lhs,rhs) == l2 is ["PROGN",:.] => bfMKPROGN [l1,:rest l2] if IDENTP first l2 then l2 := [l2,:nil] bfMKPROGN [l1,:l2,name] - g := INTERN CONCAT('"LETTMP#",STRINGIMAGE $letGenVarCounter) + g := INTERN strconc('"LETTMP#",STRINGIMAGE $letGenVarCounter) $letGenVarCounter := $letGenVarCounter + 1 rhs1 := ['L%T,g,rhs] let1 := bfLET1(lhs,g) @@ -562,7 +562,7 @@ bfLET2(lhs,rhs) == lhs is ['APPEND,var1,var2] => patrev := bfISReverse(var2,var1) rev := ['REVERSE,rhs] - g := INTERN CONCAT('"LETTMP#", STRINGIMAGE $letGenVarCounter) + g := INTERN strconc('"LETTMP#", STRINGIMAGE $letGenVarCounter) $letGenVarCounter := $letGenVarCounter + 1 l2 := bfLET2(patrev,g) if cons? l2 and atom first l2 then l2 := [l2,:nil] @@ -645,7 +645,7 @@ bfIS1(lhs,rhs) == bfAND [bfIS1(lhs,d),bfMKPROGN [l,'T]] rhs is ["EQUAL",a] => bfQ(lhs,a) cons? lhs => - g := INTERN CONCAT('"ISTMP#",STRINGIMAGE $isGenVarCounter) + g := INTERN strconc('"ISTMP#",STRINGIMAGE $isGenVarCounter) $isGenVarCounter := $isGenVarCounter + 1 bfMKPROGN [['L%T,g,lhs],bfIS1(g,rhs)] rhs is ['CONS,a,b] => @@ -662,7 +662,7 @@ bfIS1(lhs,rhs) == bfAND [['CONSP,lhs],a1,b1] rhs is ['APPEND,a,b] => patrev := bfISReverse(b,a) - g := INTERN CONCAT('"ISTMP#",STRINGIMAGE $isGenVarCounter) + g := INTERN strconc('"ISTMP#",STRINGIMAGE $isGenVarCounter) $isGenVarCounter := $isGenVarCounter + 1 rev := bfAND [['CONSP,lhs],['PROGN,['L%T,g,['REVERSE,lhs]],'T]] l2 := bfIS1(g,patrev) @@ -787,7 +787,7 @@ bfDef1 [op,args,body] == shoeLAM (op,args,control,body)== margs :=bfGenSymbol() - innerfunc:=INTERN(CONCAT(PNAME op,",LAM")) + innerfunc:=INTERN strconc(PNAME op,",LAM") [[innerfunc,["LAMBDA",args,body]], [op,["MLAMBDA",["&REST",margs],["CONS",["QUOTE", innerfunc], ["WRAP",margs, ["QUOTE", control]]]]]] @@ -1044,7 +1044,7 @@ bfWhere (context,expr)== a:=[[first d,second d,bfSUBLIS(opassoc,third d)] for d in defs] $wheredefs:=append(a,$wheredefs) - bfMKPROGN bfSUBLIS(opassoc,NCONC(nondefs,[expr])) + bfMKPROGN bfSUBLIS(opassoc,nconc(nondefs,[expr])) --shoeReadLispString(s,n)== -- n>= # s => nil @@ -1053,7 +1053,7 @@ bfWhere (context,expr)== -- [exp,:shoeReadLispString(s,ind)] bfCompHash(op,argl,body) == - auxfn:= INTERN CONCAT (PNAME op,'";") + auxfn:= INTERN strconc(PNAME op,'";") computeFunction:= ["DEFUN",auxfn,argl,:body] bfTuple [computeFunction,:bfMain(auxfn,op)] @@ -1067,7 +1067,7 @@ bfMain(auxfn,op)== g1:= bfGenSymbol() arg:=["&REST",g1] computeValue := ['APPLY,["FUNCTION",auxfn],g1] - cacheName:= INTERN CONCAT (PNAME op,'";AL") + cacheName:= INTERN strconc(PNAME op,'";AL") g2:= bfGenSymbol() getCode:= ['GETHASH,g1,cacheName] secondPredPair:= [['SETQ,g2,getCode],g2] @@ -1139,12 +1139,12 @@ bfCI(g,x,y)== bfCARCDR: (%Short,%Thing) -> %List bfCARCDR(n,g) == - [INTERN CONCAT ('"CA",bfDs n,'"R"),g] + [INTERN strconc('"CA",bfDs n,'"R"),g] bfDs: %Short -> %String bfDs n == n = 0 => '"" - CONCAT('"D",bfDs(n-1)) + strconc('"D",bfDs(n-1)) ++ Generate code for try-catch expressions. @@ -1262,15 +1262,15 @@ isSimpleNativeType t == coreSymbol: %Symbol -> %Symbol coreSymbol s == - INTERN(SYMBOL_-NAME s, "AxiomCore") + INTERN(PNAME s, "AxiomCore") bootSymbol: %Symbol -> %Symbol bootSymbol s == - INTERN SYMBOL_-NAME s + INTERN PNAME s unknownNativeTypeError t == - fatalError CONCAT('"unsupported native type: ", SYMBOL_-NAME t) + fatalError strconc('"unsupported native type: ", PNAME t) nativeType t == @@ -1362,7 +1362,7 @@ nativeType t == nativeReturnType t == t in $NativeSimpleReturnTypes => nativeType t coreError strconc('"invalid return type for native function: ", - SYMBOL_-NAME t) + PNAME t) ++ Check that `t' is a valid parameter type for a native function, ++ and returns its translation. @@ -1401,7 +1401,7 @@ coerceToNativeType(a,t) == c = "pointer" => [bfColonColon("SB-SYS","ALIEN-SAP"),a] needsStableReference? t => fatalError strconc('"don't know how to coerce argument for native type", - SYMBOL_-NAME c) + PNAME c) fatalError '"don't know how to coerce argument for native type" @@ -1413,15 +1413,15 @@ genGCLnativeTranslation(op,s,t,op') == rettype := nativeReturnType t -- If a simpel DEFENTRY will do, go for it and/[isSimpleNativeType x for x in [t,:s]] => - [["DEFENTRY", op, argtypes, [rettype, SYMBOL_-NAME op']]] + [["DEFENTRY", op, argtypes, [rettype, PNAME op']]] -- Otherwise, do it the hard way. [["CLINES",ccode], ["DEFENTRY", op, argtypes, [rettype, cop]]] where - cop := strconc(SYMBOL_-NAME op','"__stub") + cop := strconc(PNAME op','"__stub") ccode := "strconc"/[gclTypeInC t, '" ", cop, '"(", :[cparm(x,a) for x in tails s for a in tails cargs], '") { ", (t ~= "void" => '"return "; ""), - SYMBOL_-NAME op', '"(", + PNAME op', '"(", :[gclArgsInC(x,a) for x in tails s for a in tails cargs], '"); }" ] where cargs := [mkCArgName i for i in 0..(#s - 1)] @@ -1430,7 +1430,7 @@ genGCLnativeTranslation(op,s,t,op') == strconc(gclTypeInC first x, '" ", first a, (rest x => '", "; '"")) gclTypeInC x == - x in $NativeSimpleDataTypes => SYMBOL_-NAME x + x in $NativeSimpleDataTypes => PNAME x x = "void" => '"void" x = "string" => '"char*" x is [.,["pointer",.]] => "fixnum" @@ -1463,7 +1463,7 @@ genECLnativeTranslation(op,s,t,op') == rettype, callTemplate(op',#args,s), KEYWORD::ONE_-LINER, true]]] where callTemplate(op,n,s) == - "strconc"/[SYMBOL_-NAME op,'"(", + "strconc"/[PNAME op,'"(", :[sharpArg(i,x) for i in 0..(n-1) for x in s],'")"] sharpArg(i,x) == i = 0 => strconc('"(#0)",selectDatum x) @@ -1499,7 +1499,7 @@ genCLISPnativeTranslation(op,s,t,op') == -- from the same class. Consequently, we must allocate C-storage, -- copy data there, pass pointers to them, and possibly copy -- them back. Ugh. - n := INTERN strconc(SYMBOL_-NAME op, '"%clisp-hack") + n := INTERN strconc(PNAME op, '"%clisp-hack") parms := [GENSYM '"parm" for x in s] -- parameters of the forward decl. -- Now, separate non-simple data from the rest. This is a triple-list @@ -1513,7 +1513,7 @@ genCLISPnativeTranslation(op,s,t,op') == -- parameter of non-simple datatype are described as being pointers. foreignDecl := [bfColonColon("FFI","DEF-CALL-OUT"),n, - [KEYWORD::NAME,SYMBOL_-NAME op'], + [KEYWORD::NAME,PNAME op'], [KEYWORD::ARGUMENTS,:[[a, x] for x in argtypes for a in parms]], [KEYWORD::RETURN_-TYPE, rettype], [KEYWORD::LANGUAGE,KEYWORD::STDC]] @@ -1568,8 +1568,8 @@ genSBCLnativeTranslation(op,s,t,op') == unstableArgs := [a,:unstableArgs] op' := - %hasFeature KEYWORD::WIN32 => strconc('"__",SYMBOL_-NAME op') - SYMBOL_-NAME op' + %hasFeature KEYWORD::WIN32 => strconc('"__",PNAME op') + PNAME op' unstableArgs = nil => [["DEFUN",op,args, |