[snow-cvs] r69 - in trunk/src: java/org/armedbear/lisp java/snow lisp/snow
Alessio Stalla
astalla at common-lisp.net
Thu Apr 8 19:53:00 UTC 2010
Author: astalla
Date: Thu Apr 8 15:53:00 2010
New Revision: 69
Log:
Changes to make Snow work with ABCL 0.20-dev
Added:
trunk/src/java/org/armedbear/lisp/EnvAccess.java
Modified:
trunk/src/java/snow/Snow.java
trunk/src/lisp/snow/compile-system.lisp
trunk/src/lisp/snow/start.lisp
Added: trunk/src/java/org/armedbear/lisp/EnvAccess.java
==============================================================================
--- (empty file)
+++ trunk/src/java/org/armedbear/lisp/EnvAccess.java Thu Apr 8 15:53:00 2010
@@ -0,0 +1,92 @@
+/*
+ * EnvAccess.java
+ *
+ * Copyright (C) 2010 Alessio Stalla
+ *
+ * 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *
+ * As a special exception, the copyright holders of this library give you
+ * permission to link this library with independent modules to produce an
+ * executable, regardless of the license terms of these independent
+ * modules, and to copy and distribute the resulting executable under
+ * terms of your choice, provided that you also meet, for each linked
+ * independent module, the terms and conditions of the license of that
+ * module. An independent module is a module which is not derived from
+ * or based on this library. If you modify this library, you may extend
+ * this exception to your version of the library, but you are not
+ * obligated to do so. If you do not wish to do so, delete this
+ * exception statement from your version.
+ */
+
+package org.armedbear.lisp;
+
+import static org.armedbear.lisp.Lisp.*;
+
+public final class EnvAccess {
+
+ //THIS IS COPIED HERE FROM Environment.java IN MY LOCAL COPY OF ABCL
+ //this should make Snow work with stock abcl.
+
+ //Experimental port of the Franz Environment Access library
+ //(http://www.franz.com/support/documentation/8.0/doc/environments.htm)
+ //
+ //astalla 2010-01-05 - for now I'm only interested in variable-information
+ //(actually just to check if a lexical variable is bound), but this could
+ //grow in the future.
+ //
+ //I'm placing everything in SYSTEM like ACL does, but I believe we should
+ //have a SYS.ENV package or something like that.
+
+ /**
+ * Ensures the argument is an environment designator: either an environment
+ * object or NIL which means the global environment.
+ * TODO: on NIL it returns a fresh, empty environment, which is wrong.
+ */
+ public static final Environment ensureEnvironment(LispObject o) {
+ if(o == NIL) {
+ return new Environment(); //TODO
+ } else {
+ return checkEnvironment(o);
+ }
+ }
+
+ private static final Symbol KEYWORD_LEXICAL = internKeyword("LEXICAL");
+ private static final Symbol KEYWORD_SPECIAL = internKeyword("SPECIAL");
+
+ // ### variable-information
+ //http://www.franz.com/support/documentation/8.0/doc/operators/system/variable-information.htm
+ private static final Primitive VARIABLE_INFORMATION =
+ new Primitive("variable-information", PACKAGE_SYS, true, "symbol &optional env all-declarations")
+ {
+ @Override
+ public LispObject execute(LispObject[] args) {
+ if(args.length < 1 || args.length > 3) {
+ return error(new WrongNumberOfArgumentsException(this));
+ }
+ Environment env = ensureEnvironment(args.length > 1 ? args[1] : NIL);
+ Binding b = env.getBinding(args[0]);
+ LispThread t = LispThread.currentThread();
+ if(b != null) {
+ return t.setValues(b.specialp ? KEYWORD_SPECIAL : KEYWORD_LEXICAL,
+ NIL, //TODO
+ NIL, //TODO
+ T);
+ } else {
+ return t.setValues(NIL, NIL, NIL, NIL); //TODO check
+ }
+ }
+ };
+
+}
\ No newline at end of file
Modified: trunk/src/java/snow/Snow.java
==============================================================================
--- trunk/src/java/snow/Snow.java (original)
+++ trunk/src/java/snow/Snow.java Thu Apr 8 15:53:00 2010
@@ -62,7 +62,10 @@
if(!init) {
try {
lispEngine = new ScriptEngineManager(Snow.class.getClassLoader()).getEngineByExtension("lisp");
+ new org.armedbear.lisp.EnvAccess(); //Init env access primitives
} catch(final Throwable t) {
+ t.printStackTrace();
+ System.exit(1);
}
URL url = Snow.class.getResource("/snow/snow.asd");
if(url == null) {
@@ -367,6 +370,6 @@
e.printStackTrace();
}
}
-
}
+
Modified: trunk/src/lisp/snow/compile-system.lisp
==============================================================================
--- trunk/src/lisp/snow/compile-system.lisp (original)
+++ trunk/src/lisp/snow/compile-system.lisp Thu Apr 8 15:53:00 2010
@@ -1,12 +1,12 @@
(require :asdf)
(jstatic "initAux" "snow.Snow")
-(pushnew :snow-cells *features*)
(format t "Compiling snow...~%")
-(handler-bind ((error
- #'(lambda (c)
- (format t "Compilation failed: ~A~%" c)
- (quit :status 1))))
- (asdf:oos 'asdf:compile-op :snow)
- (format t "Success!~%")
- (quit))
\ No newline at end of file
+(let (*debugger-hook*)
+ (handler-bind ((error
+ #'(lambda (c)
+ (format t "Compilation failed: ~A~%" c))))
+ ; (quit :status 1))))
+ (asdf:oos 'asdf:compile-op :snow)
+ (format t "Success!~%")
+ (quit)))
\ No newline at end of file
Modified: trunk/src/lisp/snow/start.lisp
==============================================================================
--- trunk/src/lisp/snow/start.lisp (original)
+++ trunk/src/lisp/snow/start.lisp Thu Apr 8 15:53:00 2010
@@ -30,6 +30,35 @@
(in-package :snow)
+(with-gui ()
+ (frame (:id frame :title "ABCL - Snow REPL"
+ :size #C(800 300)
+ :visible-p t :layout-manager '(:mig "fill" "[fill]" "")
+ :on-close :exit
+ :menu-bar (menu-bar ()
+ (menu (:text "File")
+ (menu-item :text "Load..."
+ :on-action #'snow-load)
+ (menu-item :text "Compile..."
+ :on-action #'snow-compile)
+ (menu-item :text "Compile and load..."
+ :on-action #'snow-compile-and-load)
+ (separator)
+ (menu-item :text "Quit"
+ :on-action (lambda () (ext:quit))))
+#| (menu (:text "Util")
+ (menu-item :text "Launch Swank"
+ :on-action #'launch-swank))|#
+ (menu (:text "Help")
+ (menu-item :text "Showcase"
+ :on-action #'snow-showcase)
+ (menu-item :text "About"
+ :on-action #'snow-about))))
+ (scroll (:layout "grow")
+ (gui-repl :dispose-on-close frame
+ :environment `((*package* ,(find-package :snow-user))
+ (*readtable* ,(find-readtable 'snow:syntax)))))))
+
(defun snow-about ()
(dialog (:id dlg :title "Snow v0.3" :visible-p t)
(label :layout "wrap"
@@ -58,34 +87,12 @@
(defun snow-compile ()
(let ((file (show-file-chooser)))
- (when file (compile file))))
+ (when file (compile-file file))))
(defun snow-compile-and-load ()
(let ((file (show-file-chooser)))
(when file (load (compile-file file)))))
-(with-gui ()
- (frame (:id frame :title "ABCL - Snow REPL"
- :size #C(800 300)
- :visible-p t :layout-manager '(:mig "fill" "[fill]" "")
- :on-close :exit
- :menu-bar (menu-bar ()
- (menu (:text "File")
- (menu-item :text "Load..."
- :on-action #'snow-load)
- (menu-item :text "Compile..."
- :on-action #'snow-compile)
- (menu-item :text "Compile and load..."
- :on-action #'snow-compile-and-load)
- (separator)
- (menu-item :text "Quit"
- :on-action (lambda () (ext:quit))))
- (menu (:text "Help")
- (menu-item :text "Showcase"
- :on-action (lambda () (snow-showcase)))
- (menu-item :text "About"
- :on-action (lambda () (snow-about))))))
- (scroll (:layout "grow")
- (gui-repl :dispose-on-close frame
- :environment `((*package* ,(find-package :snow-user))
- (*readtable* ,(find-readtable 'snow:syntax)))))))
+(defun launch-swank ()
+ :todo)
+
More information about the snow-cvs
mailing list