From 9fef9535299d5f5dafae9deb2c4bc41843bb178c Mon Sep 17 00:00:00 2001 From: =?utf8?q?David=20V=C3=A1zquez?= Date: Wed, 19 Feb 2014 23:17:51 +0100 Subject: [PATCH] Implement a failing symbol-plist as primitive --- jscl.lisp | 2 +- src/compiler/compiler.lisp | 3 --- src/symbol.lisp | 37 +++++++++++++++++++++++++++++++++++++ 3 files changed, 38 insertions(+), 4 deletions(-) create mode 100644 src/symbol.lisp diff --git a/jscl.lisp b/jscl.lisp index 7c26841..e3a9581 100644 --- a/jscl.lisp +++ b/jscl.lisp @@ -54,8 +54,8 @@ ("documentation" :target) ("misc" :target) ("ffi" :target) + ("symbol" :target) ("package" :target) - ("read" :both) ("defstruct" :both) ("lambda-list" :both) diff --git a/src/compiler/compiler.lisp b/src/compiler/compiler.lisp index 222f660..d2b6975 100644 --- a/src/compiler/compiler.lisp +++ b/src/compiler/compiler.lisp @@ -1072,9 +1072,6 @@ (throw (+ "Function `" (call |xstring| (get symbol "name")) "' is undefined."))) (return func))) -(define-builtin symbol-plist (x) - `(or (get ,x "plist") ,(convert nil))) - (define-builtin lambda-code (x) `(call |make_lisp_string| (method-call ,x "toString"))) diff --git a/src/symbol.lisp b/src/symbol.lisp new file mode 100644 index 0000000..0234232 --- /dev/null +++ b/src/symbol.lisp @@ -0,0 +1,37 @@ +;;; symbols --- + +;; JSCL 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 3 of the +;; License, or (at your option) any later version. +;; +;; JSCL 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 JSCL. If not, see . + +(defun symbol-plist (x) + (cond + ((symbolp x) (error "`~a' is not a symbol." x)) + ((in "plist" x) (oget* x "plist")))) + +(defun set-symbol-plist (new-value x) + (if (symbolp x) + (oset* new-value x "plist") + (error "`~a' is not a symbol." x))) + +(define-setf-expander symbol-plist (x) + (let ((g!x (gensym)) + (g!value (gensym))) + (list (list g!x) + (list x) + (list g!value) + `(set-symbol-plist ,g!value ,g!x) + `(symbol-plist ,g!value)))) + +(defun get (symbol indicator &optional default) + (getf (symbol-plist symbol) indicator default)) + -- 1.7.10.4