From: Tom Tromey <tom@tromey.com>
To: cgen@sourceware.org
Cc: Tom Tromey <tom@tromey.com>
Subject: [RFC 09/14] Remove define-in-define
Date: Sat, 19 Aug 2023 11:42:08 -0600 [thread overview]
Message-ID: <20230819174900.866436-10-tom@tromey.com> (raw)
In-Reply-To: <20230819174900.866436-1-tom@tromey.com>
Guile does not like 'define' in certain contexts, such as within the
body of another 'define'. This replaces some instances of this with
let or let*.
---
pgmr-tools.scm | 250 +++++++++++++++++++++++++------------------------
1 file changed, 129 insertions(+), 121 deletions(-)
diff --git a/pgmr-tools.scm b/pgmr-tools.scm
index 367213a..bfd9937 100644
--- a/pgmr-tools.scm
+++ b/pgmr-tools.scm
@@ -35,120 +35,125 @@
(define (pgmr-pretty-print-insn-format insn)
- (define (to-width width n-str)
- (string-take-with-filler (- width)
- n-str
- #\0))
+ (let* ((to-width
+ (lambda (width n-str)
+ (string-take-with-filler (- width)
+ n-str
+ #\0)))
- (define (dump-insn-mask mask insn-length)
- (string-append "0x" (to-width (quotient insn-length 4)
- (number->string mask 16))
- ", "
- (string-map
- (lambda (n)
- (string-append " " (to-width 4 (number->string n 2))))
- (reverse
- (split-bits (make-list (quotient insn-length 4) 4)
- mask)))))
+ (dump-insn-mask
+ (lambda (mask insn-length)
+ (string-append "0x" (to-width (quotient insn-length 4)
+ (number->string mask 16))
+ ", "
+ (string-map
+ (lambda (n)
+ (string-append " " (to-width 4 (number->string n 2))))
+ (reverse
+ (split-bits (make-list (quotient insn-length 4) 4)
+ mask))))))
- ; Print VALUE with digits not in MASK printed as "X".
- (define (dump-insn-value value mask insn-length)
- (string-append "0x" (to-width (quotient insn-length 4)
- (number->string value 16))
- ", "
- (string-map
- (lambda (n mask)
- (string-append
- " "
- (list->string
- (map (lambda (char in-mask?)
- (if in-mask? char #\X))
- (string->list (to-width 4 (number->string n 2)))
- (bits->bools mask 4)))))
- (reverse
- (split-bits (make-list (quotient insn-length 4) 4)
- value))
- (reverse
- (split-bits (make-list (quotient insn-length 4) 4)
- mask)))))
+ ;; Print VALUE with digits not in MASK printed as "X".
+ (dump-insn-value
+ (lambda (value mask insn-length)
+ (string-append "0x" (to-width (quotient insn-length 4)
+ (number->string value 16))
+ ", "
+ (string-map
+ (lambda (n mask)
+ (string-append
+ " "
+ (list->string
+ (map (lambda (char in-mask?)
+ (if in-mask? char #\X))
+ (string->list (to-width 4 (number->string n 2)))
+ (bits->bools mask 4)))))
+ (reverse
+ (split-bits (make-list (quotient insn-length 4) 4)
+ value))
+ (reverse
+ (split-bits (make-list (quotient insn-length 4) 4)
+ mask))))))
- (define (dump-ifield f)
- (string-append " Name: "
- (obj:name f)
- ", "
- "Start: "
- (number->string
- (+ (bitrange-word-offset (-ifld-bitrange f))
- (bitrange-start (-ifld-bitrange f))))
- ", "
- "Length: "
- (number->string (ifld-length f))
- "\n"))
+ (dump-ifield
+ (lambda (f)
+ (string-append " Name: "
+ (obj:name f)
+ ", "
+ "Start: "
+ (number->string
+ (+ (bitrange-word-offset (-ifld-bitrange f))
+ (bitrange-start (-ifld-bitrange f))))
+ ", "
+ "Length: "
+ (number->string (ifld-length f))
+ "\n"))))
- (let* ((iflds (sort-ifield-list (insn-iflds insn)
- (not (current-arch-insn-lsb0?))))
- (mask (compute-insn-base-mask iflds))
- (mask-length (compute-insn-base-mask-length iflds)))
+ (let* ((iflds (sort-ifield-list (insn-iflds insn)
+ (not (current-arch-insn-lsb0?))))
+ (mask (compute-insn-base-mask iflds))
+ (mask-length (compute-insn-base-mask-length iflds)))
- (display
- (string-append
- "Instruction: " (obj:name insn)
- "\n"
- "Syntax: "
- (insn-syntax insn)
- "\n"
- "Fields:\n"
- (string-map dump-ifield iflds)
- "Instruction length (computed from ifield list): "
- (number->string (apply + (map ifld-length iflds)))
- "\n"
- "Mask: "
- (dump-insn-mask mask mask-length)
- "\n"
- "Value: "
- (let ((value (apply +
- (map (lambda (fld)
- (ifld-value fld mask-length
- (ifld-get-value fld)))
- (find ifld-constant? (ifields-base-ifields (insn-iflds insn)))))))
- (dump-insn-value value mask mask-length))
- ; TODO: Print value spaced according to fields.
- "\n"
- )))
-)
+ (display
+ (string-append
+ "Instruction: " (obj:name insn)
+ "\n"
+ "Syntax: "
+ (insn-syntax insn)
+ "\n"
+ "Fields:\n"
+ (string-map dump-ifield iflds)
+ "Instruction length (computed from ifield list): "
+ (number->string (apply + (map ifld-length iflds)))
+ "\n"
+ "Mask: "
+ (dump-insn-mask mask mask-length)
+ "\n"
+ "Value: "
+ (let ((value (apply +
+ (map (lambda (fld)
+ (ifld-value fld mask-length
+ (ifld-get-value fld)))
+ (find ifld-constant? (ifields-base-ifields (insn-iflds insn)))))))
+ (dump-insn-value value mask mask-length))
+ ; TODO: Print value spaced according to fields.
+ "\n"
+ )))
+ ))
; Pretty print an instruction's value.
(define (pgmr-pretty-print-insn-value insn value)
- (define (dump-ifield ifld value name-width)
- (string-append
- (string-take name-width (obj:str-name ifld))
- ": "
- (number->string value)
- ", 0x"
- (number->hex value)
- "\n"))
+ (let ((dump-ifield
+ (lambda (ifld value name-width)
+ (string-append
+ (string-take name-width (obj:str-name ifld))
+ ": "
+ (number->string value)
+ ", 0x"
+ (number->hex value)
+ "\n"))))
- (let ((ifld-values (map (lambda (ifld)
- (ifld-extract ifld insn value))
- (insn-iflds insn)))
- (max-name-length (apply max
- (map string-length
- (map obj:name
- (insn-iflds insn)))))
- )
+ (let ((ifld-values (map (lambda (ifld)
+ (ifld-extract ifld insn value))
+ (insn-iflds insn)))
+ (max-name-length (apply max
+ (map string-length
+ (map obj:name
+ (insn-iflds insn)))))
+ )
- (display
- (string-append
- "Instruction: " (obj:name insn)
- "\n"
- "Fields:\n"
- (string-map (lambda (ifld value)
- (dump-ifield ifld value max-name-length))
- (insn-iflds insn)
- ifld-values)
- )))
-)
+ (display
+ (string-append
+ "Instruction: " (obj:name insn)
+ "\n"
+ "Fields:\n"
+ (string-map (lambda (ifld value)
+ (dump-ifield ifld value max-name-length))
+ (insn-iflds insn)
+ ifld-values)
+ )))
+ ))
\f
; Return the <insn> object matching VALUE.
; VALUE is either a single number of size base-insn-bitsize,
@@ -161,23 +166,26 @@
#f) ; don't need to analyze semantics
; Return a boolean indicating if BASE matches the base part of <insn> INSN.
- (define (match-base base insn)
- (let ((mask (compute-insn-base-mask (insn-iflds insn)))
- (ivalue (insn-value insn)))
- ; return (value & mask) == ivalue
- (= (logand base mask) ivalue)))
+ (let ((match-base
+ (lambda (base insn)
+ (let ((mask (compute-insn-base-mask (insn-iflds insn)))
+ (ivalue (insn-value insn)))
+ ; return (value & mask) == ivalue
+ (= (logand base mask) ivalue))))
- (define (match-rest value insn)
- #t)
+ (match-rest
+ (lambda (value insn)
+ #t)))
- (let ((base (if (list? value) (car value) value)))
- (let loop ((insns (current-insn-list)))
- (if (null? insns)
- #f
- (let ((insn (car insns)))
- (if (and (= length (insn-length insn))
- (match-base base insn)
- (match-rest value insn))
- insn
- (loop (cdr insns)))))))
-)
+ (let ((base (if (list? value) (car value) value)))
+ (let loop ((insns (current-insn-list)))
+ (if (null? insns)
+ #f
+ (let ((insn (car insns)))
+ (if (and (= length (insn-length insn))
+ (match-base base insn)
+ (match-rest value insn))
+ insn
+ (loop (cdr insns)))))))
+ )
+ )
--
2.41.0
next prev parent reply other threads:[~2023-08-19 18:40 UTC|newest]
Thread overview: 28+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
2023-08-19 17:42 ` [RFC 01/14] Add a .gitignore Tom Tromey
2023-08-20 8:04 ` Jose E. Marchesi
2023-08-19 17:42 ` [RFC 02/14] Remove some 'fastcall' code Tom Tromey
2023-08-20 8:13 ` Jose E. Marchesi
2023-08-22 16:52 ` Tom Tromey
2023-08-19 17:42 ` [RFC 03/14] Remove bound-symbol? Tom Tromey
2023-08-20 8:14 ` Jose E. Marchesi
2023-08-19 17:42 ` [RFC 04/14] Remove =? and >=? aliases Tom Tromey
2023-08-20 8:15 ` Jose E. Marchesi
2023-08-19 17:42 ` [RFC 05/14] Fix bug in insn.scm Tom Tromey
2023-08-20 8:15 ` Jose E. Marchesi
2023-08-19 17:42 ` [RFC 06/14] Remove support for old versions of Guile Tom Tromey
2023-08-19 17:42 ` [RFC 07/14] Use define-macro in rtl.scm Tom Tromey
2023-08-19 17:42 ` [RFC 08/14] Remove let bindings of macros Tom Tromey
2023-08-20 8:33 ` Jose E. Marchesi
2023-08-19 17:42 ` Tom Tromey [this message]
2023-08-19 17:42 ` [RFC 10/14] Hack cos.scm to work with new Guile Tom Tromey
2023-08-19 17:42 ` [RFC 11/14] Invalid code in rtx-traverse.scm Tom Tromey
2023-08-20 8:42 ` Jose E. Marchesi
2023-08-19 17:42 ` [RFC 12/14] Nuke cgen-call-with-debugging and cgen-debugging-stack-start Tom Tromey
2023-08-19 17:42 ` [RFC 13/14] Load macros before uses Tom Tromey
2023-08-19 17:42 ` [RFC 14/14] Remove pprint.scm and cos-pprint.scm Tom Tromey
2023-08-20 8:03 ` [RFC 00/14] Port to Guile 3.0 Jose E. Marchesi
2023-08-20 17:26 ` Frank Ch. Eigler
2023-08-20 19:52 ` Tom Tromey
2023-08-21 1:38 ` Frank Ch. Eigler
2023-08-21 13:06 ` Julian Brown
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20230819174900.866436-10-tom@tromey.com \
--to=tom@tromey.com \
--cc=cgen@sourceware.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).