diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-03-21 21:19:50 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-03-21 21:19:50 +0100 |
commit | ecb92a54a8c2dce5f60765f3dece4223b9ff856a (patch) | |
tree | f9ec6a8d2370727f87b57b5d100368c1d3f44919 /util.scm | |
parent | Add filter-sorted-stream. (diff) | |
download | calp-ecb92a54a8c2dce5f60765f3dece4223b9ff856a.tar.gz calp-ecb92a54a8c2dce5f60765f3dece4223b9ff856a.tar.xz |
Fixed recurrence code.
Diffstat (limited to 'util.scm')
-rw-r--r-- | util.scm | 30 |
1 files changed, 23 insertions, 7 deletions
@@ -48,7 +48,7 @@ (define (%define-quick-record internal-define bang? name fields) (let ((symb (gensym))) - `(begin (,internal-define ,(class-name name) + `((,internal-define ,(class-name name) (,(constructor name) ,@fields) ,(pred name) ,@(map (lambda (f) `(,f ,(getter f symb) ,(setter f symb bang?))) @@ -60,13 +60,21 @@ ;;; Creates srfi-9 define{-immutable,}-record-type declations. ;;; Also creates srfi-17 accessor ((set! (access field) value)) -(define-macro (define-quick-record name . fields) - (%define-quick-record '(@ (srfi srfi-9 gnu) define-immutable-record-type) - #f name fields)) +;; (define (define-quick-record-templated define-proc name field)) -(define-macro (define-quick-record! name . fields) - (%define-quick-record '(@ (srfi srfi-9) define-record-type) - #t name fields)) +(define-macro (define-quick-record name . fields) + (let ((public-fields (or (assoc-ref fields #:public) '())) + (private-fields (or (assoc-ref fields #:private) '()))) + `(begin + ,@(%define-quick-record '(@ (srfi srfi-9 gnu) define-immutable-record-type) + #f name + (append public-fields private-fields)) + ,@(map (lambda (field) `(export ,field)) + public-fields)))) + ;; (define-quick-record-templated 'define-immutable-record-type name fields)) + +;; (define-macro (define-quick-record! name . fields) +;; (define-quick-record-templated 'define-record-type name fields)) ;;; Replace let* with a version that can bind from lists. ;;; Also supports SRFI-71 (extended let-syntax for multiple values) @@ -146,3 +154,11 @@ (cdr items) ;; seeds: (car items) '()))) + +(define-public (filter-sorted proc list) + (take-while + proc (drop-while + (negate proc) list))) + +;; (define (!= a b) (not (= a b))) +(define-public != (negate =)) |