mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 23:10:21 +02:00
Code Activity

Fix some srfi-105 parsing errors

Browse source 
* module/ice-9/read.scm (%read): Fix parsing errors.
This commit is contained in:
Andy Wingo 2021-03-03 22:56:58 +01:00
parent 94279414a8
commit ea86a5c6d2
1 changed files with 8 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

15
module/ice-9/read.scm
View file

@ -190,17 +190,18 @@
(and (pair? ls) (and (pair? ls)
(let ((op (car ls)) (let ((op (car ls))
(ls (cdr ls))) (ls (cdr ls)))
(if (null? ls) (if (and (pair? ls) (null? (cdr ls)))
(list op x) (cons* op x ls)
(let ((tail (extract-infix-list ls))) (let ((tail (extract-infix-list ls)))
(and tail (and tail
(equal? op (car tail)) (equal? (strip-annotation op)
(strip-annotation (car tail)))
(cons* op x (cdr tail)))))))))) (cons* op x (cdr tail))))))))))
(cond (cond
((or (not (eqv? rdelim #\}))) ret) ; Only on {...} lists. ((not (eqv? rdelim #\})) ret) ; Only on {...} lists.
((null? ret) ret) ; {} => () ((not (pair? ret)) ret) ; {} => ()
((null? (cdr ret)) (car ret)) ; {x} => x ((not (pair? (cdr ret))) (car ret)); {x} => x
((null? (cddr ret)) ret) ; {x y} => (x y) ((not (pair? (cddr ret))) ret) ; {x y} => (x y)
((extract-infix-list ret)) ; {x + y + ... + z} => (+ x y ... z) ((extract-infix-list ret)) ; {x + y + ... + z} => (+ x y ... z)
(else (cons '$nfx$ ret)))) ; {x y . z} => ($nfx$ x y . z) (else (cons '$nfx$ ret)))) ; {x y . z} => ($nfx$ x y . z)
(define curly? (eqv? rdelim #\})) (define curly? (eqv? rdelim #\}))