Commit c26dbc70 authored by Erick's avatar Erick

.

parent 03b10241
This diff is collapsed.
...@@ -10,6 +10,7 @@ This is mainly a maintenance version. ...@@ -10,6 +10,7 @@ This is mainly a maintenance version.
* Documentation update * Documentation update
* Modifications to support ScmPkg on MacOs MacPorts * Modifications to support ScmPkg on MacOs MacPorts
* Fix incompatibilities in FFI introduced in 1.00 * Fix incompatibilities in FFI introduced in 1.00
* Better x86_64 support
* Bug fixes * Bug fixes
* version 1.00 (2010 08 11) * version 1.00 (2010 08 11)
......
;;;; ;;;;
;;;; repl.stk -- STklos REPL ;;;; repl.stk -- STklos REPL
;;;; ;;;;
;;;; Copyright 2000-2010 Erick Gallesio - Universite de Nice <eg@unice.fr> ;;;; Copyright 2000-2011 Erick Gallesio - Universite de Nice <eg@unice.fr>
;;;; ;;;;
;;;; ;;;;
;;;; This program is free software; you can redistribute it and/or modify ;;;; 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 ;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or ;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version. ;;;; (at your option) any later version.
;;;; ;;;;
;;;; This program is distributed in the hope that it will be useful, ;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details. ;;;; GNU General Public License for more details.
;;;; ;;;;
;;;; You should have received a copy of the GNU General Public License ;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software ;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, ;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA. ;;;; USA.
;;;; ;;;;
;;;; Author: Erick Gallesio [eg@unice.fr] ;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 4-Jun-2000 15:07 (eg) ;;;; Creation date: 4-Jun-2000 15:07 (eg)
;;;; Last file update: 25-Oct-2010 20:39 (eg) ;;;; Last file update: 5-Jan-2011 09:05 (eg)
;;;; ;;;;
;; This file defines the REPL module. This module does not export anything ;; This file defines the REPL module. This module does not export anything
;; and is completely self-contained. This is the module which is last loaded ;; and is completely self-contained. This is the module which is last loaded
;; in the default boot file. ;; in the default boot file.
;; ;;
(define-module REPL (define-module REPL
...@@ -52,7 +52,7 @@ ...@@ -52,7 +52,7 @@
((help h ?) (display ((help h ?) (display
(do-color 'blue 'bold (do-color 'blue 'bold
(format "Available Commands: (format "Available Commands:
- ,backtrace ,bt Show the stack when last error occurred - ,backtrace ,bt Show the stack when last error occurred
- ,quit ,q Exit STklos - ,quit ,q Exit STklos
- ,help ,? ,h This help\n") - ,help ,? ,h This help\n")
'clear) 'clear)
...@@ -83,7 +83,7 @@ ...@@ -83,7 +83,7 @@
out))) out)))
(define (repl-handler c port) (define (repl-handler c port)
(if (condition? c) (if (condition? c)
(cond (cond
((condition-has-type? c &error-message) ;; &error-message ((condition-has-type? c &error-message) ;; &error-message
...@@ -95,7 +95,7 @@ ...@@ -95,7 +95,7 @@
((condition-has-type? c &message) ;; &message (e.g. ^C) ((condition-has-type? c &message) ;; &message (e.g. ^C)
(format port (condition-ref c 'message))) (format port (condition-ref c 'message)))
((condition-has-type? c &uncaught-exception) ((condition-has-type? c &uncaught-exception)
(repl-handler (uncaught-exception-reason c) port)) (repl-handler (uncaught-exception-reason c) port))
(else ;; Unknown (else ;; Unknown
(format port "**** Unknown condition raised.\n") (format port "**** Unknown condition raised.\n")
(format port "Condition type: ~A\n" (struct-type-name (struct-type c))) (format port "Condition type: ~A\n" (struct-type-name (struct-type c)))
...@@ -198,7 +198,7 @@ doc> ...@@ -198,7 +198,7 @@ doc>
(let ((e (%read in))) (let ((e (%read in)))
(display (do-color 'clear)) (display (do-color 'clear))
(cond (cond
((eof-object? e) ((eof-object? e)
(set! repl-level (- repl-level 1)) (set! repl-level (- repl-level 1))
(set! eof #t) (set! eof #t)
...@@ -210,7 +210,7 @@ doc> ...@@ -210,7 +210,7 @@ doc>
(do-repl-command (cdr e))) (do-repl-command (cdr e)))
(else (else
(call-with-values (call-with-values
(lambda () (eval e)) (lambda () (eval e))
(lambda v (lambda v
(when interactive? (when interactive?
...@@ -240,13 +240,13 @@ doc> ...@@ -240,13 +240,13 @@ doc>
(%initialize-signals) (%initialize-signals)
(when interactive? (when interactive?
(let ((line1 (format "STklos version ~A\n" (version))) (let ((line1 (format "STklos version ~A\n" (version)))
(line2 "Copyright (C) 1999-2010 Erick Gallesio - Universite de Nice <eg@unice.fr>\n") (line2 "Copyright (C) 1999-2011 Erick Gallesio - Universite de Nice <eg@unice.fr>\n")
(line3 (format "[~a/~a/~a]\n" (machine-type) (%thread-system) (line3 (format "[~a/~a/~a]\n" (machine-type) (%thread-system)
(key-get *%system-state-plist* :readline 'no-readline)))) (key-get *%system-state-plist* :readline 'no-readline))))
(display (do-color 'bold 'black "* " 'bold 'blue line1)) (display (do-color 'bold 'black "* " 'bold 'blue line1))
(display (do-color 'bold 'black " * " 'bold 'blue line2)) (display (do-color 'bold 'black " * " 'bold 'blue line2))
(display (do-color 'bold 'black "* * " 'bold 'blue line3 'normal)))) (display (do-color 'bold 'black "* * " 'bold 'blue line3 'normal))))
((main-repl-hook)) ((main-repl-hook))
(repl) (repl)
(%pre-exit 0)) (%pre-exit 0))
......
This diff is collapsed.
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment