Artifact 44253841ae228bdb61a52cc4c3cb63aa0bb114c7a72f69f493c26c4be6ac5a5f:

• File psl-1983/3-1/glisp/gevaux.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: 1553) [annotate] [blame] [check-ins using] [more...]

% GEVAUX.SL.14     07 April 83
% 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))))