public inbox for cgen@sourceware.org
 help / color / mirror / Atom feed
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


  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).