Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

116 lines (68 sloc) 2.474 kb
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(import (rnrs)
(dharmalab records define-record-type))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-record-type++ point
(fields x y)
(methods (neg point::neg)))
(define (point::neg p)
(import-point p)
(make-point (- x) (- y)))
(define p0 (make-point 1 2))
(is-point p0)
(assert (= p0.x 1))
(assert (and (= (point-x (p0.neg)) -1)
(= (point-y (p0.neg)) -2)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-record-type++ point-3d
(parent point)
(fields z))
(define p1 (make-point-3d 1 2 3))
(is-point-3d p1)
(assert (equal? (list p1.x p1.y p1.z) '(1 2 3)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-record-type++ spaceship
(fields pos vel))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define ship (make-spaceship (make-point 1 2) (make-point 3 4)))
(is-spaceship ship)
(is-point ship.pos)
(assert (equal? (list ship.pos.x
ship.pos.y)
'(1 2)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-record-type++ bank-account
(fields (mutable balance))
(methods
(deposit bank-account::deposit)
(withdraw bank-account::withdraw)))
(define (bank-account::deposit self amount)
(import-bank-account self)
(balance! (+ balance amount)))
(define (bank-account::withdraw self amount)
(import-bank-account self)
(when (> amount balance)
(error #t "Account overdrawn"))
(balance! (- balance amount))
balance)
(define b0 (make-bank-account 0))
(is-bank-account b0)
(b0.deposit 100)
(assert (= b0.balance 100))
(b0.withdraw 50)
(assert (= b0.balance 50))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (define-record-type++ checking-account
;; (parent bank-account)
;; (fields overdraft-account)
;; (methods
;; (withdraw checking-account::withdraw)))
;; (define (checking-account::withdraw self amount)
;; (import-checking-account self)
;; (is-bank-account overdraft-account)
;; (let ((overdraft-amount (- amount balance)))
;; (when (> overdraft-amount 0)
;; (overdraft-account.withdraw overdraft-amount)
;; (overdraft-account.deposit overdraft-amount)))
;; (withdraw amount))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Jump to Line
Something went wrong with that request. Please try again.