Permalink
Browse files

Initial import of miniscm 0.85k4.

  • Loading branch information...
0 parents commit b68989a127872b78f3ce05b1975e2c576613833b @cpressey cpressey committed Dec 13, 2011
Showing with 3,080 additions and 0 deletions.
  1. +211 −0 README
  2. +150 −0 init.scm
  3. +18 −0 makefile
  4. +2,451 −0 miniscm.c
  5. +27 −0 nextleaf.scm
  6. +223 −0 tools.scm
@@ -0,0 +1,211 @@
+ =====================================================================
+
+ ---------- Mini-Scheme Interpreter Version 0.85 ----------
+
+ coded by Atsushi Moriwaki (11/5/1989)
+
+ E-MAIL : moriwaki@kurims.kurims.kyoto-u.ac.jp
+ MIX : riemann
+ NIFTY : PBB01074
+ (Note that these addresses are now obsolete, see below)
+
+ =====================================================================
+
+ Revised by Akira KIDA
+
+ Version 0.85k4 (17 May 1994)
+ Version 0.85k3 (30 Nov 1989)
+ Version 0.85k2 (28 Nov 1989)
+ Version 0.85k1 (14 Nov 1989)
+
+ Mini-Scheme is now maintained by Akira KIDA.
+
+ E-Mail : SDI00379@niftyserve.or.jp
+
+ Most part of this document is written by Akira KIDA.
+ Send comments/requests/bug reports to Akira KIDA at the above
+ email address.
+
+ =====================================================================
+
+ This Mini-Scheme Interpreter is based on "SCHEME Interpreter in
+ Common Lisp" in Appendix of T.Matsuda & K.Saigo, Programming of LISP,
+ archive No5 (1987) p6 - p42 (published in Japan).
+
+
+ Copyright Notice:
+ THIS SOFTWARE IS PLACED IN THE PUBLIC DOMAIN BY THE AUTHOR.
+
+ This software is completely free to copy, modify and/or re-distribute.
+ But I (Atsushi Moriwaki) would appreciate it if you left my name on the
+ code as the author.
+
+ DISCLAIMER:
+ THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
+ IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ PURPOSE.
+
+
+ Supported features (or, NOT supported features :-)
+ 1) Lists, symbols, strings.
+ However, strings have very limited capability.
+ For instance, there is *NO* string-ref, string-set!, ... etc.
+ 2) Numbers are limited to FIXNUM only.
+ There is *NO* complex, real, rational and even bignum.
+ 3) Macro feature is supported, though not the one defined in R4RS.
+
+ Known problems:
+ 1) Poor error recovery from illegal use of syntax and procedure.
+ 2) Certain procedures do not check its argument type.
+
+ Installation:
+ 1) Select system declaration and configuration options by editing
+ source file.
+
+ You may choose one of the following systems by #define'ing
+ the preprocessor symbol.
+
+ Supported systems are:
+ Macintosh:
+ LSC -- LightSpeed C (3.0) for Macintosh
+ LSC4 -- LightSpeed C (4.0) for Macintosh
+ They are different in #include header only.
+ I (kida) think THINK C 5.0, 6.0, 7.0 may be OK
+ with LSC4 configuration, though not tested.
+ MPW2 -- Macintosh Programmer's Workshop v2.0x
+ I don't tested v3.x or later.
+ DOS:
+ MSC4 -- Microsoft C v4.0 (use /AL)
+ MSC v5.1, v6.0, v7.0 are all OK.
+ TURBO2 -- Bolarnd's Turbo C v2.0 (use -ml)
+ Turbo C++ 1.0 is OK.
+ UNIX:
+ BSD -- UNIX of BSD flavor, ex. SuOS 4.x
+ SYSV -- UNIX of System-V flavor, ex. Sun/Solaris 2.x
+
+ VAX/VMS:
+ VAXC -- VAX-C v3.x (this symbol may be defined by the
+ compiler automatically).
+
+ 2) Configure some preprocessor symbols by editing source files.
+
+ Configurable #define's are:
+
+ #define VERBOSE
+ -- if defined, GC messages is verbose on default.
+
+ #define AVOID_HACK_LOOP
+ -- if defined, do _NOT_ use loop construction in the
+ form
+ do { ... } while (0)
+ This form is used in macro expansion, since this is
+ the best "safety" blocking construct when used in
+ macro definition.
+ However, some compiler (including SunPRO CC 2.0.1)
+ is silly enough to warning this construct, like
+ "warning: end-of-loop code not reached", etc.
+ If you dislike such warning, please define this symbol.
+ NOTE: You may get some "statement not reached" warning
+ even if you have define this symbol. Please be patient,
+ or, use more smart compiler.
+ In short if you use GCC, undefine this and forget it
+ at all.
+
+ #define USE_SETJMP
+ -- if defined, use setjmp to global jump on error.
+ if not defined, avoid to use it. Compiled with
+ this symbol defined, the interpreter issue fatal
+ error and return to the operating system immediately
+ when we run out of free cells. By default, i.e.,
+ compiled with this symbol is not defined, the
+ interpreter will just return to the top level in
+ such a case.
+ May not be used except for compiling as Mac DA.
+
+ #define USE_MACRO
+ -- if defined, macro features are enabled.
+
+ #define USE_QQUOTE
+ -- if defined, you can use quasi-quote "`" in macro.
+ You can use macro even if this symbol is undefined.
+
+ 3) Compile!
+
+ I think there is virtually no problem about how to compile.
+ Since there is exactly one C source file. :-)
+ If you are on UNIX boxes with some BSD flavors, instead of
+ using make command, it's enough to type:
+
+ cc -DBSD -O -o miniscm miniscm.c
+
+ You may have additional warnings like 'function should
+ return value'. This is due to omitting 'void' keyword
+ from the source in order to get pre-ANSI compatibility.
+
+
+ Usage : miniscm
+
+ Sorry, no command line argnumet is allowed.
+
+
+ Special procedures of this system:
+
+ gc : (gc) -- force garbage collection
+
+ gc-verbose : (gc-verbose bool) -- GC verbose on/off
+ Argument #f turnes off the GC message.
+ Enything else turn on the GC message.
+
+ quit : (quit) -- quit to the operating system
+
+ put : (put sym prop expr)
+ -- set the value of a property of a symbol.
+ get : (get sym prop)
+ -- get the value of a property of a symbol.
+
+ new-segment : (new-segment n)
+ -- allocate n new cell segments.
+
+ print-width : (print-width list)
+ -- returns 'printed' width of list.
+
+ closure? : (closure? obj)
+ -- test if obj is a closure or not.
+
+ macro? : (macro? obj)
+ -- test if obj is a macro or not.
+ note that a macro is also a closure.
+
+ get-closure-code
+ : (get-closure-code closure-obj)
+ -- extract S-expr from closure-obj.
+
+ Scheme files:
+ init.scm -- Automatically loaded at invocation.
+ Default setting assumes that this file is in the current
+ working directory.
+ Change #define InitFile if you don't like it.
+
+ tools.scm -- This is a sample file. Contains very tiny pretty-print
+ procedure.
+ After invoking miniscm, type:
+ (load "tools.scm")
+ and try
+ (pp getd)
+ (pp do)
+
+ Documents?:
+
+ Sorry, there is no other documents.
+ Do not ask one for me, please see the source instead. :-)
+
+ But if you _absolutely_ need help, please email to me at:
+ <SDI00379@niftyserve.or.jp>
+
+ Enjoy!
+
+ -- Akira KIDA
+ Sysop for FPL in NIFTY-Serve in JAPAN.
+ (FPL stands for 'Forum for Program-Language')
+
@@ -0,0 +1,150 @@
+; This is a init file for Mini-Scheme.
+
+;; fake pre R^3 boolean values
+(define nil #f)
+(define t #t)
+
+(define (caar x) (car (car x)))
+(define (cadr x) (car (cdr x)))
+(define (cdar x) (cdr (car x)))
+(define (cddr x) (cdr (cdr x)))
+(define (caaar x) (car (car (car x))))
+(define (caadr x) (car (car (cdr x))))
+(define (cadar x) (car (cdr (car x))))
+(define (caddr x) (car (cdr (cdr x))))
+(define (cdaar x) (cdr (car (car x))))
+(define (cdadr x) (cdr (car (cdr x))))
+(define (cddar x) (cdr (cdr (car x))))
+(define (cdddr x) (cdr (cdr (cdr x))))
+
+(define call/cc call-with-current-continuation)
+
+(define (list . x) x)
+
+(define (map proc list)
+ (if (pair? list)
+ (cons (proc (car list)) (map proc (cdr list)))))
+
+(define (for-each proc list)
+ (if (pair? list)
+ (begin (proc (car list)) (for-each proc (cdr list)))
+ #t ))
+
+(define (list-tail x k)
+ (if (zero? k)
+ x
+ (list-tail (cdr x) (- k 1))))
+
+(define (list-ref x k)
+ (car (list-tail x k)))
+
+(define (last-pair x)
+ (if (pair? (cdr x))
+ (last-pair (cdr x))
+ x))
+
+(define (head stream) (car stream))
+
+(define (tail stream) (force (cdr stream)))
+
+;; The following quasiquote macro is due to Eric S. Tiedemann.
+;; Copyright 1988 by Eric S. Tiedemann; all rights reserved.
+;;
+;; --- If you don't use macro or quasiquote, cut below. ---
+
+(macro
+ quasiquote
+ (lambda (l)
+ (define (mcons f l r)
+ (if (and (pair? r)
+ (eq? (car r) 'quote)
+ (eq? (car (cdr r)) (cdr f))
+ (pair? l)
+ (eq? (car l) 'quote)
+ (eq? (car (cdr l)) (car f)))
+ (list 'quote f)
+ (list 'cons l r)))
+ (define (mappend f l r)
+ (if (or (null? (cdr f))
+ (and (pair? r)
+ (eq? (car r) 'quote)
+ (eq? (car (cdr r)) '())))
+ l
+ (list 'append l r)))
+ (define (foo level form)
+ (cond ((not (pair? form)) (list 'quote form))
+ ((eq? 'quasiquote (car form))
+ (mcons form ''quasiquote (foo (+ level 1) (cdr form))))
+ (#t (if (zero? level)
+ (cond ((eq? (car form) 'unquote) (car (cdr form)))
+ ((eq? (car form) 'unquote-splicing)
+ (error "Unquote-splicing wasn't in a list:"
+ form))
+ ((and (pair? (car form))
+ (eq? (car (car form)) 'unquote-splicing))
+ (mappend form (car (cdr (car form)))
+ (foo level (cdr form))))
+ (#t (mcons form (foo level (car form))
+ (foo level (cdr form)))))
+ (cond ((eq? (car form) 'unquote)
+ (mcons form ''unquote (foo (- level 1)
+ (cdr form))))
+ ((eq? (car form) 'unquote-splicing)
+ (mcons form ''unquote-splicing
+ (foo (- level 1) (cdr form))))
+ (#t (mcons form (foo level (car form))
+ (foo level (cdr form)))))))))
+ (foo 0 (car (cdr l)))))
+
+;;;;; following part is written by a.k
+
+;;;; atom?
+(define (atom? x)
+ (not (pair? x)))
+
+;;;; memq
+(define (memq obj lst)
+ (cond
+ ((null? lst) #f)
+ ((eq? obj (car lst)) lst)
+ (else (memq obj (cdr lst)))))
+
+;;;; equal?
+(define (equal? x y)
+ (if (pair? x)
+ (and (pair? y)
+ (equal? (car x) (car y))
+ (equal? (cdr x) (cdr y)))
+ (and (not (pair? y))
+ (eqv? x y))))
+
+
+;;;; (do ((var init inc) ...) (endtest result ...) body ...)
+;;
+(macro do
+ (lambda (do-macro)
+ (apply (lambda (do vars endtest . body)
+ (let ((do-loop (gensym)))
+ `(letrec ((,do-loop
+ (lambda ,(map (lambda (x)
+ (if (pair? x) (car x) x))
+ `,vars)
+ (if ,(car endtest)
+ (begin ,@(cdr endtest))
+ (begin
+ ,@body
+ (,do-loop
+ ,@(map (lambda (x)
+ (cond
+ ((not (pair? x)) x)
+ ((< (length x) 3) (car x))
+ (else (car (cdr (cdr x))))))
+ `,vars)))))))
+ (,do-loop
+ ,@(map (lambda (x)
+ (if (and (pair? x) (cdr x))
+ (car (cdr x))
+ nil))
+ `,vars)))))
+ do-macro)))
+
@@ -0,0 +1,18 @@
+# Makefile for System-V flavoured UNIX
+#
+#CC = gcc # you may use both ANSI and pre-ANSI
+
+#
+# Please see source and/or README for system defition
+#
+#CFLAGS = -g -DSYSV -traditional -traditional-cpp -Wid-clash-8
+CFLAGS = -O -DSYSV
+
+all : miniscm
+
+miniscm : miniscm.c Makefile
+ $(CC) $(CFLAGS) -o miniscm miniscm.c
+
+clean :
+ rm -f core *.o miniscm *~
+
Oops, something went wrong.

0 comments on commit b68989a

Please sign in to comment.