removed message-case from a file and included it in libchezio.ss

This commit is contained in:
Abdulaziz Ghuloum 2006-12-05 14:06:13 -05:00
parent 1c35c6939d
commit c5e1221ace
5 changed files with 737 additions and 749 deletions

View File

@ -94,12 +94,12 @@ setlocal nowinfixwidth
setlocal wrap setlocal wrap
setlocal wrapmargin=0 setlocal wrapmargin=0
silent! normal! zE 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 if s:l < 1 | let s:l = 1 | endif
exe s:l exe s:l
normal! zt normal! zt
678 3
normal! 011l normal! 0
let &so = s:so_save | let &siso = s:siso_save let &so = s:so_save | let &siso = s:siso_save
doautoall SessionLoadPost doautoall SessionLoadPost
" vim: set ft=vim : " vim: set ft=vim :

View File

@ -94,12 +94,12 @@ setlocal nowinfixwidth
setlocal wrap setlocal wrap
setlocal wrapmargin=0 setlocal wrapmargin=0
silent! normal! zE 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 if s:l < 1 | let s:l = 1 | endif
exe s:l exe s:l
normal! zt normal! zt
120 28
normal! 0 normal! 034l
let &so = s:so_save | let &siso = s:siso_save let &so = s:so_save | let &siso = s:siso_save
doautoall SessionLoadPost doautoall SessionLoadPost
" vim: set ft=vim : " vim: set ft=vim :

Binary file not shown.

View File

@ -1,8 +1,27 @@
(let () (let ()
;;; (define-syntax message-case
;;; GENERIC PORTS: BASIC PRIMITIVES (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: ;;; Exports:
;;; * Constructors: ;;; * 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 a valid size" i))
(error 'set-port-output-size! "~s is not an output-port" p))))) (error 'set-port-output-size! "~s is not an output-port" p)))))
(let () ;;; IO PRIMITIVES
(let ()
;;; IO PRIMITIVES
;;; ;;;
(primitive-set! '$write-char (primitive-set! '$write-char
(lambda (c p) (lambda (c p)
@ -372,9 +389,8 @@
($flush-output-port p) ($flush-output-port p)
(error 'flush-output-port "~s is not an output-port" p))]))) (error 'flush-output-port "~s is not an output-port" p))])))
(let () (let () ;;; INPUT FILES
;;; INPUT FILES ;;;
(include "message-case.ss")
(define make-input-file-handler (define make-input-file-handler
(lambda (fd port-name) (lambda (fd port-name)
(let ((open? #t)) (let ((open? #t))
@ -476,10 +492,8 @@
(open-input-file filename) (open-input-file filename)
(error 'open-input-file "~s is not a string" filename))))) (error 'open-input-file "~s is not a string" filename)))))
(let () ;;; OUTPUT FILES
(let () ;;;
;;; OUTPUT FILES
(include "message-case.ss")
(define do-write-buffer (define do-write-buffer
(lambda (fd port-name p caller) (lambda (fd port-name p caller)
(let ([bytes (foreign-call "ikrt_write_file" (let ([bytes (foreign-call "ikrt_write_file"
@ -578,10 +592,8 @@
(open-output-file filename options) (open-output-file filename options)
(error 'open-output-file "~s is not a string" filename))]))) (error 'open-output-file "~s is not a string" filename))])))
(let () ;;; OUTPUT STRINGS
(let () ;;;
(include "message-case.ss")
;;; OUTPUT STRINGS
(define string-copy (define string-copy
(lambda (s) (lambda (s)
(substring s 0 (string-length s)))) (substring s 0 (string-length s))))
@ -730,4 +742,4 @@
(lambda () (lambda ()
(close-input-port p) (close-input-port p)
(set! shot #t)))))) (set! shot #t))))))
)

View File

@ -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 ...]))]))