Merge branch 'master' of github.com:picrin-scheme/picrin
This commit is contained in:
commit
2f8c5a7689
|
@ -0,0 +1,9 @@
|
||||||
|
file(GLOB OPTIONAL_FILES ${PROJECT_SOURCE_DIR}/contrib/10.optional/piclib/*.scm)
|
||||||
|
list(APPEND PICLIB_CONTRIB_LIBS ${OPTIONAL_FILES})
|
||||||
|
add_custom_target(test-optional
|
||||||
|
for test in ${PROJECT_SOURCE_DIR}/contrib/10.optional/t/*.scm \;
|
||||||
|
do
|
||||||
|
bin/picrin "$$test" \;
|
||||||
|
done
|
||||||
|
DEPENDS repl)
|
||||||
|
set(CONTRIB_TESTS ${CONTRIB_TESTS} test-optional)
|
|
@ -0,0 +1,24 @@
|
||||||
|
(define-library (picrin optional)
|
||||||
|
(import (scheme base))
|
||||||
|
|
||||||
|
(define-syntax optional
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ args default)
|
||||||
|
(let ((t args))
|
||||||
|
(if (null? t) default (car t))))))
|
||||||
|
|
||||||
|
(define-syntax let-optionals*
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ args () body ...)
|
||||||
|
(begin body ...))
|
||||||
|
((_ args ((var default) . tail) body ...)
|
||||||
|
(let* ((t args)
|
||||||
|
(var (if (null? t) default (car t)))
|
||||||
|
(remain (if (null? t) '() (cdr t))))
|
||||||
|
(let-optionals* remain tail body ...)))
|
||||||
|
((_ args rest body ...)
|
||||||
|
(let ((rest args))
|
||||||
|
body ...))))
|
||||||
|
|
||||||
|
(export optional
|
||||||
|
let-optionals*))
|
|
@ -0,0 +1,15 @@
|
||||||
|
(import (scheme base)
|
||||||
|
(picrin optional)
|
||||||
|
(picrin test))
|
||||||
|
|
||||||
|
(test 0 (optional '() 0))
|
||||||
|
(test 1 (optional '(1) 0))
|
||||||
|
|
||||||
|
(test '(0 0) (let-optionals* '() ((a 0) (b 0)) (list a b)))
|
||||||
|
(test '(1 0) (let-optionals* '(1) ((a 0) (b 0)) (list a b)))
|
||||||
|
(test '(1 2) (let-optionals* '(1 2) ((a 0) (b 0)) (list a b)))
|
||||||
|
(test '(1 1) (let-optionals* '(1) ((a 0) (b a)) (list a b)))
|
||||||
|
|
||||||
|
(test '(0 ()) (let-optionals* '() ((a 0) . r) (list a r)))
|
||||||
|
(test '(1 ()) (let-optionals* '(1) ((a 0) . r) (list a r)))
|
||||||
|
(test '(1 (2)) (let-optionals* '(1 2) ((a 0) . r) (list a r)))
|
|
@ -1 +1,3 @@
|
||||||
list(APPEND PICLIB_CONTRIB_LIBS ${PROJECT_SOURCE_DIR}/contrib/20.repl/repl.scm)
|
list(APPEND PICLIB_CONTRIB_LIBS ${PROJECT_SOURCE_DIR}/contrib/20.repl/repl.scm)
|
||||||
|
list(APPEND PICRIN_CONTRIB_SOURCES ${PROJECT_SOURCE_DIR}/contrib/20.repl/repl.c)
|
||||||
|
list(APPEND PICRIN_CONTRIB_INITS repl)
|
||||||
|
|
|
@ -0,0 +1,21 @@
|
||||||
|
#include "picrin.h"
|
||||||
|
|
||||||
|
#include <unistd.h>
|
||||||
|
|
||||||
|
|
||||||
|
static pic_value
|
||||||
|
pic_repl_tty_p(pic_state *pic)
|
||||||
|
{
|
||||||
|
|
||||||
|
pic_get_args(pic, "");
|
||||||
|
|
||||||
|
return pic_bool_value((isatty(STDIN_FILENO)));
|
||||||
|
}
|
||||||
|
|
||||||
|
void
|
||||||
|
pic_init_repl(pic_state *pic)
|
||||||
|
{
|
||||||
|
pic_deflibrary (pic, "(picrin repl)") {
|
||||||
|
pic_defun(pic, "tty?", pic_repl_tty_p);
|
||||||
|
}
|
||||||
|
}
|
|
@ -11,7 +11,7 @@
|
||||||
(else
|
(else
|
||||||
(begin
|
(begin
|
||||||
(define (readline str)
|
(define (readline str)
|
||||||
(display str)
|
(if (tty?) (display str))
|
||||||
(read-line))
|
(read-line))
|
||||||
(define (add-history str)
|
(define (add-history str)
|
||||||
#f))))
|
#f))))
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
Subproject commit a22eef106077850db7dd2d9da5703a4d0b3b9ffe
|
Subproject commit 15889a5feb515bd67ee7dc2c6419d16703151a54
|
Loading…
Reference in New Issue