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))))