Language compat

README.md

@@ -1,25 +1,26 @@
 lisp-interpreter
 ===============
 
+> Any sufficiently complicated C or Fortran program contains an ad hoc, informally-specified, bug-ridden, slow implementation of half of Common Lisp. -- Philip Greenspun
+
 An embeddable lisp/scheme interpreter written in C.
-Includes a small subset of the MIT Scheme library.
-I created this while reading [SICP](https://github.com/justinmeiners/sicp-excercises) to improve my knowledge of lisp and to make an implementation that allows me to easily add scripting to my own programs.
+It includes a subset of R5RS with some extensions from MIT Scheme.
+
+I created this while reading [SICP](https://github.com/justinmeiners/sicp-excercises) to improve my knowledge of lisp
+and to make an implementation that allows me to easily add scripting to my own programs.
 
 ### Philosophy
 
-- **Simple**: Language implementations often are quite complicated and have too many fancy features.
+- **Simple**: Languages can become very complicated and have too many fancy features.
     This project doesn't aim to be an optimal, fully featured, or compliant Scheme implementation.
     It is just a robust foundation for scripting. 
 
-   If you need a more complete implementation try [s7](https://ccrma.stanford.edu/software/snd/snd/s7.html)
-    or [chicken](https://www.call-cc.org)
+    If you need more try [s7](https://ccrma.stanford.edu/software/snd/snd/s7.html) or [chicken](https://www.call-cc.org)
 
-- **Unintrusive**: Just copy in the header file.
-    Turn on and off major features with build macros.
-    It should be portable between major platforms.
+- **Unintrusive**: Just copy in the header file. Turn on and off major features with build macros. It should be portable between major platforms.
 
 - **Unsurprising**: You should be able to read the source code and understand how it works.
-  The header API should work how you expect.
+  The C API should work how you expect.
 
 - **First class data**: Lisp s-expressions are undervalued as an alternative to JSON or XML.
     Preprocessor flags can remove most scheme features if you just want to read s-expressions
@@ -28,25 +29,23 @@ I created this while reading [SICP](https://github.com/justinmeiners/sicp-excerc
 ### Features
 
 - C99 no dependencies. Single header.
-- Core scheme language: if, let, do, lambda, cons, car, eval, symbols, etc.
-- Data structures: lists, vectors, hash tables, integers, real numbers, characters, strings, and integers.
-- Standard library: subset of [MIT Scheme](https://groups.csail.mit.edu/mac/ftpdir/scheme-7.4/doc-html/scheme_toc.html)
-  with Common Lisp features (like `push`) mixed in.
+- Core lisp language `if`, `let`, `do`, `lambda`, `cons`, `eval`, etc.
+- Subset of scheme R5RS library: lists, vectors, hash tables, integers, real numbers, characters, strings, and integers.
+- Common lisp goodies: unhygenic macros (`define-macro`), `push`, `dotimes`.
+- Easy to integrate C functions.
 - Exact [garbage collection](#garbage-collection) with explicit invocation.
-- Common lisp style unhygenic macros: `define-macro`.
-- Easy integration of C functions.
 - REPL command line tool.
 - Efficient parsing and manipulation of large data files.
 
 ### Non-Features
 
-- compiler
-- full numeric tower: complex and rational numbers.
-- full call/cc (simple stack jump supported)
-- full port IO
-- unix system library
+- Compiler
+- Full numeric tower: complex and rational numbers.
+- Full call/cc. This only supports simple stack jumps.
+- syntax rules.
+- extensive IO or UNIX system libraries.
 
-## Examples
+### Examples
 
 ### Interactive programming with Read, eval, print loop.
 ```bash
@@ -146,7 +145,7 @@ lisp_env_define(env, lisp_make_symbol("INTEGER-RANGE", ctx), func, ctx);
 
 In Lisp
 ```scheme
-(INTEGER-RANGE 5 15)
+(integer-range 5 15)
 ; => #(5 6 7 8 9 10 11 12 13 14)
 ```
 Constants can also be stored in the environment in a similar fashion.
@@ -155,14 +154,14 @@ Constants can also be stored in the environment in a similar fashion.
 Lisp pi = lisp_make_real(3.141592);
 lisp_env_define(env, lisp_make_symbol("PI", ctx), pi, ctx);
 ```
-## Macros
+### Macros
 
 Common Lisp style (`defmacro`) is available with the name `define-macro`.
 
     (define-macro nil! (lambda (x)
       `(set! ,x '()))
 
-## Garbage Collection
+### Garbage Collection
 
 Garbage is only collected if it is explicitly told to.
 You can invoke the garbage collector in C:
@@ -174,15 +173,22 @@ OR in lisp code:
     (gc-flip)
 
 Note that whenever a collect is issued
-ANY `Lisp` value which is not accessible
+ANY `Lisp` value in `C`which is not accessible
 through the global environment may become invalid.
 Be careful what variables you hold onto in C.
 
-Don't call `eval` in a custom defined C function unless
-you know what you are doing.
+Don't call `eval` in a custom defined C function unless you know what you are doing.
 
 See [internals](INTERNALS.md) for more details.
 
+## Documentation
+
+For the language refer to [MIT Scheme](https://groups.csail.mit.edu/mac/ftpdir/scheme-7.4/doc-html/scheme_toc.html)
+with the understanding that not everything is missing.
+If we do implement a feature that MIT scheme has, we will try to follow their specificaiton.
+
+For the C API refer to the header and sample programs (`repl.c`, `printer.c`).
+
 ## Project License
 
 Copyright (c) 2020 Justin Meiners

lisp.h

@@ -892,7 +892,7 @@ Lisp lisp_alist_ref(Lisp l, Lisp key)
         }
         l = lisp_cdr(l);
     }
-    return lisp_make_null();
+    return lisp_false();
 }
 
 static int _vector_len(const Vector* v) { return v->block.d.vector.length; }
@@ -1007,7 +1007,7 @@ Lisp lisp_avector_ref(Lisp v, Lisp key)
         Lisp pair = lisp_vector_ref(v, i);
         if (lisp_is_pair(pair) && lisp_eq(lisp_car(pair), key)) return pair;
     }
-    return lisp_make_null();
+    return lisp_false();
 }
 
 static uint64_t hash_uint64(uint64_t x)
@@ -3374,8 +3374,18 @@ static Lisp sch_read(Lisp args, LispError* e, LispContext ctx)
 
 static Lisp sch_error(Lisp args, LispError* e, LispContext ctx)
 {
-   Lisp l = lisp_car(args);
-   fputs(lisp_string(l), ctx.p->out_port);
+   if (lisp_is_pair(args))
+   {
+       Lisp l = lisp_car(args);
+       fputs(lisp_string(l), ctx.p->err_port);
+       args = lisp_cdr(args);
+   }
+   while (lisp_is_pair(args))
+   {
+       fputs(" ", ctx.p->err_port);
+       lisp_printf(ctx.p->err_port, lisp_car(args));
+       args = lisp_cdr(args);
+   }
 
    *e = LISP_ERROR_RUNTIME;
    return lisp_make_null();
@@ -3567,6 +3577,7 @@ static Lisp sch_divide(Lisp args, LispError* e, LispContext ctx)
                 case LISP_REAL:
                     return lisp_make_real(lisp_number_to_real(x) / lisp_real(y));
                 case LISP_INT:
+                    // TODO: divide by zero check?
                     return lisp_make_int(lisp_int(x) / lisp_int(y));
                 default:
                     *e = LISP_ERROR_TYPE;
@@ -3653,6 +3664,7 @@ static Lisp sch_symbol_less(Lisp args, LispError* e, LispContext ctx)
 
 static Lisp sch_string_to_symbol(Lisp args, LispError* e, LispContext ctx)
 {
+    ARITY_CHECK(1, 1);
     Lisp val = lisp_car(args);
     if (lisp_type(val) != LISP_STRING)
     {
@@ -4797,42 +4809,57 @@ static const char* lib_code_lang0 = "\
   (if (pred (car l)) #t \
    (some? pred (cdr l))))) \
 \
-(define (map1 proc l result) \
+(define (_map1-helper proc l result) \
  (if (null? l) \
   (reverse! result) \
-  (map1 proc \
+  (_map1-helper proc \
    (cdr l) \
    (cons (proc (car l)) result)))) \
 \
+(define (map1 proc l) (_map1-helper proc l '())) \
+\
 (define (for-each1 proc l) \
  (if (null? l) '() \
   (begin (proc (car l)) (for-each1 proc (cdr l ))))) \
 \
+(define (_make-lambda args body) \
+ (list 'LAMBDA args (if (null? (cdr body)) (car body) (cons 'BEGIN body)))) \
+\
+(define (_check-binding-list bindings) \
+  (for-each1 (lambda (entry) \
+    (if (not (pair? entry)) (syntax-error \"bad let binding\" entry)) \
+    (if (not (symbol? (first entry))) (syntax-error \"let entry missing symbol\" entry))) bindings)) \
+\
 (define (_let->combination var bindings body) \
- (for-each1 (lambda (entry) \
-        (if (not (pair? entry)) (syntax-error \"bad let binding\" entry)) \
-        (if (not (symbol? (first entry))) (syntax-error \"let entry missing symbol\" entry))) bindings) \
- (define body-func (list 'LAMBDA \
-                    (map1 (lambda (entry) (car entry)) bindings '()) \
-                    (if (null? (cdr body)) (car body) (cons 'BEGIN body)))) \
- (define initial-args (map1 (lambda (entry) (car (cdr entry))) bindings '())) \
+ (_check-binding-list bindings) \
+ (define body-func (_make-lambda (map1 (lambda (entry) (first entry)) bindings) body)) \
+ (define initial-args (map1 (lambda (entry) (second entry)) bindings)) \
  (if (null? var) \
   (cons body-func initial-args) \
-  (list (list 'LAMBDA '() (list 'DEFINE var body-func) (cons var initial-args))))) \
+  (list (_make-lambda '() (list (list 'DEFINE var body-func) (cons var initial-args)))))) \
 \
 (define-macro let (lambda args  \
-(if (pair? (first args)) \
+  (if (pair? (first args)) \
      (_let->combination '() (car args) (cdr args)) \
      (_let->combination (first args) (second args) (cdr (cdr args)))))) \
 \
-(define (_let*-helper def-list body) \
-    (if (null? def-list) (if (null? (cdr body)) (car body) (cons 'BEGIN body)) \
-     (list 'LET (list (car def-list)) (_let*-helper (cdr def-list) body)))) \
-(define-macro let* (lambda (def-list . body) (_let*-helper def-list body))) \
+(define (_let*-helper bindings body) \
+    (if (null? bindings) (if (null? (cdr body)) (car body) (cons 'BEGIN body)) \
+     (list 'LET (list (car bindings)) (_let*-helper (cdr bindings) body)))) \
+\
+(define-macro let* (lambda (bindings . body) \
+  (_check-binding-list bindings) \
+  (_let*-helper bindings body))) \
+\
+(define-macro letrec (lambda (bindings . body) \
+  (_check-binding-list bindings) \
+  (cons (_make-lambda (map1 (lambda (entry) (first entry)) bindings) \
+    (append (map1 (lambda (entry) (list 'SET! (first entry) (second entry))) \
+                          bindings) body)) \
+      (map1 (lambda (entry) '()) bindings)))) \
 \
 (define (_cond-helper clauses) \
- (if (null? clauses) \
-  '() \
+ (if (null? clauses) '() \
   (if (eq? (car (car clauses)) 'ELSE) \
    (cons 'BEGIN (cdr (car clauses))) \
    (list 'IF \
@@ -4847,27 +4874,36 @@ static const char* lib_code_lang0 = "\
                (syntax-error \"(cond (pred expression...)...)\")) \
              ) clauses) \
    (_cond-helper clauses)))) \
-\
+";
+
+static const char* lib_code_lang1 = " \
 (define (_and-helper preds) \
- (if (null? preds) #t \
-  (cons 'IF \
-   (cons (car preds) \
-    (cons (_and-helper (cdr preds)) (cons #f '())) )))) \
+ (cond ((null? preds) #t) \
+       ((null? (cdr preds)) (car preds)) \
+       (else \
+        `(IF ,(car preds) ,(_and-helper (cdr preds)) #f)))) \
+(define-macro and (lambda preds (_and-helper preds))) \
 \
-(define-macro and \
- (lambda preds (_and-helper preds))) \
+(define (_or-helper preds var) \
+  (cond ((null? preds) #f) \
+        ((null? (cdr preds)) (car preds)) \
+        (else \
+        `(BEGIN (SET! ,var ,(car preds)) \
+                (IF ,var ,var ,(_or-helper (cdr preds) var)))))) \
 \
-(define (_or-helper preds) \
- (if (null? preds) #f \
-  (cons 'IF \
-   (cons (car preds) \
-    (cons #t (cons (_or-helper (cdr preds)) '()) ))))) \
+(define-macro or (lambda preds \
+    (let ((var (gensym))) \
+     `(LET ((,var '())) ,(_or-helper preds var))))) \
+\
+(define-macro case (lambda (key . clauses) \
+   (let ((expr (gensym))) \
+     `(let ((,expr ,key)) \
+         ,(cons 'COND (map1 (lambda (entry) \
+                       (cons (if (pair? (car entry)) \
+                                  `(memv ,expr (quote ,(car entry))) \
+                                 (car entry)) \
+                            (cdr entry))) clauses)))))) \
 \
-(define-macro or \
- (lambda preds (_or-helper preds))) \
-";
-
-static const char* lib_code_lang1 = " \
 (define-macro push \
  (lambda (v l) \
    `(begin (set! ,l (cons ,v ,l)) ,l))) \
@@ -4906,7 +4942,7 @@ static const char* lib_code_lang1 = " \
   (cons 'DEFINE  (cons (list (string->symbol (string-append \"C\" text \"R\")) 'pair) \
         (_expand-mnemonic-body (string->list text))))) \
 \
-(define-macro _mnemonic-accessors (lambda args (cons 'BEGIN (map1 _expand-mnemonic args '())))) \
+(define-macro _mnemonic-accessors (lambda args (cons 'BEGIN (map1 _expand-mnemonic args)))) \
 ";
 
 static const char* lib_code_lists = " \
@@ -4926,21 +4962,21 @@ static const char* lib_code_lists = " \
  (define (helper lists result) \
   (if (some? null? lists) \
    (reverse! result) \
-   (helper (map1 cdr lists '()) \
-    (cons (apply proc (map1 car lists '())) result)))) \
+   (helper (map1 cdr lists) \
+    (cons (apply proc (map1 car lists)) result)))) \
  (helper rest '())) \
 \
 (define (for-each proc . rest) \
  (define (helper lists) \
   (if (some? null? lists) \
    '() \
    (begin \
-    (apply proc (map1 car lists '())) \
-    (helper (map1 cdr lists '()))))) \
+    (apply proc (map1 car lists)) \
+    (helper (map1 cdr lists))))) \
  (helper rest)) \
 \
 (define (_assoc key list eq?) \
- (if (null? list) '() \
+ (if (null? list) #f \
   (let ((pair (car list))) \
     (if (and (pair? pair) (eq? key (car pair))) \
         pair \
@@ -5061,7 +5097,7 @@ static const char* lib_code_sequence = " \
 (define (vector-binary-search v key< unwrap-key key) \
   (define (helper low high mid) \
     (if (<= (- high low) 1) \
-        (if (key< (unwrap-key (vector-ref v low)) key) '() (vector-ref v low)) \
+        (if (key< (unwrap-key (vector-ref v low)) key) #f (vector-ref v low)) \
         (begin \
           (set! mid (+ low (quotient (- high low) 2))) \
           (if (key< key (unwrap-key (vector-ref v mid))) \
@@ -5096,14 +5132,13 @@ static const char* lib_code_sequence = " \
 \
 (define (sort list cmp) (vector->list (sort! (list->vector list) cmp))) \
 \
-(define-macro assert \
- (lambda (body) \
+(define-macro assert (lambda (body) \
   `(if ,body '() \
       (begin \
        (display (quote ,body)) \
        (error \" assert failed\"))))) \
 \
-(define-macro =>  \
+(define-macro ==>  \
  (lambda (test expected) \
   `(assert (equal? ,test (quote ,expected))) )) \
 ";

repl.c

@@ -45,6 +45,14 @@ int main(int argc, const char* argv[])
         ctx
     );
 
+    // Load as a macro is called "include" and can be used to load files containing macros.
+    lisp_table_set(
+            lisp_macro_table(ctx),
+            lisp_make_symbol("INCLUDE", ctx),
+            lisp_make_func(sch_load),
+            ctx
+    );
+
     clock_t start_time, end_time;
 
     if (file_path)
@@ -59,7 +67,7 @@ int main(int argc, const char* argv[])
 
         if (!file)
         {
-            fprintf(stderr, "failed to open: %s", argv[1]);
+            fprintf(stderr, "failed to open: %s", file_path);
             return 2;
         }