alist-access: avoid parser variables (broken)

[uliska]

Don't store alists as parser variables, essentially replacing ly:parser-lookup and ly:parser-define! with accessing a data structure in a closure.

This seems to break while loading the module, although the code works properly when copied to a standalone LilyPond file.

---

BTW: I think we should separate this even more, as there are two independent topics in the file:

• Generic functions to access alists (working on the actual list datastructures)
• Handling named alists stored in the data structure

[uliska]

Starting the basic file

\version "2.21.3"

\include "oll-core/package.ily"

fails with the following log, presumably while loading the module (not while using it), leaving no meaningful error messages:

Starting lilypond 2.21.3 [Untitled (2)]...
Processing `/tmp/frescobaldi-acsjzayr/tmpzt1z3aec/document.ly'
Parsing...
/home/uliska/git/oll-lib/oll-core/internal/init.ily:55:2: error: GUILE signaled an error for the expression beginning here
#
 (use-modules (oll-core internal alist-access))
/home/uliska/git/oll-lib/oll-core/internal/options.ily:378:1: error: unknown escaped string: `\newAtree'

\newAtree oll-options
/home/uliska/git/oll-lib/oll-core/internal/options.ily:378:11: error: syntax error, unexpected SYMBOL, expecting '.' or '='
\newAtree 
          oll-options
no code for module (oll-core internal logging)
/home/uliska/git/oll-lib/oll-core/internal/options.ily:389:4: In expression (setAtree (quote oll-options) opt-path ...):
/home/uliska/git/oll-lib/oll-core/internal/options.ily:389:4: Unbound variable: setAtree
Exited with return code 1.

[uliska]

The following standalone file with the code of alist-access.scm and a little bit from options.scm works properly:

\version "2.21.3"

%\include "oll-core/package.ily"

#(define retrieve-list #f)
#(define save-list #f)

#(let
 ((lists (list)))
 (set! retrieve-list
       (lambda (name)
         (assq-ref lists name)))
 (set! save-list
       (lambda (name alst)
         (set!
          lists
          (assq-set! lists name alst)))))

#(define (check-alst funcname alst key-name val)
  (if (not (retrieve-list alst))
      (oll:warn "
Trying to access non-present alist '~a' with function '~a',
using key '~a' and ~a.  This will create a new alist instead,
which is probably not intended."
        alst funcname key-name
        (if val
            (format "value '~a'" val)
            "no value"))))

#(define (set-in-alist alst key-name val in-place)
  (let* ((process-alist
          (if in-place
              alst
              (assoc-remove! alst key-name)))
         (where (assoc key-name process-alist)))
    (if where
        (begin (set-cdr! where val) alst)
        (append alst (list (cons key-name val))))))

#(define (set-a-list funcname alst key-name val in-place)
  (check-alst funcname alst key-name val)
  (save-list alst
    (set-in-alist (retrieve-list alst) key-name val in-place)))

#(define (get-from-alist alst key-name return-pair)
  (let ((intermediate (assoc key-name alst)))
    (if return-pair
        intermediate
        (if (pair? intermediate)
            (cdr intermediate)
            #f))))

#(define (set-in-atree tree path val in-place)
  (let ((key-name (car path)))
    (if (not (list? tree))
        (begin
         (ly:input-warning (*location*) "Not a list. Deleting '~A'" tree)
         (set! tree '())))
    (cond ((> (length path) 1)
           (let ((subtree (assoc-get key-name tree '())))
             (set-in-alist
              tree
              key-name
              ;; Intermediate nodes are always updated in-place
              (set-in-atree subtree (cdr path) val #t)
              in-place)))
      (else
       (set-in-alist tree key-name val in-place)))))

#(define (set-a-tree atree path val in-place)
  (save-list atree
    (set-in-atree (retrieve-list atree) path val in-place)))

#(define (get-from-tree tree path return-pair)
  (let ((key-name (car path)))
    (if (> (length path) 1)
        (let ((subtree (assoc-get key-name tree #f)))
          (if (list? subtree)
              (get-from-tree subtree (cdr path) return-pair)
              #f))
        (get-from-alist tree (car path) return-pair))))

#(define (remove-value tree path)
  (let* ((key-name (car path))
         (subpath (cdr path))
         (subtree (assoc-get key-name tree '())))
    (cond
     ((> (length subpath) 1)
      (set-in-alist tree key-name (remove-value subtree (cdr path)) #t))
     (else
      (set-in-alist tree key-name (assoc-remove! subtree (car subpath)) #t)))))

#(define-public newAlist
  (define-void-function (name)(symbol?)
    "Creates or resets <name> as an empty list."
    (save-list name (list))))

#(define-public setAlist
  (define-void-function (alst key-name val)(symbol? symbol? scheme?)
    (set-a-list 'setAlist alst key-name val #t)))

#(define-public addToAlist
  (define-void-function (alst key-name val) (symbol? symbol? scheme?)
    (set-a-list 'addToAlist alst key-name val #f)))

#(define-public removeFromAlist
  (define-void-function (alst key-name)(symbol? symbol?)
    (check-alst 'removeFromAlist alst key-name #f)
    (save-list alst
      (assoc-remove! (retrieve-list alst) key-name))))

#(define-public newAtree newAlist)

#(define-public setAtree
  (define-void-function (atree path val)(symbol? list? scheme?)
    (set-a-tree atree path val #t)))

#(define-public addAtree
  (define-void-function (atree path val)(symbol? list? scheme?)
    (set-a-tree atree path val #f)))

#(define-public getAtree
  (define-scheme-function (return-pair atree path)
    ((boolean?) symbol? symbol-list-or-symbol?)
    (check-alst 'getAtree atree path #f)
    (get-from-tree (retrieve-list atree) path return-pair)))

#(define-public remAtree
  (define-void-function (atree path)(symbol? list?)
    (check-alst 'remAtree atree path #f)
    (save-list atree
      (remove-value (retrieve-list atree) path))))

#(define-public extract-options
  (define-scheme-function (ctx-mods)((ly:context-mod?))
    (ly:warning "\"extract-options\" from module alist-access is deprecated.
Please use the equivalent context-mod->props instead.")
    (map (lambda (o)
           (cons (cadr o) (caddr o)))
      (ly:get-context-mods ctx-mods))))

\newAtree oll-options

#(define-public registerOption
(define-void-function (opt-path init)(symbol-list? scheme?)
   (setAtree 'oll-options opt-path init)))

#(define-public getOption
(define-scheme-function (path) (symbol-list?)
  "Retrieve value of an existing option."
   (let ((option (getAtree #t 'oll-options path)))
     (if option
         ;; getAtree has returned a pair => option is set
         (cdr option)
         ;; getAtree has returned #f
         (begin
          (oll-warn
           "Trying to access non-existent option: ~a" (os-path-join-dots path))
          #f)))))

\registerOption mein.baum 34

#(display (getOption '(mein baum)))

[uliska]

I've found a better approach, including the separation of generic access and named access.