peter
/
UNSLISP
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

read: change datum label to object, that returns an encapsulated datum label

This commit is contained in:
Peter McGoron 2024-09-27 12:12:16 -04:00
parent fee4198f2f
commit b0ce282a30
1 changed files with 47 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
read.scm
View File

@ -294,9 +294,10 @@
(else (error 'read:ident "invalid operation" op args))))))
(define read:ident-builder
(lambda (start-char location)
(lambda (location . start-char)
(let ((char-list (linked-list:new)))
(char-list 'push start-char)
(if (not (null? start-char))
(char-list 'push (car start-char)))
(lambda (op . args)
(cond
((eq? op 'finalize->ident)
@ -347,8 +348,8 @@
(lambda (table char acc port)
(readtable:act readtable:identifier
(port 'read)
(read:ident-builder char
(port 'location))
(read:ident-builder (port 'location)
char)
port)))
;;; ;;;;;;;;;;;;;;;;;;;;
@ -518,6 +519,30 @@
((eq? op 'toplevel) toplevel)
(else (apply ll op args)))))))
(define read:datum-label
(lambda (location toplevel)
(let ((finalized? #f)
(value '())
(name (read:ident-builder location)))
(lambda (op . args)
(cond
((eq? op 'finalize-value)
(if finalized?
(error 'datum-label "cannot finalize twice"))
(set! finalized? #t)
(set! value (car args))
(set! toplevel #f))
((eq? op 'finalize->ident)
(set! name (name 'finalize->ident)))
((eq? op 'value)
(if (not finalized?)
(error 'datum-label "value called before finalize"))
value)
((eq? op 'toplevel) toplevel)
((eq? op 'type) 'datum-label)
((eq? op 'as-string) (name 'value))
(else (apply name op args)))))))
;;; Readtable for the number part of a datum label / reference. A label
;;; looks like "#[NUMBER]=" and a reference looks like "#[NUMBER]#".
(define readtable:datum-label-next
@ -527,36 +552,24 @@
(list readtable:update-list readtable:digits readtable:push-char)
(list readtable:update #\=
(lambda (_ __ acc port)
;; All datum labels are saved as strings.
(let ((label (list->string (acc 'to-list))))
;; Datum labels are pairs, one with the label and the other
;; with the data that is to be used. The label is there to
;; detect when a datum label refers to iself: i.e.
;; #0=#0# .
;;
;; The CAR is the label and the CDR is the thing it refers
;; to.
(let ((datum-label (cons label '())))
(port 'set-datum-label! label datum-label)
(acc 'finalize->ident)
(port 'set-datum-label! (acc 'as-string) acc)
(let ((next-value (readtable:next (acc 'toplevel)
#f
port)))
;; After reading the part after the datum label, check
;; that the labeled datum is not self a reference to
;; the datum label.
(if (and (pair? next-value)
(equal? (car next-value) label))
(error 'datum-label-next "datum label cannot be itself")
(set-cdr! datum-label next-value))
next-value)))))
(if (eqv? acc next-value)
(error 'datum-label-next "datum label cannot be itself"))
(acc 'finalize-value next-value)
(acc 'value))))
(list readtable:update #\#
(lambda (_ __ acc port)
(let ((label (list->string (acc 'to-list))))
(let ((datum-label (port 'get-datum-label label)))
(if (null? datum-label)
(acc 'finalize->ident)
(let ((datum-label-container (port 'get-datum-label
(acc 'as-string))))
(if (null? datum-label-container)
(error 'datum-label-next
"unknown reference to datum label" label)
(map:val datum-label))))))))
(map:val datum-label-container)))))))
;;; Reads the next toplevel datum, discards it, and then continues at the
;;; toplevel.
@ -578,7 +591,7 @@
(lambda (_ char toplevel port)
(readtable:act readtable:datum-label-next
char
(linked-list/toplevel:new toplevel)
(read:datum-label (port 'location) toplevel)
port)))
(list readtable:update %bol readtable:vector)))
@ -634,6 +647,7 @@
(let ((type (value 'type)))
(cond
((eq? type 'ident) (value 'value))
((eq? type 'datum-label) (uncycle (value 'value)))
(else (vector 'unrepresentable type)))))
(else value)))))
(uncycle value)))))