Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-13 07:47:39 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

bug fixes for record types

Browse source
This commit is contained in:
Justin Ethier 2016-04-27 22:11:44 -04:00
parent 76a3778dda
commit 7276bcbacf
4 changed files with 35 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
debug/kons.scm
View file

@ -1,7 +1,7 @@
;; A temporary test file ;; A temporary test file
(import (scheme base) (import (scheme base)
(scheme write) (scheme write)
(srfi 9) ;(srfi 9)
) )
;; TODO: seems begins are not spliced when part of an applied lambda?? ;; TODO: seems begins are not spliced when part of an applied lambda??

30
scheme/base.sld
View file

@ -17,16 +17,17 @@
; TODO: need filter for the next two. also, they really belong in SRFI-1, not here ; TODO: need filter for the next two. also, they really belong in SRFI-1, not here
;delete ;delete
;delete-duplicates ;delete-duplicates
;; TODO: possibly relocating here in the future ;; Record types
define-record-type define-record-type
record? record?
; register-simple-type register-simple-type
; make-type-predicate make-type-predicate
; make-constructor make-constructor
; make-getter make-getter
; make-setter make-setter
; slot-set! slot-set!
; type-slot-offset type-slot-offset
;; END records
receive receive
abs abs
max max
@ -1385,7 +1386,7 @@
new))) new)))
(define (type-slot-offset name sym) (define (type-slot-offset name sym)
(let ((field-tags (vector-ref name 2))) (let ((field-tags (vector-ref name 2)))
(list-index2 sym field-tags))) (_list-index sym field-tags)))
(define (slot-set! name obj idx val) (define (slot-set! name obj idx val)
(let ((vec obj)) ;; TODO: get actual slots from obj (let ((vec obj)) ;; TODO: get actual slots from obj
(vector-set! (vector-ref vec 2) idx val))) (vector-set! (vector-ref vec 2) idx val)))
@ -1396,6 +1397,17 @@
(lambda (obj val) (lambda (obj val)
(vector-set! (vector-ref obj 2) idx val))) (vector-set! (vector-ref obj 2) idx val)))
;; Find index of element in list, or -1 if not found
(define _list-index
(lambda (e lst)
(if (null? lst)
-1
(if (eq? (car lst) e)
0
(if (= (_list-index e (cdr lst)) -1)
-1
(+ 1 (_list-index e (cdr lst))))))))
(define (record? obj) (define (record? obj)
(and (vector? obj) (and (vector? obj)
(> (vector-length obj) 0) (> (vector-length obj) 0)

13
srfi/9.sld
View file

@ -45,7 +45,7 @@
new))) new)))
(define (type-slot-offset name sym) (define (type-slot-offset name sym)
(let ((field-tags (vector-ref name 2))) (let ((field-tags (vector-ref name 2)))
(list-index2 sym field-tags))) (_list-index sym field-tags)))
(define (slot-set! name obj idx val) (define (slot-set! name obj idx val)
(let ((vec obj)) ;; TODO: get actual slots from obj (let ((vec obj)) ;; TODO: get actual slots from obj
(vector-set! (vector-ref vec 2) idx val))) (vector-set! (vector-ref vec 2) idx val)))
@ -61,6 +61,17 @@
(> (vector-length obj) 0) (> (vector-length obj) 0)
(equal? record-marker (vector-ref obj 0)))) (equal? record-marker (vector-ref obj 0))))
;; Find index of element in list, or -1 if not found
(define _list-index
(lambda (e lst)
(if (null? lst)
-1
(if (eq? (car lst) e)
0
(if (= (_list-index e (cdr lst)) -1)
-1
(+ 1 (_list-index e (cdr lst))))))))
(define-syntax define-record-type (define-syntax define-record-type
(er-macro-transformer (er-macro-transformer
(lambda (expr rename compare) (lambda (expr rename compare)

2
tests/unit-tests.scm
View file

@ -5,7 +5,7 @@
(scheme read) (scheme read)
(scheme write) (scheme write)
(scheme eval) (scheme eval)
(srfi 9) ;(srfi 9)
) )
(define *num-passed* 0) (define *num-passed* 0)