artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mescc: Create less garbage when dumping M1.

Browse source 
* module/mes/M1.mes (display-join): New function.
* (object->M1): Use it.
This commit is contained in:
Jan Nieuwenhuizen 2018-04-24 07:26:27 +02:00
parent 18d143aa62
commit e628b311d6
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
1 changed files with 13 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
module/mes/M1.mes
View file

@ -84,6 +84,14 @@
(if hex? (string-append "!0x" (dec->hex o))
(string-append "!" (number->string o))))
(define* (display-join o #:optional (sep ""))
(let loop ((o o))
(when (pair? o)
(display (car o))
(if (pair? (cdr o))
(display sep))
(loop (cdr o)))))
(define (object->M1 o)
(stderr "dumping M1: object\n")
(let* ((functions (assoc-ref o 'functions))
@ -127,9 +135,11 @@
(cond ((eq? (car o) #:label)
(display (string-append ":" (cadr o))))
((eq? (car o) #:comment)
(display (string-append "\t\t\t\t\t# " (text->M1 (cadr o)))))
(display "\t\t\t\t\t# ")
(display (text->M1 (cadr o))))
((or (string? (car o)) (symbol? (car o)))
(display (string-append "\t" (string-join (map text->M1 o) " "))))
(display "\t" )
(display-join (map text->M1 o) " "))
(else (error "line->M1 invalid line:" o)))
(newline))
(display (string-append " :" name "\n") (current-error-port))
@ -161,7 +171,7 @@
(not (find (cut memq <> '(#\nul #\backspace #\return #\" #\')) (list-head data (1- (length data)))))
(not (any (lambda (ch) (>= (char->integer ch) #x80)) data)))
(display (string-append "\"" (list->string (list-head data (1- (length data)))) "\"")))
(else (display (string-join (map text->M1 data) " "))))
(else (display-join (map text->M1 data) " ")))
(newline)))
(display "M1: functions\n" (current-error-port))
(for-each write-function (filter cdr functions))