removed message-case from a file and included it in libchezio.ss
This commit is contained in:
parent
1c35c6939d
commit
c5e1221ace
|
@ -94,12 +94,12 @@ setlocal nowinfixwidth
|
|||
setlocal wrap
|
||||
setlocal wrapmargin=0
|
||||
silent! normal! zE
|
||||
let s:l = 678 - ((19 * winheight(0) + 17) / 34)
|
||||
let s:l = 3 - ((2 * winheight(0) + 15) / 31)
|
||||
if s:l < 1 | let s:l = 1 | endif
|
||||
exe s:l
|
||||
normal! zt
|
||||
678
|
||||
normal! 011l
|
||||
3
|
||||
normal! 0
|
||||
let &so = s:so_save | let &siso = s:siso_save
|
||||
doautoall SessionLoadPost
|
||||
" vim: set ft=vim :
|
||||
|
|
|
@ -94,12 +94,12 @@ setlocal nowinfixwidth
|
|||
setlocal wrap
|
||||
setlocal wrapmargin=0
|
||||
silent! normal! zE
|
||||
let s:l = 120 - ((0 * winheight(0) + 17) / 35)
|
||||
let s:l = 28 - ((15 * winheight(0) + 17) / 34)
|
||||
if s:l < 1 | let s:l = 1 | endif
|
||||
exe s:l
|
||||
normal! zt
|
||||
120
|
||||
normal! 0
|
||||
28
|
||||
normal! 034l
|
||||
let &so = s:so_save | let &siso = s:siso_save
|
||||
doautoall SessionLoadPost
|
||||
" vim: set ft=vim :
|
||||
|
|
BIN
lib/ikarus.boot
BIN
lib/ikarus.boot
Binary file not shown.
|
@ -1,8 +1,27 @@
|
|||
|
||||
|
||||
(let ()
|
||||
;;;
|
||||
;;; GENERIC PORTS: BASIC PRIMITIVES
|
||||
(define-syntax message-case
|
||||
(syntax-rules (else)
|
||||
[(_ msg args
|
||||
[(msg-name msg-arg* ...) b b* ...] ...
|
||||
[else else1 else2 ...])
|
||||
(let ([tmsg msg] [targs args])
|
||||
(define-syntax match-and-bind
|
||||
(syntax-rules ()
|
||||
[(__ y () body)
|
||||
(if (null? y)
|
||||
body
|
||||
(error 'message-case "unmatched ~s" (cons tmsg targs)))]
|
||||
[(__ y (a a* (... ...)) body)
|
||||
(if (pair? y)
|
||||
(let ([a (car y)] [d (cdr y)])
|
||||
(match-and-bind d (a* (... ...)) body))
|
||||
(error 'message-case "unmatched ~s" (cons tmsg targs)))]))
|
||||
(case tmsg
|
||||
[(msg-name)
|
||||
(match-and-bind targs (msg-arg* ...) (begin b b* ...))] ...
|
||||
[else else1 else2 ...]))]))
|
||||
|
||||
(let () ;;; GENERIC PORTS: BASIC PRIMITIVES
|
||||
;;;
|
||||
;;; Exports:
|
||||
;;; * Constructors:
|
||||
|
@ -214,9 +233,7 @@
|
|||
(error 'set-port-output-size! "~s is not a valid size" i))
|
||||
(error 'set-port-output-size! "~s is not an output-port" p)))))
|
||||
|
||||
|
||||
(let ()
|
||||
;;; IO PRIMITIVES
|
||||
(let () ;;; IO PRIMITIVES
|
||||
;;;
|
||||
(primitive-set! '$write-char
|
||||
(lambda (c p)
|
||||
|
@ -372,9 +389,8 @@
|
|||
($flush-output-port p)
|
||||
(error 'flush-output-port "~s is not an output-port" p))])))
|
||||
|
||||
(let ()
|
||||
;;; INPUT FILES
|
||||
(include "message-case.ss")
|
||||
(let () ;;; INPUT FILES
|
||||
;;;
|
||||
(define make-input-file-handler
|
||||
(lambda (fd port-name)
|
||||
(let ((open? #t))
|
||||
|
@ -476,10 +492,8 @@
|
|||
(open-input-file filename)
|
||||
(error 'open-input-file "~s is not a string" filename)))))
|
||||
|
||||
|
||||
(let ()
|
||||
;;; OUTPUT FILES
|
||||
(include "message-case.ss")
|
||||
(let () ;;; OUTPUT FILES
|
||||
;;;
|
||||
(define do-write-buffer
|
||||
(lambda (fd port-name p caller)
|
||||
(let ([bytes (foreign-call "ikrt_write_file"
|
||||
|
@ -578,10 +592,8 @@
|
|||
(open-output-file filename options)
|
||||
(error 'open-output-file "~s is not a string" filename))])))
|
||||
|
||||
|
||||
(let ()
|
||||
(include "message-case.ss")
|
||||
;;; OUTPUT STRINGS
|
||||
(let () ;;; OUTPUT STRINGS
|
||||
;;;
|
||||
(define string-copy
|
||||
(lambda (s)
|
||||
(substring s 0 (string-length s))))
|
||||
|
@ -730,4 +742,4 @@
|
|||
(lambda ()
|
||||
(close-input-port p)
|
||||
(set! shot #t))))))
|
||||
|
||||
)
|
||||
|
|
|
@ -1,24 +0,0 @@
|
|||
|
||||
|
||||
(define-syntax message-case
|
||||
(syntax-rules (else)
|
||||
[(_ msg args
|
||||
[(msg-name msg-arg* ...) b b* ...] ...
|
||||
[else else1 else2 ...])
|
||||
(let ([tmsg msg] [targs args])
|
||||
(define-syntax match-and-bind
|
||||
(syntax-rules ()
|
||||
[(__ y () body)
|
||||
(if (null? y)
|
||||
body
|
||||
(error 'message-case "unmatched ~s" (cons tmsg targs)))]
|
||||
[(__ y (a a* (... ...)) body)
|
||||
(if (pair? y)
|
||||
(let ([a (car y)] [d (cdr y)])
|
||||
(match-and-bind d (a* (... ...)) body))
|
||||
(error 'message-case "unmatched ~s" (cons tmsg targs)))]))
|
||||
(case tmsg
|
||||
[(msg-name)
|
||||
(match-and-bind targs (msg-arg* ...) (begin b b* ...))] ...
|
||||
[else else1 else2 ...]))]))
|
||||
|
Loading…
Reference in New Issue