- 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:
parent
544d0422aa
commit
6acf5eaf16
14
src/cell.cpp
14
src/cell.cpp
|
@ -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
|
||||||
{
|
{
|
||||||
|
|
|
@ -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>");
|
||||||
|
|
|
@ -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;
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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:
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue