load library.scm before contribs

Makefile

@@ -1,34 +1,7 @@
-LIBPICRIN_SRCS = \
-	lib/blob.c\
-	lib/bool.c\
-	lib/char.c\
-	lib/cont.c\
-	lib/data.c\
-	lib/debug.c\
-	lib/dict.c\
-	lib/error.c\
-	lib/gc.c\
-	lib/number.c\
-	lib/pair.c\
-	lib/port.c\
-	lib/proc.c\
-	lib/record.c\
-	lib/state.c\
-	lib/string.c\
-	lib/symbol.c\
-	lib/var.c\
-	lib/vector.c\
-	lib/weak.c\
-	lib/ext/boot.c\
-	lib/ext/lib.c\
-	lib/ext/file.c\
-	lib/ext/load.c\
-	lib/ext/read.c\
-	lib/ext/write.c
-LIBPICRIN_OBJS = $(LIBPICRIN_SRCS:.c=.o)
-
 PICRIN_SRCS = \
 	src/main.c\
+	src/init_lib.c\
+	src/lib.c\
 	src/load_piclib.c\
 	src/init_contrib.c
 PICRIN_OBJS = \
@@ -45,25 +18,40 @@ REPL_ISSUE_TESTS = $(wildcard t/issue/*.sh)
 
 TEST_RUNNER = picrin
 
-CFLAGS += -I./lib/include -Wall -Wextra
+CFLAGS += -I./lib/include -I./include -Wall -Wextra
 LDFLAGS += -lm
 
 prefix ?= /usr/local
 
-all: CFLAGS += -O2 -g -DNDEBUG=1
-all: picrin
-
-debug: CFLAGS += -O0 -g
-debug: picrin
-
-tiny-picrin: CFLAGS += -O0 -g -DPIC_USE_LIBRARY=0
-tiny-picrin: $(LIBPICRIN_OBJS) src/tiny-main.o
-	$(CC) $(CFLAGS) -o $@ $(LIBPICRIN_OBJS) src/tiny-main.o $(LDFLAGS)
-
 include $(sort $(wildcard contrib/*/nitro.mk))
 
-picrin: $(PICRIN_OBJS) $(CONTRIB_OBJS) $(LIBPICRIN_OBJS)
+all: CFLAGS += -O2 -g -DNDEBUG=1
-	$(CC) $(CFLAGS) -o $@ $(PICRIN_OBJS) $(CONTRIB_OBJS) $(LIBPICRIN_OBJS) $(LDFLAGS)
+all: bootstrap picrin
+
+debug: CFLAGS += -O0 -g
+debug: bootstrap picrin
+
+bootstrap: bin/picrin-bootstrap
+
+bin/picrin-bootstrap:
+	test -f bin/picrin-bootstrap || { $(MAKE) lib/mini-picrin && mv lib/mini-picrin bin/picrin-bootstrap; }
+
+lib/mini-picrin:
+	$(MAKE) -C lib mini-picrin
+
+lib/libpicrin.a:
+	$(MAKE) -C lib libpicrin.a
+
+ext: lib/ext/eval.c
+
+lib/ext/eval.c: piclib/eval.scm
+	bin/picrin-bootstrap -c piclib/eval.scm | bin/picrin-bootstrap tools/mkeval.scm > lib/ext/eval.c
+
+picrin: $(PICRIN_OBJS) $(CONTRIB_OBJS) ext lib/libpicrin.a
+	$(CC) $(CFLAGS) -o $@ $(PICRIN_OBJS) $(CONTRIB_OBJS) lib/libpicrin.a $(LDFLAGS)
+
+src/init_lib.c: piclib/library.scm
+	cat piclib/library.scm | bin/picrin-bootstrap tools/mklib.scm > src/init_lib.c
 
 src/load_piclib.c: $(CONTRIB_LIBS)
 	perl tools/mkloader.pl $(CONTRIB_LIBS) > $@
@@ -71,14 +59,7 @@ src/load_piclib.c: $(CONTRIB_LIBS)
 src/init_contrib.c:
 	perl tools/mkinit.pl $(CONTRIB_INITS) > $@
 
