making os name symbols non-constant, so they aren't evaluated at compile time

more aliases

femtolisp/aliases.scm

@@ -19,6 +19,12 @@
   (let (($gensym gensym))
     (lambda ((x #f)) ($gensym))))
 
+(define-macro (begin0 first . rest)
+  (let ((g (gensym)))
+    `(let ((,g ,first))
+       ,@rest
+       ,g)))
+
 (define vector-ref aref)
 (define vector-set! aset!)
 (define vector-length length)
@@ -94,11 +100,13 @@
 
 (define (input-port? x) (iostream? x))
 (define (output-port? x) (iostream? x))
+(define (port? x) (iostream? x))
 (define close-input-port io.close)
 (define close-output-port io.close)
 (define (read-char (s *input-stream*)) (io.getc s))
 (define (peek-char (s *input-stream*)) (io.peekc s))
 (define (write-char c (s *output-stream*)) (io.putc s c))
+; TODO: unread-char
 (define (port-eof? p) (io.eof? p))
 (define (open-input-string str)
   (let ((b (buffer)))
@@ -237,3 +245,15 @@
 	(lambda (sym key)
 	  (let ((sp (get *properties* sym #f)))
 	    (and sp (has? sp key) (del! sp key))))))
+
+; --- gambit
+#|
+(define (with-exception-catcher hand thk)
+  (trycatch (thk)
+	    (lambda (e) (hand e))))
+
+(define make-table table)
+(define table-ref get)
+(define table-set! put!)
+(define read-line io.readline)
+|#

femtolisp/flisp.boot

@@ -29,14 +29,14 @@
 								  *output-stream*
 								  copy-list])  catch #fn("7000r2c0qe13041;" [#fn("@000r1c0\x7fc1|L1c2c3c4|L2c5c6|L2c7c8L2L3c5c9|L2~L3L4c:|L2c;|L2L4L3L3;" [trycatch
   lambda if and pair? eq car quote thrown-value cadr caddr raise]) gensym]))
-	  *whitespace* "\t\n\v\f\r \u0085\u00a0\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u2028\u2029\u202f\u205f\u3000"
+	  *whitespace* "\t\n\v\f\r \u0085  ᠎           \u2028\u2029  　" 1+
-	  1+ #fn("7000r1|aw;" [] 1+) 1-
+	  #fn("7000r1|aw;" [] 1+) 1- #fn("7000r1|ax;" [] 1-) 1arg-lambda?
-	  #fn("7000r1|ax;" [] 1-) 1arg-lambda? #fn("8000r1|F16T02|Mc0<16J02|NF16B02|\x84F16:02e1|\x84a42;" [lambda
+	  #fn("8000r1|F16T02|Mc0<16J02|NF16B02|\x84F16:02e1|\x84a42;" [lambda
   length=] 1arg-lambda?)
 	  <= #fn("7000r2|}X17602|}W;" [] <=) >
 	  #fn("7000r2}|X;" [] >) >= #fn("7000r2}|X17602|}W;" [] >=)
 	  Instructions #table(not 16  vargc 67  load1 49  = 39  setc.l 64  sub2 72  brne.l 83  largc 74  brnn 85  loadc.l 58  loadi8 50  < 40  nop 0  set-cdr! 32  loada 55  bound? 21  / 37  neg 73  brn.l 88  lvargc 75  brt 7  trycatch 68  null? 17  load0 48  jmp.l 8  loadv 51  seta 61  keyargs 91  * 36  function? 26  builtin? 23  aref 43  optargs 89  vector? 24  loadt 45  brf 6  symbol? 19  cdr 30  for 69  loadc00 78  pop 2  pair? 22  cadr 84  closure 65  loadf 46  compare 41  loadv.l 52  setg.l 60  brn 87  eqv? 13  aset! 44  eq? 12  atom? 15  boolean? 18  brt.l 10  tapply 70  dummy_nil 94  loada0 76  brbound 90  list 28  dup 1  apply 33  loadc 57  loadc01 79  dummy_t 92  setg 59  loada1 77  tcall.l 81  jmp 5  fixnum? 25  cons 27  loadg.l 54  tcall 4  call 3  - 35  brf.l 9  + 34  dummy_f 93  add2 71  seta.l 62  loadnil 47  brnn.l 86  setc 63  set-car! 31  vector 42  loadg 53  loada.l 56  argc 66  div0 38  ret 11  number? 20  equal? 14  car 29  call.l 80  brne 82)
-	  __init_globals #fn("7000r0c0c1<17B02c0c2<17802c0c3<6>0c4k52c6k75;0c8k52c9k72e:k;2e<k=2e>k?;" [macos
+	  __init_globals #fn("7000r0c0c1<17B02c0c2<17802c0c3<6>0c4k52c6k75;0c8k52c9k72e:k;2e<k=2e>k?;" [linux
   win32 win64 windows "\\" *directory-separator* "\r\n" *linefeed* "/" "\n"
   *stdout* *output-stream* *stdin* *input-stream* *stderr* *error-stream*] __init_globals)
 	  __script #fn("7000r1c0qc1t;" [#fn("7000r0e0~41;" [load])

femtolisp/flisp.c

@@ -814,7 +814,7 @@ static value_t do_trycatch()
 /*
   argument layout on stack is
   |--required args--|--opt args--|--kw args--|--rest args...
- */
+*/
 static uint32_t process_keys(value_t kwtable,
                              uint32_t nreq, uint32_t nkw, uint32_t nopt,
                              uint32_t bp, uint32_t nargs, int va)
@@ -2215,13 +2215,13 @@ static void lisp_init(void)
     setc(symbol("top-level-bound?"), builtin(OP_BOUNDP));
 
 #ifdef LINUX
-    setc(symbol("*os-name*"), symbol("linux"));
+    set(symbol("*os-name*"), symbol("linux"));
 #elif defined(WIN32) || defined(WIN64)
-    setc(symbol("*os-name*"), symbol("win32"));
+    set(symbol("*os-name*"), symbol("win32"));
 #elif defined(MACOSX)
-    setc(symbol("*os-name*"), symbol("macos"));
+    set(symbol("*os-name*"), symbol("macos"));
 #else
-    setc(symbol("*os-name*"), symbol("unknown"));
+    set(symbol("*os-name*"), symbol("unknown"));
 #endif
 
     the_empty_vector = tagptr(alloc_words(1), TAG_VECTOR);

femtolisp/system.lsp

@@ -22,8 +22,8 @@
      (prog1 acc
       (while (pair? lst)
 	     (begin (set! acc
-					  (cdr (set-cdr! acc (cons (f (car lst)) ()))))
+			  (cdr (set-cdr! acc (cons (f (car lst)) ()))))
-				(set! lst (cdr lst)))))))
+		    (set! lst (cdr lst)))))))
   (define (mapn f lsts)
     (if (null? (car lsts))
 	()