diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 8 | ||||
| -rw-r--r-- | src/Makefile.am | 2 | ||||
| -rw-r--r-- | src/Makefile.in | 2 | ||||
| -rw-r--r-- | src/boot/strap/utility.clisp | 25 | ||||
| -rw-r--r-- | src/boot/utility.boot | 16 | ||||
| -rw-r--r-- | src/gui/gui.pro.in | 4 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 2 | ||||
| -rw-r--r-- | src/interp/i-intern.boot | 4 | ||||
| -rw-r--r-- | src/interp/i-map.boot | 4 | ||||
| -rw-r--r-- | src/interp/macros.lisp | 15 |
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) |