aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-05-01 21:02:41 +0000
committerdos-reis <gdr@axiomatics.org>2011-05-01 21:02:41 +0000
commit50ffaabb3e56f7dec884c7e44c0fc0296772dfc8 (patch)
tree6e24f407fb4d1b871135cba4d7c794564b939874 /src
parentedaf84d62bf70e3e3ad6ea4f910397f03b77688b (diff)
downloadopen-axiom-50ffaabb3e56f7dec884c7e44c0fc0296772dfc8.tar.gz
* boot/utility.boot (applySubstNQ): New.
* interp/compiler.boot (finishLambdaExpression): Use it. * interp/i-intern.boot (mkAtreeExpandMacros): Likewise. * interp/i-map.boot (addMap): Likewise. * interp/vmlisp.lisp (SUBLISNQ, SUBANQ, SUBB): Remove.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog8
-rw-r--r--src/Makefile.am2
-rw-r--r--src/Makefile.in2
-rw-r--r--src/boot/strap/utility.clisp25
-rw-r--r--src/boot/utility.boot16
-rw-r--r--src/gui/gui.pro.in4
-rw-r--r--src/interp/compiler.boot2
-rw-r--r--src/interp/i-intern.boot4
-rw-r--r--src/interp/i-map.boot4
-rw-r--r--src/interp/macros.lisp15
10 files changed, 56 insertions, 26 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 7badb42d..366e7943 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,13 @@
2011-05-01 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * boot/utility.boot (applySubstNQ): New.
+ * interp/compiler.boot (finishLambdaExpression): Use it.
+ * interp/i-intern.boot (mkAtreeExpandMacros): Likewise.
+ * interp/i-map.boot (addMap): Likewise.
+ * interp/vmlisp.lisp (SUBLISNQ, SUBANQ, SUBB): Remove.
+
+2011-05-01 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/vmlisp.lisp (EQSUBSTLIST): Remove.
* interp/c-util.boot (eqSubstAndCopy, eqSubst): Likewise. Adjust
callers.
diff --git a/src/Makefile.am b/src/Makefile.am
index 89c0d3e7..482f3748 100644
--- a/src/Makefile.am
+++ b/src/Makefile.am
@@ -89,7 +89,7 @@ all-sman: all-lib all-driver
cd sman && $(MAKE) $(AM_MAKEFLAGS) $@
all-gui: all-driver
- cd gui && $(MAKE) $(AM_MAKEFLAGS) $@
+ cd gui && $(MAKE) $(AM_MAKEFLAGS)
all-hyper: all-lib
cd hyper && $(MAKE) $(AM_MAKEFLAGS) $@
diff --git a/src/Makefile.in b/src/Makefile.in
index d5c7415d..43b89d32 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -687,7 +687,7 @@ all-sman: all-lib all-driver
cd sman && $(MAKE) $(AM_MAKEFLAGS) $@
all-gui: all-driver
- cd gui && $(MAKE) $(AM_MAKEFLAGS) $@
+ cd gui && $(MAKE) $(AM_MAKEFLAGS)
all-hyper: all-lib
cd hyper && $(MAKE) $(AM_MAKEFLAGS) $@
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index e399057f..f10a1749 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -9,7 +9,13 @@
|scalarMember?| |listMember?| |reverse| |reverse!|
|lastNode| |append| |append!| |copyList| |substitute|
|substitute!| |setDifference| |applySubst| |applySubst!|
- |remove| |removeSymbol|))
+ |applySubstNQ| |remove| |removeSymbol|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Thing|)
+ |substitute|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Thing|)
+ |substitute!|))
(DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|) (|%List| |%Thing|))
(|%List| |%Thing|))
@@ -204,6 +210,23 @@
(CDR |p|))
(T |t|)))))
+(DEFUN |applySubstNQ| (|sl| |t|)
+ (PROG (|p| |tl| |hd|)
+ (RETURN
+ (COND
+ ((AND (CONSP |t|)
+ (PROGN (SETQ |hd| (CAR |t|)) (SETQ |tl| (CDR |t|)) T))
+ (COND
+ ((EQ |hd| 'QUOTE) |t|)
+ (T (SETQ |hd| (|applySubstNQ| |sl| |hd|))
+ (SETQ |tl| (|applySubstNQ| |sl| |tl|))
+ (COND
+ ((AND (EQ |hd| (CAR |t|)) (EQ |tl| (CDR |t|))) |t|)
+ (T (CONS |hd| |tl|))))))
+ ((AND (SYMBOLP |t|) (SETQ |p| (|assocSymbol| |t| |sl|)))
+ (CDR |p|))
+ (T |t|)))))
+
(DEFUN |setDifference| (|x| |y|)
(PROG (|a| |l| |p|)
(RETURN
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index 39973783..b00eac00 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -35,7 +35,10 @@ namespace BOOTTRAN
module utility (objectMember?, symbolMember?, stringMember?,
charMember?, scalarMember?, listMember?, reverse, reverse!,
lastNode, append, append!, copyList, substitute, substitute!,
- setDifference, applySubst, applySubst!,remove,removeSymbol) where
+ setDifference, applySubst, applySubst!, applySubstNQ,
+ remove,removeSymbol) where
+ substitute: (%Thing,%Thing,%Thing) -> %Thing
+ substitute!: (%Thing,%Thing,%Thing) -> %Thing
append: (%List %Thing,%List %Thing) -> %List %Thing
append!: (%List %Thing,%List %Thing) -> %List %Thing
copyList: %List %Thing -> %List %Thing
@@ -190,6 +193,17 @@ applySubst!(sl,t) ==
symbol? t and (p := assocSymbol(t,sl)) => rest p
t
+++ Like applySubst, but skip quoted materials.
+applySubstNQ(sl,t) ==
+ t is [hd,:tl] =>
+ hd is "QUOTE" => t
+ hd := applySubstNQ(sl,hd)
+ tl := applySubstNQ(sl,tl)
+ sameObject?(hd,first t) and sameObject?(tl,rest t) => t
+ [hd,:tl]
+ symbol? t and (p := assocSymbol(t,sl)) => rest p
+ t
+
--% set operations
setDifference(x,y) ==
diff --git a/src/gui/gui.pro.in b/src/gui/gui.pro.in
index dfbe0fc3..6ea0d2b7 100644
--- a/src/gui/gui.pro.in
+++ b/src/gui/gui.pro.in
@@ -13,8 +13,8 @@ VPATH += @srcdir@
## Our headers
HEADERS += main-window.h
-INCLUDEPATH += . $$OA_INC
-DEPENDPATH += .
+INCLUDEPATH += @srcdir@
+DEPENDPATH += @srcdir@
## Source files
SOURCES += main-window.C main.C
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index c679cadd..68eac24f 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -337,7 +337,7 @@ finishLambdaExpression(expr is ["LAMBDA",vars,.],env) ==
rest v = 1 => slist := [[first v,:val],:slist]
scode := [[first v,val],:scode]
body :=
- slist => SUBLISNQ(slist,CDDR expandedFunction)
+ slist => applySubstNQ(slist,CDDR expandedFunction)
CDDR expandedFunction
if scode ~= nil then
body := [['%bind,reverse! scode,:body]]
diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot
index 5138bd28..5a6b06f0 100644
--- a/src/interp/i-intern.boot
+++ b/src/interp/i-intern.boot
@@ -1,6 +1,6 @@
-- Copyright (C) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007-2010, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -88,7 +88,7 @@ mkAtreeExpandMacros x ==
[args,:body] := m
#args = #argl =>
sl := [[a,:s] for a in args for s in argl]
- x := SUBLISNQ(sl,body)
+ x := applySubstNQ(sl,body)
null args => x := [body,:argl]
x := [op,:argl]
x := [mkAtreeExpandMacros op,:argl]
diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot
index 373b3610..0d41f57b 100644
--- a/src/interp/i-map.boot
+++ b/src/interp/i-map.boot
@@ -180,8 +180,8 @@ addMap(lhs,rhs,pred) ==
argPredList:= reverse! predList
finalPred :=
-- handle g(a,T)==a+T confusion between pred=T and T variable
- MKPF((pred and (pred ~= 'T) => [:argPredList,SUBLISNQ($sl,pred)]; argPredList),"and")
- body:= SUBLISNQ($sl,rhs)
+ MKPF((pred and (pred ~= 'T) => [:argPredList,applySubstNQ($sl,pred)]; argPredList),"and")
+ body:= applySubstNQ($sl,rhs)
oldMap :=
(obj := get(op,'value,$InteractiveFrame)) => objVal obj
nil
diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp
index c98ab032..e2dbf4f1 100644
--- a/src/interp/macros.lisp
+++ b/src/interp/macros.lisp
@@ -210,21 +210,6 @@
((EQL (CDR L) TL) (RPLACD L NIL))
((TRUNCLIST-1 (CDR L) TL))))
-; 15.4 Substitution of Expressions
-
-(DEFUN SUBLISNQ (KEY E) (declare (special KEY)) (if (NULL KEY) E (SUBANQ E)))
-
-(DEFUN SUBANQ (E)
- (declare (special key))
- (COND ((ATOM E) (SUBB KEY E))
- ((EQCAR E (QUOTE QUOTE)) E)
- ((MAPCAR #'(LAMBDA (J) (SUBANQ J)) E))))
-
-(DEFUN SUBB (X E)
- (COND ((ATOM X) E)
- ((EQ (CAAR X) E) (CDAR X))
- ((SUBB (CDR X) E))))
-
; 15.5 Using Lists as Sets
(DEFUN PREDECESSOR (TL L)