/usr/share/scheme48-1.9/big/import-def.scm is in scheme48 1.9-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 | ; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees, Marcus Crestani
; Two macros:
;
; (import-definition <id>)
; ->
; (define <id> (lookup-imported-binding "<id with - becoming _>"))
;
; (import-definition <id> <string id>)
; ->
; (define <id> (lookup-imported-binding <string-id>))
;
; (import-lambda-definition <id> (<formal> ...))
; ->
; (begin
; (define temp (lookup-imported-binding "<id with - becoming _>"))
; (define <id>
; (lambda (<formal> ...)
; (call-imported-binding temp <formal> ...))))
;
; (import-lambda-definition <id> (<formal> ...) <string id>)
; ->
; ...same again using <string id> as the imported name...
(define-syntax import-definition
(lambda (exp rename compare)
(let ((id (cadr exp))
(%define (rename 'define))
(%lookup-imported-binding (rename 'lookup-imported-binding)))
(let ((external-id (if (null? (cddr exp))
(list->string (map (lambda (ch)
(if (char=? ch #\-)
#\_
ch))
(string->list
(symbol->string id))))
(caddr exp))))
`(,%define ,id
(,%lookup-imported-binding ,external-id))))))
; (import-lambda-definition id (formal ...) [external name])
(define-syntax import-lambda-definition
(lambda (exp rename compare)
(let ((id (cadr exp))
(formals (caddr exp))
(%define (rename 'define))
(%begin (rename 'begin))
(%lambda (rename 'lambda))
(%call-imported-binding (rename 'call-imported-binding))
(%lookup-imported-binding (rename 'lookup-imported-binding))
(%binding (rename 'binding)))
(let ((external-id (if (null? (cdddr exp))
(list->string (map (lambda (ch)
(if (char=? ch #\-)
#\_
ch))
(string->list
(symbol->string id))))
(cadddr exp))))
`(,%begin
(,%define ,%binding
(,%lookup-imported-binding ,external-id))
(,%define ,id
(,%lambda ,formals
(,%call-imported-binding ,%binding . ,formals))))))))
(define-syntax import-lambda-definition-2
(lambda (exp rename compare)
(let ((id (cadr exp))
(formals (caddr exp))
(%define (rename 'define))
(%begin (rename 'begin))
(%lambda (rename 'lambda))
(%call-imported-binding-2 (rename 'call-imported-binding-2))
(%lookup-imported-binding (rename 'lookup-imported-binding))
(%binding (rename 'binding)))
(let ((external-id (if (null? (cdddr exp))
(list->string (map (lambda (ch)
(if (char=? ch #\-)
#\_
ch))
(string->list
(symbol->string id))))
(cadddr exp))))
`(,%begin
(,%define ,%binding
(,%lookup-imported-binding ,external-id))
(,%define ,id
(,%lambda ,formals
(,%call-imported-binding-2 ,%binding . ,formals))))))))
|