- fix bug in unit test script

- change print format of forced-compiled-promises
- fix some warnings



git-svn-id: svn://localhost/root/svnrepo/trunk@11 bee25f81-8ba7-4b93-944d-dfac3d1a11cc
This commit is contained in:
colin.smith 2006-09-05 07:56:51 +00:00
parent 544d0422aa
commit 6acf5eaf16
6 changed files with 41 additions and 37 deletions

View File

@ -390,11 +390,15 @@ cellvector * Cell::CProcValue () const
typecheck(Cproc); return cd.cv; typecheck(Cproc); return cd.cv;
} }
Cell * Cell::PromiseValue () const Cell* Cell::PromiseValue () const {
{ typecheck (Promise);
typecheck (Promise); return cd.cv->get (0);
return cd.cv->get (0); }
}
Cell* Cell::CPromiseValue() const {
typecheck(Cpromise);
return cd.cv->get(0);
}
psymbol Cell::BuiltinValue () const psymbol Cell::BuiltinValue () const
{ {

View File

@ -535,9 +535,10 @@ void Cell::write (sstring& ss) const {
ss.append("#<compiled-procedure>"); ss.append("#<compiled-procedure>");
break; break;
case Cpromise: case Cpromise:
ss.append(flag(FORCED) if (flag(FORCED))
? "#<forced-compiled-promise>" CPromiseValue()->write(ss);
: "#<compiled-promise>"); else
ss.append("#<compiled-promise>");
break; break;
case Insn: case Insn:
ss.append("#<vm-instruction>"); ss.append("#<vm-instruction>");

View File

@ -290,7 +290,7 @@ Cell* Context::execute (Cell* proc, Cell* args) {
break; break;
case 2: // subr case 2: // subr
if (!insn->flag(Cell::QUICK)) { if (!insn->flag(Cell::QUICK)) {
Cell* subr = find_var(root_envt, insn->cd.y, 0); Cell* const subr = find_var(root_envt, insn->cd.y, 0);
if (!subr) error("missing primitive procedure"); if (!subr) error("missing primitive procedure");
Cell* proc = cdr(subr); Cell* proc = cdr(subr);
type = proc->type(); type = proc->type();
@ -303,12 +303,12 @@ Cell* Context::execute (Cell* proc, Cell* args) {
// re-push the args, and dispatch to the procedure. // re-push the args, and dispatch to the procedure.
n_args = INSN_COUNT(insn); n_args = INSN_COUNT(insn);
cellvector cv; cellvector cv;
for (int ix = 0; ix < n_args; ++ix) for (unsigned int ix = 0; ix < n_args; ++ix)
cv.push(m_stack.pop()); cv.push(m_stack.pop());
save(r_envt); save(r_envt);
save(r_cproc); save(r_cproc);
save(pc+1); save(pc+1);
for (int ix = 0; ix < n_args; ++ix) for (unsigned int ix = 0; ix < n_args; ++ix)
m_stack.push(cv.pop()); m_stack.push(cv.pop());
r_cproc = proc; r_cproc = proc;
goto PROC; goto PROC;

View File

@ -415,39 +415,39 @@ public:
// preallocate the string space; freeing this object discards // preallocate the string space; freeing this object discards
// both box and string. // both box and string.
struct StringBox struct StringBox {
{ size_t length;
size_t length; char s[1];
char s[1]; };
};
// Value extractors // Value extractors
int IntValue () const; int IntValue() const;
char CharValue () const; char CharValue() const;
SubrBox * SubrValue () const; SubrBox* SubrValue() const;
char * StringValue () const; char* StringValue() const;
size_t StringLength () const; size_t StringLength() const;
FILE * IportValue () const; FILE* IportValue() const;
FILE * OportValue () const; FILE* OportValue() const;
void * ContValue () const; void* ContValue() const;
cellvector * VectorValue () const; cellvector* VectorValue() const;
cellvector * CProcValue () const; cellvector* CProcValue() const;
Cell * PromiseValue () const; Cell* PromiseValue() const;
psymbol SymbolValue () const; Cell* CPromiseValue() const;
psymbol BuiltinValue () const; psymbol SymbolValue() const;
Procedure LambdaValue () const; psymbol BuiltinValue() const;
double RealValue () const; Procedure LambdaValue() const;
const char * name () const; double RealValue() const;
const char* name() const;
// unsafe accessors: use when you have prior knowledge that the // unsafe accessors: use when you have prior knowledge that the
// cell contains an atom of the proper type. // cell contains an atom of the proper type.
cellvector * unsafe_vector_value() const { cellvector* unsafe_vector_value() const {
return cd.cv; return cd.cv;
} }
static void real_to_string (double, char *, int); static void real_to_string (double, char *, int);
double asReal () const { double asReal () const {
if (type () == Cell::Int) if (type () == Cell::Int)

View File

@ -744,7 +744,7 @@ SECTION(6 9)
(delay (3 3)) ==> (3 3) (delay (3 3)) ==> (3 3)
(delay 2) ==> 2 (delay 2) ==> 2
(#<subr force> #<compiled-promise>) ==> 6 (#<subr force> #<compiled-promise>) ==> 6
(#<subr force> #<forced-compiled-promise>) ==> 6 (#<subr force> 6) ==> 6
(force 3) ==> 3 (force 3) ==> 3
errors were: errors were:

View File

@ -52,8 +52,7 @@
(display (cdr result)) (display (cdr result))
(display " ") (display " ")
(set! total-time (+ total-time (cdr result)))) (set! total-time (+ total-time (cdr result))))
(else (display "FAIL: "))
(display "FAIL: ")))
(display testcase) (display testcase)
(newline))) (newline)))
testcases) testcases)