ray/ordo
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Some refactoring

Browse source 
* Don't export record field setters (unless required)
* Remove get- prefix from record getters
* Introduce handlers (simplified tasks)
This commit is contained in:
Ray Miller 2025-01-05 19:10:42 +00:00
parent 297d779ea4
commit 52f011267b
Signed by: ray
GPG key ID: 043F786C4CD681B8
6 changed files with 89 additions and 51 deletions
Download patch file Download diff file Expand all files Collapse all files

30
modules/ordo/context.scm
View file

@ -2,26 +2,26 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:export (make-context
#:export (context
context?
get-context-scratch-dir
set-context-scratch-dir!
context-scratch-dir
add-context-triggers!
get-context-triggers
set-context-triggers!
get-context-vars
set-context-vars!
context-triggered?
register-context-var!
context-ref
resolve-context-ref
resolve-context-refs))
(define-record-type <context>
(make-context)
(make-context scratch-dir vars)
context?
(scratch-dir get-context-scratch-dir set-context-scratch-dir!)
(vars get-context-vars set-context-vars!)
(triggers get-context-triggers set-context-triggers!))
(scratch-dir context-scratch-dir set-context-scratch-dir!)
(vars context-vars set-context-vars!)
(triggers context-triggers set-context-triggers!))
(define* (context #:key scratch-dir init-vars)
(make-context scratch-dir init-vars))
(define-record-type <context-ref>
(context-ref name)
@ -30,7 +30,7 @@
(define (resolve-context-ref ctx v)
(if (context-ref? v)
(assoc-ref (get-context-vars ctx) (var-name v))
(assoc-ref (context-vars ctx) (var-name v))
v))
(define (resolve-context-refs ctx args)
@ -38,7 +38,11 @@
(define (add-context-triggers! ctx triggers)
(when triggers
(set-context-triggers! ctx (fold cons (or (get-context-triggers ctx) '()) triggers))))
(set-context-triggers! ctx
(apply lset-adjoin equal? (or (context-triggers ctx) '()) triggers))))
(define (context-triggered? ctx trigger)
(find (lambda (t) (equal? t trigger)) (context-triggers ctx)))
(define (register-context-var! ctx var-name val)
(set-context-vars! ctx (assoc-set! (get-context-vars ctx) var-name val)))
(set-context-vars! ctx (assoc-set! (context-vars ctx) var-name val)))