From net@cs.tu-berlin.de Thu Jun 9 18:36:37 EDT 1994 Article: 13064 of comp.lang.lisp Xref: glinda.oz.cs.cmu.edu comp.lang.lisp:13064 comp.lang.scheme:9144 Path: honeydew.srv.cs.cmu.edu!rochester!cornell!travelers.mail.cornell.edu!news.kei.com!MathWorks.Com!europa.eng.gtefsd.com!howland.reston.ans.net!spool.mu.edu!nigel.msen.com!zib-berlin.de!cs.tu-berlin.de!net From: net@cs.tu-berlin.de (Oliver Laumann) Newsgroups: comp.lang.lisp,comp.lang.scheme Subject: Re: Writing a small Lisp Date: 9 Jun 1994 12:43:55 GMT Organization: Technical University of Berlin, Germany Lines: 159 Message-ID: <2t72qb$7v5@news.cs.tu-berlin.de> References: <2t26go$4tn@info-server.bbn.com> <771072428snz@wildcard.demon.co.uk> NNTP-Posting-Host: kugelbus.cs.tu-berlin.de Mime-Version: 1.0 Content-Type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: 8bit Scott Schwartz wrote: > At the risk of being sysetms-programming-centric, here's a test of > viability for a programming language: Rewrite the stuff in /bin in lisp > or scheme. /bin/ls is a good place to start, since it's not very > complicated. Any takers? No problem. Here is a BSD-style /bin/ls for Elk 2.2. There are a few limitations with respect to the real /bin/ls. All of these are minor and could be removed easily; I just didn't have the time to write an *exact* clone of /bin/ls. o There are no options; it always uses -l (long listing). o The sticky bit isn't recognized (this is trivial to implement). o The year isn't shown in the modification time if the file hasn't been modified during the last year. o The listing isn't sorted. I don't have an efficient sort function for Elk. o Error handling isn't optimal. o You can only list the current directory. o The `total' header displayed by /bin/ls -l is missing. o It assumes that symbolic links are supported (easy to fix). It has been tested under SunOS 4.1.3, SunOS 5.3, Ultrix 4.2, SGI Irix 5.1 and HP-UX 9.0 and should work on all platforms where Elk 2.2 is available. The code is somewhat slow, but that's because Elk isn't one of the fastest Scheme implementations around (it has been designed primarily as an extension language to be linked into applications rather than as a fast standalone implementation of Scheme). To use the code, just load ls.scm into Elk 2.2, either interactively from within the top level or by supplying the file in the command line: % scheme -l ls.scm [Autoloading unix.scm] [Autoloading record.scm] [Autoloading record.o] [Autoloading recordutil.scm] [Autoloading unix.o] -rw-r--r-- 1 net 48059 Apr 21 17:44 patch-dec-alpha -rw-r--r-- 1 net 6126 Feb 8 12:52 MIGRATE -rw-r--r-- 1 net 14828 Feb 6 18:45 MACHINES -rw-r--r-- 1 net 7656 Feb 6 18:03 INSTALL -rw-r--r-- 1 net 1564 Apr 13 15:20 COPYRIGHT -rw-r--r-- 1 net 5110 Feb 6 18:26 README -rw-r--r-- 1 net 809146 Feb 8 14:23 elk-2.2.tar.gz -rw-r--r-- 1 net 16784 Feb 8 10:45 CHANGES -rw-r--r-- 1 net 5698 Apr 11 10:11 ANNOUNCE -rw-r--r-- 1 net 2707 Mar 17 11:50 RELEASE drwxr-sr-x 3 net 512 Jan 26 15:50 misc lrwxrwxrwx 1 root 512 Feb 8 13:50 util -> ../../util drwxr-sr-x 5 net 1024 Mar 20 18:16 config drwxr-xr-x 4 net 512 Mar 20 18:18 scripts drwxr-xr-x 7 net 512 Feb 6 17:42 contrib drwxr-xr-x 8 net 512 Jan 18 14:56 examples drwxr-xr-x 3 net 2048 Apr 21 16:16 src drwxr-xr-x 3 net 512 Mar 20 18:18 include drwxr-xr-x 3 net 1024 Mar 20 18:21 scm drwxr-xr-x 8 net 512 Oct 18 10:20 lib drwxr-xr-x 14 net 512 Feb 8 13:19 doc % Here is the code: ----------------------------------------------------------------------------- (require 'unix) ;; Map file type to letter (define type-char-map '((regular . #\-) (directory . #\d) (symlink . #\l) (socket . #\=) (fifo . #\p) (character-special . #\c) (block-special . #\b) (unknown . #\?))) ;; Map file mode to /bin/ls-style mode string without/with taking ;; setuid/setgid bit into account (define perm-tab '#("---" "--x" "-w-" "-wx" "r--" "r-x" "rw-" "rwx")) (define perm-tab1 '#("--S" "--s" "-wS" "-ws" "r-S" "r-s" "rwS" "rws")) ;; Right justify string within field of `n' spaces (define (rjust str n) (let* ((y (string-append (make-string n #\space) str)) (l (string-length y))) (substring y (- l n) l))) ;; Left justify string within field of `n' spaces (define (ljust str n) (let* ((y (string-append str (make-string n #\space))) (l (string-length y))) (substring y 0 n))) (define (print-type type) (display (cdr (assq type type-char-map)))) (define (print-perm perm setid?) (let ((bits (vector-ref (if setid? perm-tab1 perm-tab) perm))) (display bits))) ;; This could probably be made more efficient by using Elk's bitstring ;; extension (define (print-mode mode) (let ((owner 0) (group 0) (world (modulo mode 8))) (set! mode (quotient mode 8)) (set! group (modulo mode 8)) (set! mode (quotient mode 8)) (set! owner (modulo mode 8)) (set! mode (quotient mode 8)) (print-perm owner (>= mode 4)) (print-perm group (odd? (quotient mode 2))) (print-perm world #f))) (define (print-nlink nlink) (display (rjust (number->string nlink) 3)) (display #\space)) (define (print-owner uid) (display (ljust (passwd-name (unix-get-passwd uid)) 8))) (define (print-size size) (display (rjust (number->string size) 9))) (define (print-mtime mtime) (display (substring (unix-time->string mtime) 3 16)) (display #\space)) (define (print-name name) (display name)) (define (print-link name) (display " -> ") (display (unix-readlink name))) (define (list-entry name) (if (not (char=? (string-ref name 0) #\.)) (let ((s (unix-lstat name))) (print-type (stat-type s)) (print-mode (stat-mode s)) (print-nlink (stat-nlink s)) (print-owner (stat-uid s)) (print-size (stat-size s)) (print-mtime (stat-mtime s)) (print-name name) (if (eq? (stat-type s) 'symlink) (print-link name)) (newline)))) (define (ls) (for-each list-entry (unix-read-directory "."))) (ls)