-# FIXME: Undefined symbols error for _emyg_atod and _emyg_dtoa
+$(PICRIN_OBJS) $(CONTRIB_OBJS): lib/include/*.h lib/include/picrin/*.h lib/*.h include/picrin/*.h
-# libpicrin.so: $(LIBPICRIN_OBJS)
-# 	$(CC) -shared $(CFLAGS) -o $@ $(LIBPICRIN_OBJS) $(LDFLAGS)
-
-lib/ext/boot.c: piclib/compile.scm piclib/library.scm
-	cat piclib/compile.scm piclib/library.scm | bin/picrin-bootstrap tools/mkboot.scm > lib/ext/boot.c
-
-$(LIBPICRIN_OBJS) $(PICRIN_OBJS) $(CONTRIB_OBJS): lib/include/picrin.h lib/include/picrin/*.h lib/khash.h lib/object.h lib/state.h
 
 doc: docs/*.rst docs/contrib.rst
 	$(MAKE) -C docs html
@@ -95,8 +76,8 @@ test: test-contribs test-nostdlib test-issue
 
 test-contribs: picrin $(CONTRIB_TESTS)
 
-test-nostdlib: lib/ext/boot.c
+test-nostdlib: ext
-	$(CC) -I./lib -I./lib/include -D'PIC_USE_LIBC=0' -D'PIC_USE_STDIO=0' -D'PIC_USE_WRITE=0' -D'PIC_USE_LIBRARY=0' -D'PIC_USE_EVAL=0' -ffreestanding -nostdlib -Os -fPIC -shared -std=c89 -pedantic -Wall -Wextra -Werror -o libpicrin-tiny.so $(LIBPICRIN_SRCS) etc/libc_polyfill.c -fno-stack-protector
+	$(CC) -I./lib/include -Os -DPIC_USE_LIBC=0 -DPIC_USE_CALLCC=0 -DPIC_USE_FILE=0 -DPIC_USE_READ=0 -DPIC_USE_WRITE=0 -DPIC_USE_EVAL=0 -nostdlib -ffreestanding -fno-stack-protector -shared -pedantic -std=c89 -Wall -Wextra -Werror -o libpicrin-tiny.so $(wildcard lib/*.c)
 	strip libpicrin-tiny.so
 	ls -lh libpicrin-tiny.so
 	rm -f libpicrin-tiny.so
@@ -120,11 +101,11 @@ install: all
 	install -c picrin $(prefix)/bin/picrin
 
 clean:
+	$(MAKE) -C lib clean
 	$(RM) picrin
-	$(RM) src/load_piclib.c src/init_contrib.c lib/ext/boot.c
+	$(RM) src/load_piclib.c src/init_contrib.c src/init_lib.c
-	$(RM) libpicrin.so libpicrin-tiny.so
+	$(RM) libpicrin-tiny.so
-	$(RM) $(LIBPICRIN_OBJS)
 	$(RM) $(PICRIN_OBJS)
 	$(RM) $(CONTRIB_OBJS)
 
-.PHONY: all install clean push test test-r7rs test-contribs test-issue test-picrin-issue test-repl-issue doc $(CONTRIB_TESTS) $(REPL_ISSUE_TESTS)
+.PHONY: all bootstrap ext install clean push test test-r7rs test-contribs test-issue test-picrin-issue test-repl-issue doc $(CONTRIB_TESTS) $(REPL_ISSUE_TESTS)

contrib/10.math/math.c

@@ -1,5 +1,6 @@
 #include "picrin.h"
 #include "picrin/extra.h"
+#include "picrin/lib.h"
 
 #include <math.h>
 

contrib/20.r7rs/nitro.mk

@@ -2,7 +2,6 @@ CONTRIB_INITS += r7rs
 
 CONTRIB_SRCS += \
 	contrib/20.r7rs/src/r7rs.c\
-	contrib/20.r7rs/src/file.c\
 	contrib/20.r7rs/src/load.c\
 	contrib/20.r7rs/src/system.c\
 	contrib/20.r7rs/src/time.c

contrib/20.r7rs/src/file.c

@@ -1,87 +0,0 @@
-/**
- * See Copyright Notice in picrin.h
- */
-
-#include "picrin.h"
-#include "picrin/extra.h"
-
-#include <stdio.h>
-
-PIC_NORETURN static void
-file_error(pic_state *pic, const char *msg)
-{
-  pic_raise(pic, pic_make_error(pic, "file", msg, pic_nil_value(pic)));
-}
-
-static pic_value
-open_file(pic_state *pic, const char *fname, const char *mode)
-{
-  FILE *fp;
-
-  if ((fp = fopen(fname, mode)) == NULL) {
-    file_error(pic, "could not open file...");
-  }
-  return pic_fopen(pic, fp, mode);
-}
-
-pic_value
-pic_file_open_input_file(pic_state *pic)
-{
-  char *fname;
-
-  pic_get_args(pic, "z", &fname);
-
-  return open_file(pic, fname, "r");
-}
-
-pic_value
-pic_file_open_output_file(pic_state *pic)
-{
-  char *fname;
-
-  pic_get_args(pic, "z", &fname);
-
-  return open_file(pic, fname, "w");
-}
-
-pic_value
-pic_file_exists_p(pic_state *pic)
-{
-  char *fname;
-  FILE *fp;
-
-  pic_get_args(pic, "z", &fname);
-
-  fp = fopen(fname, "r");
-  if (fp) {
-    fclose(fp);
-    return pic_true_value(pic);
-  } else {
-    return pic_false_value(pic);
-  }
-}
-
-pic_value
-pic_file_delete(pic_state *pic)
-{
-  char *fname;
-
-  pic_get_args(pic, "z", &fname);
-
-  if (remove(fname) != 0) {
-    file_error(pic, "file cannot be deleted");
-  }
-  return pic_undef_value(pic);
-}
-
-void
-pic_nitro_init_file(pic_state *pic)
-{
-  pic_defun(pic, "scheme.base:open-input-file", pic_file_open_input_file); /* for `include' */
-  pic_defun(pic, "scheme.file:open-input-file", pic_file_open_input_file);
-  pic_defun(pic, "scheme.file:open-binary-input-file", pic_file_open_input_file);
-  pic_defun(pic, "scheme.file:open-output-file", pic_file_open_output_file);
-  pic_defun(pic, "scheme.file:open-binary-output-file", pic_file_open_output_file);
-  pic_defun(pic, "scheme.file:file-exists?", pic_file_exists_p);
-  pic_defun(pic, "scheme.file:delete-file", pic_file_delete);
-}

