You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
58 lines
2.3 KiB
58 lines
2.3 KiB
(import :std/format) |
|
;; Units |
|
(define is-units? (lambda (object);;; Inspector |
|
(cond ((eq? 'units (car object)) #t) |
|
(else #f) ) )) |
|
|
|
(define make-units (lambda (units);;; Constructor |
|
(cond ((not (zero? units)) (cons 'units units)) |
|
(else (error "(Argument 1) Unsigned 8 bit exact non-zero INTEGER expected")) ) )) |
|
|
|
;; Asset |
|
(define is-asset? (lambda (object);;; Inspector |
|
(cond ((eq? 'asset (car object)) #t) |
|
(else #f) ) )) |
|
|
|
;; New make-asset |
|
(define asset-types (vector "ETF" "Stock" "Mutual Fund")) |
|
(define make-asset (lambda (asset asset-type) |
|
(let loop |
|
((vector-index (- (vector-length asset-types) 1))) |
|
;(display (format "Evaluates ~a = ~a .\n" (vector-ref asset-types vector-index) asset-type)) |
|
;(display (equal? (vector-ref asset-types vector-index) asset-type)) |
|
(cond ((> 0 vector-index) |
|
(error `"(Argument 2) defined ASSET-TYPE expected. Is ,asset-type defined?")) |
|
((equal? (vector-ref asset-types vector-index) asset-type) |
|
(list 'asset asset asset-type) ) |
|
(else (loop (- vector-index 1))) ) ) )) |
|
;(define make-asset (lambda (asset);;; Constructor |
|
; (cond ((string? asset) (cons 'asset asset)) |
|
; (else (error "(Argument 1) STRING expected")) ) )) |
|
|
|
;;Holding |
|
(define is-holding? (lambda (object);;; Inspector |
|
(cond ((eq? 'holding (car object)) #t) |
|
(else #f) ) )) |
|
|
|
(define make-holding (lambda (asset units);;; Constructor |
|
(cond ((and (is-asset? asset) (is-units? units)) (list 'holding asset units)) |
|
(else (error "Type Error")) ) )) |
|
|
|
(define get-units (lambda (holding);;; Selector->Units |
|
(cond ((is-holding? holding) (caddr holding)) |
|
(else (error "(Argument 1) HOLDING expected")) ) )) |
|
|
|
(define get-asset (lambda (holding);;; Selector->Asset |
|
(cond ((is-holding? holding) (cadr holding)) |
|
(else (error "(Argument 1) HOLDING expected")) ) )) |
|
|
|
(define get-asset-type (lambda (holding);;; Selector->Asset |
|
(cond ((is-holding? holding) (list-ref (cadr holding) 2)) |
|
(else (error "(Argument 1) HOLDING expected")) ) )) |
|
|
|
(define print-holding (lambda (holding);;; Print |
|
(cond ((is-holding? holding) |
|
(printf (format "(~a)[~d]\n" |
|
(cadr (get-asset holding)) (cdr (get-units holding)) )) ) |
|
(else (error "(Argument 1) HOLDING expected")) ) )) |
|
;; Database functions
|
|
|