From 460eba8d1a5ea8feef28282e70ba2d22fa1fcdc6 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Fri, 28 May 2010 14:12:41 +0000
Subject: 	Add support for 'property' builtin function. 	*
 interp/g-timer.boot: Rename property to prop to avoid conflict. 	*
 boot/parser.boot (bpAssignLHS): Allow functional places to 	assign to. 
 * boot/ast.boot (bfPlace): New. 	(bfAssign): Handle %Place forms. 
 * boot/tokens.boot: property is now translated to GET.

---
 src/boot/strap/ast.clisp    | 12 +++++++++---
 src/boot/strap/parser.clisp |  6 +++++-
 src/boot/strap/tokens.clisp |  2 +-
 3 files changed, 15 insertions(+), 5 deletions(-)

(limited to 'src/boot/strap')

diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 737250ef..64b6e0f4 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -233,6 +233,8 @@
     ((AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE)) |x|)
     (T (CONS (|compFluidize| (CAR |x|)) (|compFluidize| (CDR |x|))))))
 
+(DEFUN |bfPlace| (|x|) (CONS '|%Place| |x|))
+
 (DEFUN |bfTuple| (|x|) (CONS 'TUPLE |x|))
 
 (DEFUN |bfTupleP| (|x|) (AND (CONSP |x|) (EQ (CAR |x|) 'TUPLE)))
@@ -1647,9 +1649,13 @@
     (T (LIST 'THE |b| |a|))))
 
 (DEFUN |bfAssign| (|l| |r|)
-  (COND
-    ((|bfTupleP| |l|) (|bfSetelt| (CADR |l|) (CDDR |l|) |r|))
-    (T (|bfLET| |l| |r|))))
+  (PROG (|l'|)
+    (RETURN
+      (COND
+        ((|bfTupleP| |l|) (|bfSetelt| (CADR |l|) (CDDR |l|) |r|))
+        ((AND (CONSP |l|) (EQ (CAR |l|) '|%Place|))
+         (SETQ |l'| (CDR |l|)) (LIST 'SETF |l'| |r|))
+        (T (|bfLET| |l| |r|))))))
 
 (DEFUN |bfSetelt| (|e| |l| |r|)
   (COND
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 434e8513..802fc8bc 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -1096,7 +1096,11 @@
     ((NOT (|bpName|)) NIL)
     ((|bpEqKey| 'COLON) (OR (|bpApplication|) (|bpTrap|))
      (|bpPush| (|bfLocal| (|bpPop2|) (|bpPop1|))))
-    (T (AND (|bpArgumentList|) (OR (|bpEqPeek| 'DOT) (|bpTrap|)))
+    (T (AND (|bpArgumentList|)
+            (OR (|bpEqPeek| 'DOT)
+                (AND (|bpEqPeek| 'BEC)
+                     (|bpPush| (|bfPlace| (|bpPop1|))))
+                (|bpTrap|)))
        (COND
          ((|bpEqKey| 'DOT)
           (AND (|bpList| #'|bpPrimary| 'DOT) (|bpChecknull|)
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index c3c5105b..d498edb7 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -216,7 +216,7 @@
                   (LIST '|nil| NIL) (LIST '|not| 'NOT)
                   (LIST '|nreverse| 'NREVERSE) (LIST '|null| 'NULL)
                   (LIST '|or| 'OR) (LIST '|otherwise| 'T)
-                  (LIST '|readByte| 'READ-BYTE)
+                  (LIST '|property| 'GET) (LIST '|readByte| 'READ-BYTE)
                   (LIST '|readInteger| 'PARSE-INTEGER)
                   (LIST '|readLine| 'READ-LINE)
                   (LIST '|removeDuplicates| 'REMDUP)
-- 
cgit v1.2.3