(require (lib "43.ss" "srfi"))(require (lib "69.ss" "srfi"))(require (lib "process.ss")) ;(require-extension srfi-43) ;(use-modules (ice-9 srfi-43)(ice-9 syncase)) (define database (make-hash-table)) (define-syntax (define-implementation x) (syntax-case x () ((_ implementation evaluate-command interpret-command compile-command run-compiled-command) (syntax (hash-table-set! database 'implementation (vector evaluate-command interpret-command compile-command run-compiled-command)))))) (define-syntax (define-accessor x) (syntax-case x () ((_ name position) (syntax (define (name implementation) (let ((entry (hash-table-ref/default database implementation #f))) (if entry (vector-ref entry position) (error "no such implementation known!")))))))) (define-accessor implementation->evaluate-command 0) (define-accessor implementation->interpret-command 1) (define-accessor implementation->compile-command 2) (define-accessor implementation->run-compiled-command 3) (define-implementation bigloo (lambda (x) (string-append "echo '" x "' | bigloo -s")) (lambda (x) (string-append "bigloo -i" x)) (lambda (x) (string-append "bigloo -native" x " -o ." x "_bigloo")) (lambda (x) (string-append "./." x "_bigloo"))) (define-implementation mzscheme (lambda (x) (string-append "echo '" x "' | mzscheme --mute-banner")) (lambda (x) (string-append "mzscheme --script" x)) (lambda (x) (string-append "mzc --extension --autodir" x)) (lambda (x) (implementation->evaluate-command mzscheme (append-string "(load/use-compiled \"" x "\")")))) (define-syntax (define-command x) (syntax-case x () ((_ name implementation->command) (syntax (define (name implementation program) (system ((implementation->command implementation) program))))))) (define-command evaluate implementation->evaluate-command) (define-command interpret implementation->interpret-command) (define-command compile implementation->compile-command) (define-command run-compiled implementation->run-compiled-command) (evaluate 'mzscheme "(+ 1 2)") (evaluate 'bigloo '"(+ 5 2)")