From 4da4e775ade14aa9e8c2d0b4b106e743e4d283a4 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sun, 5 Oct 2008 03:06:07 +0000 Subject: * interp/c-util.boot (isAtomicForm): New. (replaceSimpleFunctions): Use it. Simplify back to original implementation. (proclaimCapsuleFunction): Constructor parameters are generic. * interp/sys-utility.boot (getVMType): Handle wildcard. * algebra/stream.spad.pamphlet: Don't build STREAM with proclamation on -- it currently violates type rules. --- TODO | 1 + src/ChangeLog | 10 ++++++++++ src/algebra/stream.spad.pamphlet | 3 +++ src/input/Makefile.in | 5 +++-- src/input/Makefile.pamphlet | 5 +++-- src/interp/c-util.boot | 41 ++++++++++++++++++++-------------------- src/interp/define.boot | 4 ++-- src/interp/sys-utility.boot | 4 +++- 8 files changed, 46 insertions(+), 27 deletions(-) diff --git a/TODO b/TODO index b0ae4949..b185cbdd 100644 --- a/TODO +++ b/TODO @@ -2,6 +2,7 @@ === TODO === ============ +* Fix STREAM implementation (dynamic semantics rules violation). * Fix compilation of domain where withon is empty. * Improve overload resolution routines. * Have an option to build OpenAxiom as a Firefox-based standalone diff --git a/src/ChangeLog b/src/ChangeLog index 283064d1..a6e1f476 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,13 @@ +2008-10-04 Gabriel Dos Reis + + * interp/c-util.boot (isAtomicForm): New. + (replaceSimpleFunctions): Use it. Simplify back to original + implementation. + (proclaimCapsuleFunction): Constructor parameters are generic. + * interp/sys-utility.boot (getVMType): Handle wildcard. + * algebra/stream.spad.pamphlet: Don't build STREAM with + proclamation on -- it currently violates type rules. + 2008-10-04 Gabriel Dos Reis * algebra/data.spad.pamphlet (sample$Byte): New. diff --git a/src/algebra/stream.spad.pamphlet b/src/algebra/stream.spad.pamphlet index 0241548c..66d7a227 100644 --- a/src/algebra/stream.spad.pamphlet +++ b/src/algebra/stream.spad.pamphlet @@ -550,6 +550,9 @@ CyclicStreamTools(S,ST): Exports == Implementation where @ \section{domain STREAM Stream} <>= +-- As explained below, in the capsule, the Rep for STREAM is actually +-- a half lie. So, the system should not be allowed to trust it. +)boot $optProclaim := false import Type import Void import Boolean diff --git a/src/input/Makefile.in b/src/input/Makefile.in index 2eabdecc..acfdd10a 100644 --- a/src/input/Makefile.in +++ b/src/input/Makefile.in @@ -528,8 +528,9 @@ pamphlets = \ $(wildchar.as.pamplhet) mostlyclean-local: - -rm -rf $(MID) - -rm -rf $(OUT) + rm -f *.output + rm -rf $(MID) + rm -rf $(OUT) clean-local: mostlyclean-local diff --git a/src/input/Makefile.pamphlet b/src/input/Makefile.pamphlet index 6b673e35..5a320d1c 100644 --- a/src/input/Makefile.pamphlet +++ b/src/input/Makefile.pamphlet @@ -883,8 +883,9 @@ $(OUT): <> mostlyclean-local: - -rm -rf $(MID) - -rm -rf $(OUT) + rm -f *.output + rm -rf $(MID) + rm -rf $(OUT) clean-local: mostlyclean-local diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 5ffaf9c3..8a6f4402 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -856,10 +856,15 @@ eqSubst: (%List, %List, %Form) -> %Form eqSubst(args,parms,body) == NSUBLIS(pairList(parms,args),body,KEYWORD::TEST,function EQ) + +++ returns true if `form' does not really induce computations. +isAtomicForm: %Form -> %Boolean +isAtomicForm form == + atom form or first form = "QUOTE" + ++ Walk `form' and replace simple functions as appropriate. replaceSimpleFunctions form == - atom form => form - form is ["QUOTE",:.] => form + isAtomicForm form => form -- 1. process argument first. for args in tails rest form repeat arg' := replaceSimpleFunctions(arg := first args) @@ -876,7 +881,7 @@ replaceSimpleFunctions form == -- 2.2. the substitution case. fun' is ["XLAM",parms,body] => -- conservatively approximate eager semantics - and/[atom first as for as in tails args] => + and/[isAtomicForm first as for as in tails args] => -- alpha rename before substitution. newparms := [GENSYM() for p in parms] body := eqSubstAndCopy(newparms,parms,body) @@ -910,25 +915,21 @@ setCompilerOptimizations level == proclaimCapsuleFunction(op,sig) == LAM_,EVALANDFILEACTQ ["DECLAIM",["FTYPE", - ["FUNCTION",[:[argType first d for d in tails rest sig],"%Shell"], - retType first sig],op]] where - argType d == - getVMType normalize d - retType d == - d := normalize d - atom d => getVMType d - args := rest d - #args = 0 => getVMType d - or/[atom a for a in args] => "%Thing" - -- not theoretically correct, but practically OK. - getVMType d - normalize d == + ["FUNCTION",[:[vmType first d for d in tails rest sig],"%Shell"], + vmType first sig],op]] where + vmType d == + getVMType normalize(d,true) + normalize(d,top?) == d = "$" => + not top? => "*" -- If the representation is explicitly stated, use it. That way -- we optimize abstractions just as well as builtins. - rep := get("Rep","value",$e) => rep + r := get("Rep","value",$e) => normalize(r.expr,top?) -- Cope with old-style constructor definition atom $functorForm => [$functorForm] - $functorForm - atom d => d - [first d, :[normalize first args for args in tails rest d]] + normalize($functorForm,top?) + atom d => + top? => "%Thing" + getmode(d,$e) => "*" + d + [first d, :[normalize(first args,false) for args in tails rest d]] diff --git a/src/interp/define.boot b/src/interp/define.boot index 5939cdcb..58c39f1b 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -927,8 +927,8 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body], e:= compArgumentConditions e if $profileCompiler then - for x in argl for t in rest signature' repeat profileRecord('arguments,x,t) - + for x in argl for t in rest signature' repeat + profileRecord('arguments,x,t) --4. introduce needed domains into extendedEnv for domain in signature' repeat e:= addDomain(domain,e) diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index 20e84c18..3c820e9f 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -44,7 +44,9 @@ namespace BOOT ++ representation of a domain, as a Lisp type specifier as seen by ++ the runtime system. getVMType d == - IDENTP d => "%Thing" + IDENTP d => + d = "*" => d + "%Thing" STRINGP d => "%Thing" -- literal flag parameter case (d' := devaluate d) of Void => "%Void" -- cgit v1.2.3