Skip to content

L
lis.pl
Commit b32daf2e authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files
Options

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

parent 43a09926
Hide whitespace changes
Inline Side-by-side
Showing with 140 additions and 104 deletions
Fundamental.lisp
View file @ b32daf2e
......@@ -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))
......@@ -450,7 +380,6 @@
(car l)
(elt (cdr l)
(1- n)))))
(defun last (l)
"Return the last element of list 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
View file @ b32daf2e
......@@ -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
View file @ b32daf2e
(defun strlen (s)
"return the length of string S"
(if (string= "" s)
0
(1+ (strlen (substr s 1)))))
l/fib.lisp 0 → 100644
View file @ b32daf2e
(defun fib (n)
"Return the Fibonacci number N."
(if (< n 2)
1
(+ (fib (- n 1))
(fib (- n 2)))))
l/lslice.lisp 0 → 100644
View file @ b32daf2e
(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))))))
l/sequences.lisp 0 → 100644
View file @ b32daf2e
(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 length (sequence)
"return the length of SEQUENCE"
(if (stringp sequence)
(setq sequence (split-string sequence "")))
(if (null sequence)
0
(1+ (length (cdr sequence)))))
(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)
"sort list L with predicate PRED and return the resulting list"
(if (or (null l) (null (cdr l)))
l
(let* ((len (length l))
(half (div len 2))
(l1 (sublist l 0 half))
(l2 (sublist l half))
(merge (lambda (l1 l2)
(if (null l1)
l2
(if (null l2)
l1
(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))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment