Artifact daf5a78e91292f698a05ec822495bd78c0a8d1a4867df28096758c365613b94c:
- File
psl-1983/3-1/glisp/gevaux20.old
— part of check-in
[eb17ceb7f6]
at
2020-04-21 19:40:01
on branch master
— Add Reduce 3.0 to the historical section of the archive, and some more
files relating to version sof PSL from the early 1980s. Thanks are due to
Paul McJones and Nelson Beebe for these, as well as to all the original
authors.git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 1538) [annotate] [blame] [check-ins using] [more...]
- File
psl-1983/3-1/glisp/gevaux20.sl
— part of check-in
[eb17ceb7f6]
at
2020-04-21 19:40:01
on branch master
— Add Reduce 3.0 to the historical section of the archive, and some more
files relating to version sof PSL from the early 1980s. Thanks are due to
Paul McJones and Nelson Beebe for these, as well as to all the original
authors.git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 1538) [annotate] [blame] [check-ins using]
% GEVAUX20.SL.21 % Auxiliary functions for PSL version of GEV. % GSN 07 March 83 % Interlisp Substring function. (de substring (string first last) (cond ((not (stringp string)) (setq string (gevstringify string)))) (cond ((minusp first) (setq first (add1 (plus (add1 (size string)) first))))) (cond ((minusp last) (setq last (add1 (plus (add1 (size string)) last))))) (subseq string (sub1 first) last) ) % Make a string out of anything (de gevstringify (x) (cond ((stringp x) x) (t (bldmsg "%p" x)))) % Concatenate an arbitrary number of items (de concatn (l) (cond ((null l) "") ((null (cdr l)) (gevstringify (car l))) (t (concat (gevstringify (car l)) (concatn (cdr l)))))) (de concatln (l) (cond ((null l) "") ((null (cdr l)) (gevstringify (eval (car l)))) (t (concat (gevstringify (eval (car l))) (concatln (cdr l)))))) (df concatl (concatlarg) (concatln concatlarg)) (de gevconcat (l) (concatn l)) (de dreverse (l) (reversip l)) (de mkatom (s) (intern s)) (de gevputd (fn form) (put fn 'gloriginalexpr (cons 'lambda (cdr form))) (put fn 'glcompiled nil) (remd fn) (putd fn 'macro '(lambda (gldgform) (glhook gldgform)))) % Apply a function to arguments, Glisp-compiling first if needed. (de gevapply (fn args) (cond ((and (atom fn) (or (null (get fn 'glcompiled)) (not (eq (getddd fn) (get fn 'glcompiled))))) (glcc fn) (apply fn args)) (t (apply fn args))))