continuing to debug falling rain world program

This commit is contained in:
Danny Yoo 2011-07-20 14:06:52 -04:00
parent 615319f9ac
commit cfd65fc782
5 changed files with 89 additions and 5 deletions

View File

@ -41,10 +41,23 @@
(define-struct world (sky ;; listof drop
))
(define (my-filter f l)
(cond
[(null? l)
'()]
[(f (car l))
(cons (car l)
(my-filter f (cdr l)))]
[else
(my-filter f (cdr l))]))
;; tick: world -> world
(define (tick w)
(make-world
(filter not-on-floor?
(my-filter not-on-floor?
(map drop-descend (cons (random-drop) (world-sky w))))))
@ -90,9 +103,20 @@
a-scene))
(define (my-foldl f acc lst)
(cond
[(null? lst)
acc]
[else
(my-foldl f
(f (car (car lst)) acc)
(cdr lst))]))
;; draw: world -> scene
(define (draw w)
(foldl place-drop BACKGROUND (world-sky w)))
(my-foldl place-drop BACKGROUND (world-sky w)))

View File

@ -24,6 +24,29 @@
}
};
var makeCheckParameterizedArgumentType = function(parameterizedPredicate,
parameterizedPredicateName) {
return function(MACHINE, callerName, position) {
var args = [];
for (var i = 3; i < arguments.length; i++) {
args.push(arguments[i]);
}
testArgument(
MACHINE,
parameterizedPredicateName.apply(null, args),
function(x) {
return parameterizedPredicate.apply(null, [x].concat(args));
},
MACHINE.env[MACHINE.env.length - 1 - position],
position,
callerName);
return MACHINE.env[MACHINE.env.length - 1 - position];
}
};
var makeCheckListofArgumentType = function(predicate, predicateName) {
var listPredicate = function(x) {
@ -127,6 +150,14 @@
plt.baselib.numbers.isNatural,
'natural');
var checkNaturalInRange = makeCheckParameterizedArgumentType(
function(x, a, b) {
return plt.baselib.numbers.isNatural(x) &&
}
function(a, b) {
return plt.baselib.format('natural between ~a and ~a', [a, b])
});
var checkInteger = makeCheckArgumentType(
plt.baselib.numbers.isInteger,
'integer');
@ -182,6 +213,7 @@
exports.testArgument = testArgument;
exports.testArity = testArity;
exports.makeCheckArgumentType = makeCheckArgumentType;
exports.makeCheckParameterizedArgumentType = makeCheckParameterizedArgumentType;
exports.makeCheckListofArgumentType = makeCheckListofArgumentType;
exports.checkOutputPort = checkOutputPort;
@ -192,6 +224,7 @@
exports.checkReal = checkReal;
exports.checkNonNegativeReal = checkNonNegativeReal;
exports.checkNatural = checkNatural;
exports.checkNaturalInRange = checkNaturalInRange;
exports.checkInteger = checkInteger;
exports.checkRational = checkRational;
exports.checkPair = checkPair;

View File

@ -191,6 +191,17 @@
};
var length = function(lst) {
var len = 0;
while (lst !== EMPTY) {
len++;
lst = lst.rest;
}
return len;
};
//////////////////////////////////////////////////////////////////////
exports.EMPTY = EMPTY;
@ -202,6 +213,7 @@
exports.makePair = makePair;
exports.makeList = makeList;
exports.reverse = reverse;
exports.length = length;
})(this['plt'].baselib);

View File

@ -115,6 +115,7 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
var checkReal = plt.baselib.check.checkReal;
var checkNonNegativeReal = plt.baselib.check.checkNonNegativeReal;
var checkNatural = plt.baselib.check.checkNatural;
var checkNaturalInRange = plt.baselib.check.checkNaturalInRange;
var checkInteger = plt.baselib.check.checkInteger;
var checkRational = plt.baselib.check.checkRational;
var checkPair = plt.baselib.check.checkPair;
@ -828,6 +829,19 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
return result;
});
installPrimitiveProcedure(
'list-ref',
2,
function(MACHINE) {
var lst = checkList(MACHINE, 'list-ref', 0);
var index = checkNaturalInRange(MACHINE, 'list-ref', 1,
0, plt.baselib.lists.length(lst));
});
installPrimitiveProcedure(
'car',
1,
@ -951,7 +965,8 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
var elts = checkVector(MACHINE, 'vector-set!', 0).elts;
// FIXME: check out-of-bounds vector
var index = plt.baselib.numbers.toFixnum(
checkNatural(MACHINE, 'vector-set!', 1));
checkNaturalInRange(MACHINE, 'vector-set!', 1,
0, elts.length));
var val = MACHINE.env[MACHINE.env.length - 1 - 2];
elts[index] = val;
return VOID;

View File

@ -291,7 +291,7 @@ exact?
length
;; list?
;; list*
;; list-ref
list-ref
;; list-tail
append
reverse