Commit b32daf2e authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

moved a lot of non-essential functions to l/*.lisp

parent 43a09926

Fundamental.lisp

+10 −103
Original line number Diff line number Diff line
@@ -188,25 +188,15 @@ 
(fset 'not #'null)

(fset 'string-concat #'concat)



(defun sequencep (object)

  "return t if OBJECT is a sequence (list or string), nil else"

  (or (listp object) (stringp object)))



(defun subseq (seq start &optional end)

  "return a copy of the subsequence of SEQ bounded by START and END"

  (cond ((listp seq) (sublist seq start end))

        ((stringp seq) (substr seq start end))

        (t (error "subseq: not a sequence: %s" seq))))



(defun atom (ob)

  "return true if OBJECT is an atom, i.e. not a pair"

  (null (consp ob)))



(defun expt (base power)

  "raise BASE to POWER"

  (if (zerop expt)

  (if (zerop power)

      1

    (* base (^ base (1- expt)))))

    (* base (expt base (1- power)))))



(defun <= (&rest args)

  "return t if number args are in ascending order (non-strict), else nil"
@@ -290,19 +280,11 @@ 
           (apply #'string/= (cons n (cddr args)))

           (apply #'string/= (cdr args))))))



(defun length (sequence)

  "return the length of SEQUENCE"

  (if (stringp sequence)

      (setq sequence (split-string sequence "")))

  (if (null sequence)

      0

    (1+ (length (cdr sequence)))))



(defun strlen (s)

  "return the length of string S"

  (if (string= "" s)

(defun length (list)

  "return the length of LIST"

  (if (null list)

      0

    (1+ (strlen (substr s 1)))))

    (1+ (length (cdr list)))))



(defun list* (&rest args+)

  "list of all args, with last arg as the cdr of the last pair constructed"
@@ -333,49 +315,9 @@ 
      l

    (skip l (- (length l) n))))



(defun first (sequence)

  "return the first element of SEQUENCE"

  (cond ((stringp sequence) (substr sequence 0 1))

        ((listp sequence) (car sequence))

        (t (error "first: not a sequence: %s" sequence))))



(defun rest (sequence)

  "return all but the first element of SEQUENCE"

  (cond ((stringp sequence) (substr sequence 1))

        ((listp sequence) (cdr sequence))

        (t (error "rest: not a sequence: %s" sequence))))



(defun prepend (element sequence)

  "prepend ELEMENT to SEQUENCE and return the resulting sequence"

  (cond ((stringp sequence) (string element sequence))

        ((listp sequence) (cons element sequence))

        (t (error "prepend: not a sequence: %s" sequence))))



(defun empty (sequence)

  "return non-nil iff SEQUENCE is empty"

  (cond ((stringp sequence) (string= "" sequence))

        ((listp sequence) (null sequence))

        (t (error "empty: not a sequence: %s" sequence))))



(defun sort-string (s pred)

  "sort string S with predicate PRED and return the resulting string"

  (if (or (string= s "") (= 1 (strlen s)))

      s

    (let* ((len (strlen s))

           (half (div len 2))

           (s1 (substr s 0 half))

           (s2 (substr s half))

           (merge (lambda (s1 s2)

                    (if (string= "" s1)

                        s2

                      (if (string= "" s2)

                          s1

                        (if (pred (substr s1 0 1) (substr s2 0 1))

                            (string (substr s1 0 1) (merge (substr s1 1) s2))

                          (string (substr s2 0 1) (merge s1 (substr s2 1)))))))))

      (merge (sort-string s1 pred) (sort-string s2 pred)))))



(defun sort-list (l pred)





(defun sort (l pred)

  "sort list L with predicate PRED and return the resulting list"

  (if (or (null l) (null (cdr l)))

      l
@@ -391,14 +333,7 @@ 
                        (if (pred (car l1) (car l2))

                            (cons (car l1) (merge (cdr l1) l2))

                          (cons (car l2) (merge l1 (cdr l2)))))))))

      (merge (sort-list l1 pred) (sort-list l2 pred)))))



(defun sort (s pred)

  "sort sequence S with predicate PRED and return the result"

  (cond ((stringp s)

         (apply #'string (sort-list (split-string s "") pred)))

        ((listp s) (sort-list s pred))

        (t (error "sort: not a sequence: %s" s))))

      (merge (sort l1 pred) (sort l2 pred)))))





(defun make-string (n el)
@@ -429,11 +364,6 @@ 
(defun 2+ (n) (+ n 2))

(defun 2- (n) (- n 2))



(defun fib (n)

  (if (< n 2)

      1

    (+ (fib (1- n)) (fib (2- n)))))



(defun zerop (n)

  (= n 0))
@@ -451,7 +381,6 @@ 
      (elt (cdr l)

           (1- n)))))





(defun last (l)

  "Return the last element of list L."

  (car (last-pair l)))
@@ -563,28 +492,6 @@ 
        (decf n)))

    (nreverse result)))



(defun lslice (l from to)

  "Return a slice of list L, beginning at FROM, ending just before TO.

If one or both of the indexes are outside of the list, return a shorter

list as appropriate."

  (let ((result '())

        (index 0))

    (while (and l (< index from))

      (setq l (cdr l))

      (setq index (1+ index)))

    (while (and l (< index to))

      (setq result (cons (car l) result))

      (setq l (cdr l))

      (setq index (1+ index)))

    (nreverse result)))



(defun fib (n)

  "Return the Fibonacci number N."

  (if (< n 2)

      1

    (+ (fib (- n 1))

       (fib (- n 2)))))



(defun identity (ob)

  "return the argument"

  ob)

Makefile

+1 −1
Original line number Diff line number Diff line
@@ -21,7 +21,7 @@ uses.dot: $(PERLSOURCES) Makefile 
test:

	./Lis.pl tests/run-tests.lisp



tags: $(PERLSOURCES)

tags: $(PERLSOURCES) *.lisp

	etags $(PERLSOURCES)



profile:

l/examples.listp

0 → 100644
+6 −0
Original line number Diff line number Diff line 
(defun strlen (s)

  "return the length of string S"

  (if (string= "" s)

      0

    (1+ (strlen (substr s 1)))))

l/fib.lisp

0 → 100644
+8 −0
Original line number Diff line number Diff line 


(defun fib (n)

  "Return the Fibonacci number N."

  (if (< n 2)

      1

    (+ (fib (- n 1))

       (fib (- n 2)))))

l/lslice.lisp

0 → 100644
+31 −0
Original line number Diff line number Diff line 
(defun lslice (l from to)

  "Return a slice of list L, beginning at FROM, ending just before TO.

If one or both of the indexes are outside of the list, return a shorter

list as appropriate."

  (let ((result '())

        last-pair

        (index 0))

    (while (and l (< index from))

      (setq l (cdr l))

      (setq index (1+ index)))

    (while (and l (< index to))

      (let ((newpair (cons (pop l) nil)))

        (if result

            (rplacd last-pair newpair)

          (setq result newpair))

        (setq last-pair newpair))

      (setq index (1+ index)))

    result))



(defun lslice-r (l from to)

  "Return a slice of list L, beginning at FROM, ending just before TO.

If one or both of the indexes are outside of the list, return a shorter

list as appropriate."

  (if (null l)

      nil

    (if (< to 1)

        nil

      (if (< from 1)

          (cons (car l) (lslice-r (cdr l) from (1- to)))

        (lslice-r (cdr l) (1- from) (1- to))))))