From 1776abc8e977e4fdf0d518c96286680c841d3d67 Mon Sep 17 00:00:00 2001 From: Rose Hogenson Date: Fri, 5 Aug 2022 21:28:34 -0700 Subject: Check that records are the correct type. To avoid selecting the wrong field, or reading out of bounds, we should ensure that a record is the correct type before reading a field. --- lib/scheme/base/50-records.csc | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) (limited to 'lib/scheme/base') diff --git a/lib/scheme/base/50-records.csc b/lib/scheme/base/50-records.csc index d7fa8d1..2830b3c 100644 --- a/lib/scheme/base/50-records.csc +++ b/lib/scheme/base/50-records.csc @@ -29,17 +29,23 @@ (define-syntax define-selectors (syntax-rules () - ((define-selectors (selectors ...)) + ((define-selectors pred (selectors ...)) (values selectors ...)) - ((define-selectors (selectors ...) (field getter) selector ...) - (define-selectors (selectors ... (lambda (r) - (call-builtin peek r field))) + ((define-selectors pred (selectors ...) (field getter) selector ...) + (define-selectors pred (selectors ... (lambda (r) + (unless (pred r) + (error "unexpected type in getter" r 'getter)) + (call-builtin peek r field))) selector ...)) - ((define-selectors (selectors ...) (field getter setter) selector ...) - (define-selectors (selectors ... (lambda (r) - (call-builtin peek r field)) - (lambda (r val) - (call-builtin poke val r field))) + ((define-selectors pred (selectors ...) (field getter setter) selector ...) + (define-selectors pred (selectors ... (lambda (r) + (unless (pred r) + (error "unexpected type in getter" r 'getter)) + (call-builtin peek r field)) + (lambda (r val) + (unless (pred r) + (error "unexpected type in setter" r 'setter)) + (call-builtin poke val r field))) selector ...)))) -- cgit v1.3.1