Added unless

scheme/base.sld

@@ -112,6 +112,7 @@
     cond-expand
     do
     when
+    unless
     quasiquote
     floor
     ceiling
@@ -123,40 +124,6 @@
 ;;;;
 ; Possibly missing functions:
 ;
-;    ; TODO: error-object-irritants
-;    ; TODO: error-object-message
-;    ; TODO: error-object?
-;    ; TODO: file-error?
-;    ; TODO: read-error?
-;    ;(Cyc-bin-op cmp x lst)
-;    ;(Cyc-bin-op-char cmp c cs)
-;    ;=>
-;    ;bytevector-u8-set!
-;    ;current-error-port
-;    ;define-values
-;    ;error-object-irritants
-;    ;error-object-message
-;    ;error-object?
-;    ;file-error?
-;    ;guard
-;    ;import
-;    ;include-ci
-;    ;let-syntax
-;    ;letrec-syntax
-;    ;list-set!
-;    ;peek-u8
-;    ;port?
-;    ;raise
-;    ;raise-continuable
-;    ;read-bytevector!
-;    ;read-error?
-;    ;read-u8
-;    ;symbol=?
-;    ;syntax-rules
-;    ;u8-ready?
-;    ;unquote
-;    ;unquote-splicing
-;    ;write-u8
 ;    binary-port?
 ;    bytevector
 ;    bytevector-append
@@ -164,42 +131,29 @@
 ;    bytevector-copy!
 ;    bytevector-length
 ;    bytevector-u8-ref
+;    bytevector-u8-set!
 ;    bytevector?
-;    char->integer
-;    char-ready?
-;    close-input-port
-;    close-output-port
-;    close-port
 ;    complex?
-;    current-error-port
 ;    define-record-type
+;    define-values
 ;    denominator
 ;    eof-object
-;    eof-object?
-;    eq?
-;    equal?
-;    eqv?
-;    exact-integer-sqrt
-;    foldl
-;    foldr
 ;    get-output-bytevector
 ;    get-output-string
+;    guard
+;    import
 ;    include
 ;    input-port-open?
 ;    input-port?
-;    integer->char
-;    integer?
-;    length
 ;    let*-values
+;    let-syntax
 ;    let-values
 ;    letrec*
+;    letrec-syntax
 ;    list->string
 ;    list->vector
 ;    list-set!
 ;    make-bytevector
-;    make-vector
-;    number->string
-;    number?
 ;    numerator
 ;    open-input-bytevector
 ;    open-input-string
@@ -207,41 +161,26 @@
 ;    open-output-string
 ;    output-port-open?
 ;    output-port?
-;    pair?
 ;    parameterize
-;    peek-char
-;    procedure?
-;    quotient
+;    peek-u8
 ;    raise
 ;    raise-continuable
 ;    rational?
 ;    rationalize
 ;    read-bytevector
-;    read-char
+;    read-bytevector!
 ;    read-string
-;    real?
+;    read-u8
 ;    record?
-;    remainder
-;    string->number
-;    string->symbol
 ;    string->utf8
-;    string-append
-;    string-length
-;    string-ref
-;    string?
-;    substring
-;    symbol->string
-;    symbol=?
-;    symbol?
 ;    syntax-error
+;    syntax-rules
 ;    textual-port?
-;    unless
+;    u8-ready?
 ;    utf8->string
-;    vector-length
-;    vector-ref
-;    vector?
 ;    write-bytevector
 ;    write-string
+;    write-u8
 ;;;;
   )
   (begin
@@ -423,6 +362,14 @@
           `(if ,(cadr exp)
                ((lambda () ,@(cddr exp)))
                #f))))
+    (define-syntax unless
+      (er-macro-transformer
+        (lambda (exp rename compare)
+          (if (null? (cdr exp)) (error "empty unless" exp))
+          (if (null? (cddr exp)) (error "no unless body" exp))
+          `(if ,(cadr exp)
+               #f
+               ((lambda () ,@(cddr exp)))))))
   (define-syntax do
     (er-macro-transformer
      (lambda (expr rename compare)