diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 11 | ||||
| -rw-r--r-- | src/interp/boot-pkg.lisp | 4 | ||||
| -rw-r--r-- | src/interp/clammed.boot | 4 | ||||
| -rw-r--r-- | src/interp/debug.lisp | 4 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 6 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 2 | ||||
| -rw-r--r-- | src/interp/i-analy.boot | 4 | ||||
| -rw-r--r-- | src/interp/trace.boot | 26 | ||||
| -rw-r--r-- | src/interp/vmlisp.lisp | 4 |
9 files changed, 37 insertions, 28 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index f508f131..acb3a248 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,14 @@ +2012-04-28 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/boot-pkg.lisp (gensym?): Check for non-null object. + * interp/clammed.boot: Use it in lieu of GENSYMP. + * interp/debug.lisp: Likewise. + * interp/g-opt.boot: Likewise. + * interp/g-util.boot: Likewise. + * interp/i-analy.boot: Likewise. + * interp/trace.boot: Likewise. + * interp/vmlisp.lisp (GENSYMP): Remove. + 2012-03-02 Gabriel Dos Reis <gdr@cse.tamu.edu> * algebra/catdef.spad.pamphlet (MonoidOperation): Noew CoercibleTo diff --git a/src/interp/boot-pkg.lisp b/src/interp/boot-pkg.lisp index 39e52c06..0bfffad7 100644 --- a/src/interp/boot-pkg.lisp +++ b/src/interp/boot-pkg.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007-2011, Gabriel Dos Reis. +;; Copyright (C) 2007-2012, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -52,7 +52,7 @@ (setf (symbol-function f) v))) (defun |gensym?| (s) - (null (symbol-package s))) + (and (symbolp s) (null (symbol-package s)))) ;; Below are some missing functions. There here for lack of better ;; place (sys-funs.lisp?) diff --git a/src/interp/clammed.boot b/src/interp/clammed.boot index 033ddcd8..db1972da 100644 --- a/src/interp/clammed.boot +++ b/src/interp/clammed.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2011, Gabriel Dos Reis. +-- Copyright (C) 2007-2012, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -113,7 +113,7 @@ isValidType form == null (sig := getConstructorSignature op) => nil [.,:cl] := sig -- following line is needed to deal with mutable domains - if # cl ~= # argl and GENSYMP last argl then argl:= drop(-1,argl) + if # cl ~= # argl and gensym? last argl then argl:= drop(-1,argl) # cl ~= # argl => nil cl:= replaceSharps(cl,form) and/[isValid for x in argl for c in cl] where isValid() == diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp index 36a5d0e1..3a00fcdb 100644 --- a/src/interp/debug.lisp +++ b/src/interp/debug.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007-2011, Gabriel Dos Reis. +;; Copyright (C) 2007-2012, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -438,7 +438,7 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|)) (if (AND |$traceDomains| (|isFunctor| FN) (ATOM FN)) (RETURN (|traceDomainConstructor| FN OPTIONS))) (SETQ MATHTRACE (/GETTRACEOPTIONS OPTIONS 'MATHPRINT)) - (if (AND MATHTRACE (NOT (EQL (ELT (PNAME FN) 0) #\$)) (NOT (GENSYMP FN))) + (if (AND MATHTRACE (NOT (EQL (ELT (PNAME FN) 0) #\$)) (NOT (|gensym?| FN))) (if (RASSOC FN |$mapSubNameAlist|) (SETQ |$mathTraceList| (CONS FN |$mathTraceList|)) (|spadThrowBrightly| diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index d771739b..57f518f1 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -616,12 +616,12 @@ EqualBarGensym(x,y) == fn(x,y) where fn(x,y) == x=y => true - GENSYMP x and GENSYMP y => + gensym? x and gensym? y => z:= assoc(x,$GensymAssoc) => y=rest z $GensymAssoc:= [[x,:y],:$GensymAssoc] true - null x => y is [g] and GENSYMP g - null y => x is [g] and GENSYMP g + null x => y is [g] and gensym? g + null y => x is [g] and gensym? g x isnt [.,:.] or y isnt [.,:.] => false fn(first x,first y) and fn(rest x,rest y) diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 95d26cb4..9ed9468b 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -1101,7 +1101,7 @@ charDigitVal c == n gensymInt g == - not GENSYMP g => error '"Need a GENSYM" + not gensym? g => error '"Need a GENSYM" p := symbolName g n := 0 for i in 2..maxIndex p repeat diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot index 54d576b1..c54043c5 100644 --- a/src/interp/i-analy.boot +++ b/src/interp/i-analy.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2011, Gabriel Dos Reis. +-- Copyright (C) 2007-2012, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -370,7 +370,7 @@ bottomUpIdentifier(t,id) == expr:= objVal u om := objMode(u) (om ~= $EmptyMode) and (om isnt ['RuleCalled,.]) => - $genValue or GENSYMP(id) => + $genValue or gensym?(id) => null tar => [om] (r := resolveTM(om,tar)) => [r] [om] diff --git a/src/interp/trace.boot b/src/interp/trace.boot index 5e3c0b43..8e09eeff 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2011, Gabriel Dos Reis. +-- Copyright (C) 2007-2012, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -420,7 +420,7 @@ funfind("functor","opname") == isDomainOrPackage dom == vector? dom and #dom>0 and isFunctor opOf dom.0 -isTraceGensym x == GENSYMP x +isTraceGensym x == gensym? x spadTrace(domain,options) == $fromSpadTrace:= true @@ -453,7 +453,7 @@ spadTrace(domain,options) == isTraceable(x is [.,.,n,:.],domain) == domain.n isnt [.,:.] => nil functionSlot:= first domain.n - GENSYMP functionSlot => + gensym? functionSlot => (reportSpadTrace("Already Traced",x); nil) null (BPINAME functionSlot) => (reportSpadTrace("No function for",x); nil) @@ -588,13 +588,13 @@ letPrint(x,val,currentFunction) == if $letAssoc and ((y:= LASSOC(currentFunction,$letAssoc)) or (y:= symbolTarget("all",$letAssoc))) then if (y="all" or symbolMember?(x,y)) and - not (IS__GENVAR(x) or isSharpVarWithNum(x) or GENSYMP x) then + not (IS__GENVAR(x) or isSharpVarWithNum(x) or gensym? x) then sayBrightlyNT [:bright x,": "] PRIN1 shortenForPrinting val TERPRI() if (y:= hasPair("BREAK",y)) and (y="all" or symbolMember?(x,y) and - (not symbolMember?(PNAME(x).0,'($ _#)) and not GENSYMP x)) then + (not symbolMember?(PNAME(x).0,'($ _#)) and not gensym? x)) then break [:bright currentFunction,'"breaks after",:bright x,'":= ", shortenForPrinting val] val @@ -606,14 +606,14 @@ letPrint2(x,printform,currentFunction) == if $letAssoc and ((y:= symbolTarget(currentFunction,$letAssoc)) or (y:= symbolTarget("all",$letAssoc))) then if (y="all" or symbolMember?(x,y)) and - not (IS__GENVAR(x) or isSharpVarWithNum(x) or GENSYMP x) then + not (IS__GENVAR(x) or isSharpVarWithNum(x) or gensym? x) then $BreakMode:='letPrint2 flag:=nil CATCH('letPrint2,mathprint ["=",x,printform],flag) if flag='letPrint2 then print printform if (y:= hasPair("BREAK",y)) and (y="all" or symbolMember?(x,y) and - (not symbolMember?(PNAME(x).0,'($ _#)) and not GENSYMP x)) then + (not symbolMember?(PNAME(x).0,'($ _#)) and not gensym? x)) then break [:bright currentFunction,'"breaks after",:bright x,":= ", printform] x @@ -626,14 +626,14 @@ letPrint3(x,xval,printfn,currentFunction) == if $letAssoc and ((y:= LASSOC(currentFunction,$letAssoc)) or (y:= symbolTarget("all",$letAssoc))) then if (y="all" or symbolMember?(x,y)) and - not (IS__GENVAR(x) or isSharpVarWithNum(x) or GENSYMP x) then + not (IS__GENVAR(x) or isSharpVarWithNum(x) or gensym? x) then $BreakMode:='letPrint2 flag:=nil CATCH('letPrint2,mathprint ["=",x,SPADCALL(xval,printfn)],flag) if flag='letPrint2 then print xval if (y:= hasPair("BREAK",y)) and (y="all" or symbolMember?(x,y) and - (not (PNAME(x).0 in '($ _#)) and not GENSYMP x)) then + (not (PNAME(x).0 in '($ _#)) and not gensym? x)) then break [:bright currentFunction,'"breaks after",:bright x,'":= ", xval] x @@ -766,7 +766,7 @@ addTraceItem d == constructor? d => $constructors:=[d,:$constructors] tracelet(fn,vars) == - if GENSYMP fn and stupidIsSpadFunction eval fn then + if gensym? fn and stupidIsSpadFunction eval fn then fn := eval fn if COMPILED_-FUNCTION_-P fn then fn:=BPINAME fn fn = 'Undef => nil @@ -779,14 +779,14 @@ tracelet(fn,vars) == $TRACELETFLAG : local := true $QuickLet : local := false not symbolMember?(fn,$traceletFunctions) and not IS__GENVAR fn and COMPILED_-FUNCTION_-P symbolFunction fn - and not stupidIsSpadFunction fn and not GENSYMP fn => + and not stupidIsSpadFunction fn and not gensym? fn => ($traceletFunctions:= [fn,:$traceletFunctions]; compileBoot fn ; $traceletFunctions:= remove($traceletFunctions,fn) ) breaklet(fn,vars) == --vars is "all" or a list of variables --$letAssoc ==> (.. (=fn .. (BREAK . all))) OR (.. (=fn .. (BREAK . vl))) - if GENSYMP fn and stupidIsSpadFunction eval fn then + if gensym? fn and stupidIsSpadFunction eval fn then fn := eval fn if COMPILED_-FUNCTION_-P fn then fn:= BPINAME fn fn = "Undef" => nil @@ -800,7 +800,7 @@ breaklet(fn,vars) == if $letAssoc then SETLETPRINTFLAG true $QuickLet:local := false not symbolMember?(fn,$traceletFunctions) and not stupidIsSpadFunction fn - and not GENSYMP fn => + and not gensym? fn => $traceletFunctions:= [fn,:$traceletFunctions] compileBoot fn $traceletFunctions:= removeSymbol($traceletFunctions,fn) diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp index 47ccdec1..6282e0d4 100644 --- a/src/interp/vmlisp.lisp +++ b/src/interp/vmlisp.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007-2011, Gabriel Dos Reis. +;; Copyright (C) 2007-2012, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -516,8 +516,6 @@ ; 9.5 Identifiers -(defun gensymp (x) (and (symbolp x) (null (symbol-package x)))) - (defun digitp (x) (or (and (symbolp x) (digitp (symbol-name x))) (and (characterp x) (digit-char-p x)) |