; -*- Lisp -*- ; lambda-calculus-interface: an EuLisp library for interactive ; and file-based running of lambda-calculus scripts ; ; Copyright (c) 2001 Ian Hickson ; ; This program is free software; you can redistribute it and/or modify ; it under the terms of the GNU General Public License as published by ; the Free Software Foundation; either version 2 of the License, or ; (at your option) any later version. ; ; This program is distributed in the hope that it will be useful, but ; WITHOUT ANY WARRANTY; without even the implied warranty of ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ; General Public License for more details. ; ; You should have received a copy of the GNU General Public License ; along with this program; if not, write to the Free Software ; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (defmodule lambda-calculus-interface (import (level0 lambda-calculus-interpreter utilities)) ; Note: Euscheme doesn't implement the EuLisp 'stream' module, so ; the file-related bits below are actually written in a mixture of ; xscheme and EuLisp. :-/ ; A pure EuLisp stream-based implementation would be somewhat ; neater, and this should be revisted once euscheme more fully ; implements EuLisp 0.99. ;; error that can be raised by the interface (defcondition ) ; the equivalent of read-line-from-stream but for stdin (implied ; stream -- I could find no documentation on how to get a handle to ; the default input stream in this variant of xscheme, and the ; EuLisp equivalent is not implemented in euscheme) (defun read-line-from-stdin (echo handle-eof) (let ((character (read-char))) (if (not (characterp character)) ; not a character, so there was a stream read error ; we're going to assume this is the end of the file ; at top level (no text entered yet), we treat EOF as 'quit' ; otherwise, just stop loop for now and catch EOF next time (let ((result (if handle-eof "quit" ""))) ; echo this if we are not in quiet mode (if echo (print result) result)) (if (equal character #\newline) ; end of line, end the loop "" ; add this character to our string and loop (concatenate (convert character ) (read-line-from-stdin echo ())))))) (defun get-command-from-stdin (prompt echo) (progn (if prompt (prin "> ")) (read-line-from-stdin echo t))) ; display prompt and return true if no more input or if user entered ; one of the characters on the yes list. (defun interactive-prompt (prompt . yes) (prin prompt) (let ((character (read-char))) (or (not (characterp character)) (member character yes)))) (defun run-interactive-read-eval-loop (echo references abort-reductions) (let ((command (get-command-from-stdin echo echo))) (if (not (equal command "quit")) (progn (let/cc abort (with-handler ; report any error and continue regardless (generic-lambda ((condition ) (resume )) method: (((condition ) (resume )) (print "error:") (write condition) (print "") ; should we special case some errors? ; e.g. what if the error is that the machine is about ; to self destruct... XXX (abort))) (execute command references echo (if abort-reductions (lambda (prompt . yes) t) interactive-prompt))) (run-interactive-read-eval-loop echo references abort-reductions)))))) ;; interactive shell (defun run-interactively (echo abort-reductions) ; XXX per the EuLisp spec the constructor call below should be ; creating a , but in euscheme
is an abstract class ; with descendant . So... (run-interactive-read-eval-loop echo (make ) abort-reductions)) ; read a command from a specified stream (defun read-line-from-stream (stream handle-eof) (let ((character (read-char stream))) (if (not (characterp character)) ; not a character, so there was a stream read error ; we're going to assume this is the end of the file ; at top level (no text entered yet), we treat EOF as 'quit' ; otherwise, just stop loop for now and catch EOF next time (if handle-eof "quit" "") (if (equal character #\newline) ; end of line, end the loop "" ; add this character to our string and loop (concatenate (convert character ) (read-line-from-stream stream ())))))) (defun run-stream (stream echo references) ; if it's not the end of the stream... (if (not (eof-object-p stream)) (progn (if echo (prin "> ")) ; get a command... (let ((command (read-line-from-stream stream t))) ; output the command if we should (if echo (print command)) ; if the command isn't 'quit'... (if (not (equal command "quit")) ; execute said command... ; the lambda is the 'prompt' function ; this one just returns false (progn (execute command references echo (lambda (prompt . yes) ())) ; and repeat. (run-stream stream echo references))))))) (defun run-file (filename echo) (let ((stream (open-input-file filename))) (if stream ; XXX per the EuLisp spec the constructor call below should ; be creating a
, but in euscheme
is an ; abstract class with descendant . So... (run-stream stream echo (make )) (error (concatenate "can't open input file: " filename) )))) ; XXX should this be fatal? ;; non-interactive shell (defun run-files (files echo) (if files (let ((filename (car files))) (let/cc abort (with-handler ; report any error and continue regardless (generic-lambda ((condition ) (resume )) method: (((condition ) (resume )) (print (concatenate "fatal error in " filename ":")) ; XXX would be nice to give line number (write condition) (print "") (abort))) (if (equal filename "-") ; XXX this will never match since euscheme doesn't let arguments starting with '-' through :-/ (run-interactively echo) (run-file filename echo)) (run-files (cdr files) echo)))))) ;; a function to print introductory text (defun print-intro () (print "Lambda Calculus - Version 0.1") (print "lc comes with ABSOLUTELY NO WARRANTY; for details type 'warranty'.") (print "This is free software, and you are welcome to redistribute it under") (print "certain conditions; type 'license' for details.") (print "You may type 'help' at any time for more information.") (print "")) (export run-files run-interactively print-intro) )