contrib/20.r7rs/src/load.c

@@ -23,10 +23,12 @@ pic_load_load(pic_state *pic)
 
   port = pic_fopen(pic, fp, "r");
   pic_try {
-    pic_value form;
     size_t ai = pic_enter(pic);
 
-    while (! pic_eof_p(pic, form = pic_read(pic, port))) {
+    while (1) {
+      pic_value form = pic_funcall(pic, "read", 1, port);
+      if (pic_eof_p(pic, form))
+        break;
       pic_funcall(pic, "eval", 1, form);
       pic_leave(pic, ai);
     }

contrib/20.r7rs/src/r7rs.c

@@ -4,7 +4,6 @@
 
 #include "picrin.h"
 
-void pic_nitro_init_file(pic_state *);
 void pic_nitro_init_load(pic_state *);
 void pic_nitro_init_system(pic_state *);
 void pic_nitro_init_time(pic_state *);
@@ -12,7 +11,6 @@ void pic_nitro_init_time(pic_state *);
 void
 pic_nitro_init_r7rs(pic_state *pic)
 {
-  pic_nitro_init_file(pic);
   pic_nitro_init_load(pic);
   pic_nitro_init_system(pic);
   pic_nitro_init_time(pic);

contrib/30.random/src/random.c

@@ -1,5 +1,6 @@
 #include "picrin.h"
 #include "picrin/extra.h"
+#include "picrin/lib.h"
 
 double genrand_real3(void);
 

contrib/30.readline/src/readline.c

@@ -7,6 +7,7 @@ forget to use the C++ extern "C" to get it to compile.
 */
 #include "picrin.h"
 #include "picrin/extra.h"
+#include "picrin/lib.h"
 
 #include <editline/readline.h>
 

contrib/30.regexp/src/regexp.c

@@ -1,5 +1,6 @@
 #include "picrin.h"
 #include "picrin/extra.h"
+#include "picrin/lib.h"
 
 #include <regex.h>
 

include/picrin/lib.h

@@ -0,0 +1,24 @@
+/**
+ * See Copyright Notice in picrin.h
+ */
+
+#ifndef PICRIN_LIB_H
+#define PICRIN_LIB_H
+
+#if defined(__cplusplus)
+extern "C" {
+#endif
+
+/*
+ * library
+ */
+
+void pic_deflibrary(pic_state *, const char *lib);
+void pic_in_library(pic_state *, const char *lib);
+void pic_export(pic_state *, int n, ...);
+
+#if defined(__cplusplus)
+}
+#endif
+
+#endif

lib/Makefile

@@ -39,20 +39,15 @@ LIBPICRIN_HEADERS = \
 
 CFLAGS += -I./include -Wall -Wextra -g
 
-mini-picrin: $(LIBPICRIN_OBJS) ext/main.o
+mini-picrin: ext/main.o libpicrin.a
-	$(CC) $(CFLAGS) -o $@ ext/main.o $(LIBPICRIN_OBJS)
+	$(CC) $(CFLAGS) -o $@ ext/main.o libpicrin.a
 
-libpicrin.so: CFLAGS += -fPIC
+libpicrin.a: $(LIBPICRIN_OBJS)
-libpicrin.so: $(LIBPICRIN_OBJS)
+	$(AR) $(ARFLAGS) $@ $(LIBPICRIN_OBJS)
-	$(CC) $(CFLAGS) -shared -o $@ $(LIBPICRIN_OBJS) $(LDFLAGS)
-
-libpicrin.so.minimal: $(LIBPICRIN_SRCS)
-	$(CC) -I./include -Os -DPIC_USE_LIBC=0 -DPIC_USE_CALLCC=0 -DPIC_USE_FILE=0 -DPIC_USE_READ=0 -DPIC_USE_WRITE=0 -DPIC_USE_EVAL=0 -nostdlib -ffreestanding -fno-stack-protector -shared -o $@ $(LIBPICRIN_SRCS) $(LDFLAGS)
-	strip $@
 
 $(LIBPICRIN_OBJS): $(LIBPICRIN_HEADERS)
 
 clean:
-	$(RM) $(LIBPICRIN_OBJS) ext/main.o mini-picrin libpicrin.so libpicrin.so.minimal
+	$(RM) $(LIBPICRIN_OBJS) ext/main.o mini-picrin libpicrin.a
 
 .PHONY: clean

lib/cont.c

@@ -41,7 +41,7 @@ cont_call(pic_state *pic)
   }
   pic->cxt = cxt;
 
-  PIC_LONGJMP(cxt->jmp, 1);
+  longjmp(cxt->jmp, 1);
   PIC_UNREACHABLE();
 }
 

lib/include/picrin/setup.h

@@ -42,10 +42,9 @@
 # include <setjmp.h>
 # define PIC_JMPBUF jmp_buf
 # define PIC_SETJMP(buf) setjmp(buf)
-# define PIC_LONGJMP(buf, val) longjmp((buf), (val))
 #else
 # define PIC_JMPBUF char
-# define PIC_SETJMP(buf) 0
+# define PIC_SETJMP(buf) ((void)(buf), 0)
 #endif
 
 #ifndef PIC_ABORT

lib/load.c

@@ -56,9 +56,10 @@ assemble(pic_state *pic, pic_value as)
   i = 0;
   /* TODO: validate operands */
   pic_for_each (r, codes, it) {
+    pic_value op;
     if (! pic_pair_p(pic, r))
       continue;
-    pic_value op = pic_car(pic, r);
+    op = pic_car(pic, r);
     if (pic_eq_p(pic, op, pic_intern_lit(pic, "HALT"))) {
       code[i++] = OP_HALT;
     }

lib/object.h

@@ -92,7 +92,7 @@ enum {
   OP_LOADF = 0x0A,        /* 0x0A 0x**            OP_LOADF dest     */
   OP_LOADN = 0x0B,        /* 0x0B 0x**            OP_LOADN dest     */
   OP_LOADU = 0x0C,        /* 0x0C 0x**            OP_LOADU dest     */
-  OP_LOADI = 0x0D,        /* 0x0D 0x** 0x**       OP_LOADI dest i   */
+  OP_LOADI = 0x0D         /* 0x0D 0x** 0x**       OP_LOADI dest i   */
 };
 
 typedef unsigned char code_t;

piclib/library.scm

@@ -93,9 +93,10 @@
                (lambda (expr)
                  (let ((exprs (if (and (pair? expr) (eq? (car expr) 'begin))
                                   (cdr expr)
-                                  (list expr))))
+                                  (list expr)))
+                       (env (library-environment name)))
                    (for-each
-                    (lambda (e) (eval e name))
+                    (lambda (e) (eval e env))
                     exprs)))
                body)))))
 
