diff options
author | dos-reis <gdr@axiomatics.org> | 2013-05-14 21:17:18 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2013-05-14 21:17:18 +0000 |
commit | a97a8e2cbc7d6c86f79a5465cba20212deff66c9 (patch) | |
tree | 5f0b1963e418af41b54cf4fea0ff6a4bc8b48762 | |
parent | 99e0f1d94fc9b0326b2b1e3afc6b17708304eadb (diff) | |
download | open-axiom-a97a8e2cbc7d6c86f79a5465cba20212deff66c9.tar.gz |
* interp/c-util.boot (cleanParameterList!): New.
* interp/define.boot (spadCompileOrSetq): Use it.
-rw-r--r-- | src/ChangeLog | 5 | ||||
-rw-r--r-- | src/interp/br-saturn.boot | 2 | ||||
-rw-r--r-- | src/interp/c-util.boot | 18 | ||||
-rw-r--r-- | src/interp/define.boot | 11 | ||||
-rw-r--r-- | src/interp/ht-util.boot | 6 | ||||
-rw-r--r-- | src/interp/lisp-backend.boot | 3 |
6 files changed, 30 insertions, 15 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 003c7d9a..41ccaf39 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2013-05-14 Gabriel Dos Reis <gdr@cse.tamu.edu> + + * interp/c-util.boot (cleanParameterList!): New. + * interp/define.boot (spadCompileOrSetq): Use it. + 2013-05-14 Gabriel Dos Reis <gdr@integrable-solutions.net> * algebra/array2.spad.pamphlet (TwoDimensionalArrayCategory): diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index c3172af8..34764f70 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -604,7 +604,7 @@ htInitPageNoHeading(propList) == --------------------> NEW DEFINITION <-------------------------- htpMakeEmptyPage(propList,:options) == - name := IFCAR options or GENTEMP() + name := IFCAR options or gensym() if not $saturn then $activePageList := [name, :$activePageList] val := vector [name, nil, nil, nil, nil, nil, propList, nil] diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index bcbef30c..e658f851 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2012, Gabriel Dos Reis. +-- Copyright (C) 2007-2013, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -1727,3 +1727,19 @@ lookupDefiningFunction(op,sig,dc) == lookupInheritedDefiningFunction(op,sig,shell,args,shell.loc) -- 6.3. Whatever. fun + +++ flag parameters needs to be made atomic, otherwise Lisp is confused. +++ We try our best to preserve +++ Note that we don't need substitution in the body because flag +++ parameters are never used in the body. +cleanParameterList! parms == + count := 0 + for vars in tails parms repeat + v := first vars + ident? v => nil + t := nil + until not symbolMember?(t,parms) repeat + count := count + 1 + t := makeSymbol strconc('"T",toString count) + vars.first := t + parms diff --git a/src/interp/define.boot b/src/interp/define.boot index bef1da67..89244baf 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2012, Gabriel Dos Reis. +-- Copyright (C) 2007-2013, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -2051,14 +2051,7 @@ spadCompileOrSetq(db,form is [nam,[lam,vl,body]]) == --good for performance (LISPLLIB size, BPI size, NILSEC) CONTAINED($ClearBodyToken,body) => sayBrightly ['" ",:bright nam,'" not compiled"] - -- flag parameters needs to be made atomic, otherwise Lisp is confused. - -- We try our best to preserve - -- Note that we don't need substitution in the body because flag - -- parameters are never used in the body. - vl := [ renameParameter for v in vl] where - renameParameter() == - integer? v or ident? v or string? v => v - gensym '"flag" + vl := cleanParameterList! vl if $optReplaceSimpleFunctions then body := replaceSimpleFunctions body diff --git a/src/interp/ht-util.boot b/src/interp/ht-util.boot index fcc9b2f5..1d8b75f2 100644 --- a/src/interp/ht-util.boot +++ b/src/interp/ht-util.boot @@ -286,7 +286,7 @@ htLispMemoLinks(links) == htLispLinks(links,true) beforeAfter(x,u) == [[y for [y,:r] in tails u while x ~= y],r] mkCurryFun(fun, val) == - name := GENTEMP() + name := gensym() code := ['DEFUN, name, '(arg), ['APPLY, MKQ fun, ['CONS, 'arg, MKQ val]]] eval code @@ -295,7 +295,7 @@ mkCurryFun(fun, val) == htRadioButtons [groupName, :buttons] == htpSetRadioButtonAlist($curPage, [[groupName, :buttonNames buttons], : htpRadioButtonAlist $curPage]) - boxesName := GENTEMP() + boxesName := gensym() iht ['"\newline\indent{5}\radioboxes{", boxesName, '"}{\htbmfile{pick}}{\htbmfile{unpick}}\beginitems "] defaultValue := '"1" @@ -313,7 +313,7 @@ htRadioButtons [groupName, :buttons] == htBcRadioButtons [groupName, :buttons] == htpSetRadioButtonAlist($curPage, [[groupName, :buttonNames buttons], : htpRadioButtonAlist $curPage]) - boxesName := GENTEMP() + boxesName := gensym() iht ['"\radioboxes{", boxesName, '"}{\htbmfile{pick}}{\htbmfile{unpick}} "] defaultValue := '"1" diff --git a/src/interp/lisp-backend.boot b/src/interp/lisp-backend.boot index 7382b41c..3139a0f3 100644 --- a/src/interp/lisp-backend.boot +++ b/src/interp/lisp-backend.boot @@ -791,7 +791,7 @@ removeFluids args == $Vars := [args,:$Vars] args args isnt [.,:.] => - args := GENTEMP() + args := gensym() $Vars := [args,:$Vars] args args is ['FLUID,v] and ident? v => @@ -965,6 +965,7 @@ transformToBackendCode x == $LocalVars: local := nil $SpecialVars: local := nil x := middleEndExpand x + cleanParameterList! x.absParms massageBackendCode CDDR x body := skipDeclarations CDDR x -- Make it explicitly a sequence of statements if it is not a one liner. |