@@ -122,7 +123,7 @@
               (if (null? clauses)
                   #undefined
                   (if (test (caar clauses))
-                      `(,(make-identifier 'begin default-environment) ,@(cdar clauses))
+                      `(,(make-identifier 'begin (default-environment)) ,@(cdar clauses))
                       (loop (cdr clauses))))))))
 
       (define-transformer 'import
@@ -206,7 +207,7 @@
 
     (let ()
       (make-library '(picrin base))
-      (set-car! (dictionary-ref *libraries* (mangle '(picrin base))) default-environment)
+      (set-car! (dictionary-ref *libraries* (mangle '(picrin base))) (default-environment))
       (let* ((exports
               (library-exports '(picrin base)))
              (export-keyword
@@ -222,12 +223,6 @@
                      do when unless
                      parameterize define-record-type))
         (dictionary-for-each export-keyword (global-objects)))
-      (set! eval
-            (let ((e eval))
-              (lambda (expr . lib)
-                (let ((lib (if (null? lib) (current-library) (car lib))))
-                  (parameterize ((current-library lib))
-                    (e expr (library-environment lib)))))))
       (make-library '(picrin user)))
 
     (values current-library

src/lib.c

@@ -0,0 +1,40 @@
+/**
+ * See Copyright Notice in picrin.h
+ */
+
+#include "picrin.h"
+#include "picrin/extra.h"
+
+void
+pic_deflibrary(pic_state *pic, const char *lib)
+{
+  pic_value name = pic_intern_cstr(pic, lib), v;
+
+  v = pic_funcall(pic, "find-library", 1, name);
+  if (! pic_bool(pic, v)) {
+    pic_funcall(pic, "make-library", 1, name);
+  }
+}
+
+void
+pic_in_library(pic_state *pic, const char *lib)
+{
+  pic_value name = pic_intern_cstr(pic, lib);
+
+  pic_funcall(pic, "current-library", 1, name);
+}
+
+void
+pic_export(pic_state *pic, int n, ...)
+{
+  size_t ai = pic_enter(pic);
+  va_list ap;
+
+  va_start(ap, n);
+  while (n--) {
+    pic_value var = pic_intern_cstr(pic, va_arg(ap, const char *));
+    pic_funcall(pic, "library-export", 2, var, var);
+  }
+  va_end(ap);
+  pic_leave(pic, ai);
+}

src/main.c

@@ -8,9 +8,11 @@
 void
 pic_init_picrin(pic_state *pic)
 {
+  void pic_init_lib(pic_state *);
   void pic_init_contrib(pic_state *);
   void pic_load_piclib(pic_state *);
 
+  pic_init_lib(pic);
   pic_init_contrib(pic);
   pic_load_piclib(pic);
 }

src/tiny-main.c

@@ -1,39 +0,0 @@
-/**
- * See Copyright Notice in picrin.h
- */
-
-#include "picrin.h"
-#include "picrin/extra.h"
-
-int
-main()
-{
-  pic_state *pic;
-  pic_value e, form;
-  int status;
-
-  pic = pic_open(pic_default_allocf, NULL);
-
-  pic_try {
-    while (1) {
-      size_t ai = pic_enter(pic);
-      pic_printf(pic, "> ");
-      form = pic_read(pic, pic_stdin(pic));
-      if (pic_eof_p(pic, form)) {
-        break;
-      }
-      pic_printf(pic, "~s\n", pic_funcall(pic, "eval", 1, form));
-      pic_leave(pic, ai);
-    }
-
-    status = 0;
-  }
-  pic_catch(e) {
-    pic_print_error(pic, pic_stderr(pic), e);
-    status = 1;
-  }
-
-  pic_close(pic);
-
-  return status;
-}

tools/mkeval.scm

@@ -1,9 +1,9 @@
-(import (scheme base)
-        (scheme read)
-        (scheme write))
-
 (define (generate-rom)
 
+  (define open-output-string open-output-bytevector)
+  (define (get-output-string port)
+    (list->string (map integer->char (bytevector->list (get-output-bytevector port)))))
+
   (define (with-output-to-string thunk)
     (let ((port (open-output-string)))
       (parameterize ((current-output-port port))
@@ -23,10 +23,10 @@
         (string-for-each
          (lambda (c)
            (case c
-             ((#\\) (write-string "\\\\"))
+             ((#\\) (display "\\\\"))
-             ((#\") (write-string "\\\""))
+             ((#\") (display "\\\""))
-             ((#\newline) (write-string "\\n"))
+             ((#\newline) (display "\\n"))
-             (else (write-char c))))
+             (else (display c))))
          s))))
 
   (define (group-string i s)

tools/mklib.scm

@@ -0,0 +1,64 @@
+(define (generate-rom)
+
+  (define open-output-string open-output-bytevector)
+  (define (get-output-string port)
+    (list->string (map integer->char (bytevector->list (get-output-bytevector port)))))
+
+  (define (with-output-to-string thunk)
+    (let ((port (open-output-string)))
+      (parameterize ((current-output-port port))
+        (thunk)
+        (let ((s (get-output-string port)))
+          (close-port port)
+          s))))
+
+  (define text
+    (with-output-to-string
+      (lambda ()
+        (write (read)))))
+
+  (define (escape-string s)
+    (with-output-to-string
+      (lambda ()
+        (string-for-each
+         (lambda (c)
+           (case c
+             ((#\\) (display "\\\\"))
+             ((#\") (display "\\\""))
+             ((#\newline) (display "\\n"))
+             (else (display c))))
+         s))))
+
+  (define (group-string i s)
+    (let loop ((t s) (n (string-length s)) (acc '()))
+      (if (= n 0)
+          (reverse acc)
+          (if (< n i)
+              (loop "" 0 (cons t acc))
+              (loop (string-copy t i) (- n i) (cons (string-copy t 0 i) acc))))))
+
+  (define lines (map escape-string (group-string 80 text)))
+
+  (let loop ((lines lines) (acc ""))
+       (if (null? lines)
+           acc
+           (loop (cdr lines) (string-append acc "\"" (car lines) "\",\n")))))
+
+
+(for-each
+ display
+ `("#include \"picrin.h\"\n"
+   "#include \"picrin/extra.h\"\n"
+   "\n"
+   "static const char lib_rom[][80] = {\n"
+   ,(generate-rom)
+   "};\n"
+   "\n"
+   "void\n"
+   "pic_init_lib(pic_state *PIC_UNUSED(pic))\n"
+   "{\n"
+   "  pic_value port;\n"
+   "  port = pic_fmemopen(pic, &lib_rom[0][0], strlen(&lib_rom[0][0]), \"r\");\n"
+   "  pic_funcall(pic, \"eval\", 1, pic_funcall(pic, \"read\", 1, port));\n"
+   "}\n"))
+

tools/mkloader.pl

@@ -21,9 +21,11 @@ pic_eval_native(pic_state *pic, const char *str)
 
   pic_try {
     size_t ai = pic_enter(pic);
-    pic_value form;
 
-    while (! pic_eof_p(pic, form = pic_read(pic, port))) {
+    while (1) {
+      pic_value form = pic_funcall(pic, "read", 1, port);
+      if (pic_eof_p(pic, form))
+        break;
       pic_funcall(pic, "eval", 1, form);
       pic_leave(pic, ai);
     }