mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

more pmatchification

Browse source 
* module/system/il/ghil.scm: No need for a match

* module/system/repl/command.scm: Pmatchify

* module/system/vm/disasm.scm: Pmatchify.
This commit is contained in:
Andy Wingo 2008-05-03 19:39:41 +02:00
parent 23d43503d1
commit e429de1e5f
3 changed files with 11 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

1
module/system/il/ghil.scm
View file

@ -21,7 +21,6 @@
(define-module (system il ghil) (define-module (system il ghil)
:use-syntax (system base syntax) :use-syntax (system base syntax)
:use-module (ice-9 match)
:use-module (ice-9 regex) :use-module (ice-9 regex)
:export :export
( (

15
module/system/repl/command.scm
View file

@ -21,6 +21,7 @@
(define-module (system repl command) (define-module (system repl command)
:use-syntax (system base syntax) :use-syntax (system base syntax)
:use-module (system base pmatch)
:use-module (system base compile) :use-module (system base compile)
:use-module (system repl common) :use-module (system repl common)
:use-module (system vm core) :use-module (system vm core)
@ -126,7 +127,7 @@ List available meta commands.
A command group name can be given as an optional argument. A command group name can be given as an optional argument.
Without any argument, a list of help commands and command groups Without any argument, a list of help commands and command groups
are displayed, as you have already seen ;)" are displayed, as you have already seen ;)"
(match args (pmatch args
(() (()
(display-group (lookup-group 'help)) (display-group (lookup-group 'help))
(display "Command Groups:\n\n") (display "Command Groups:\n\n")
@ -140,9 +141,9 @@ are displayed, as you have already seen ;)"
(newline) (newline)
(display "Type `,COMMAND -h' to show documentation of each command.") (display "Type `,COMMAND -h' to show documentation of each command.")
(newline)) (newline))
(('all) ((all)
(for-each display-group *command-table*)) (for-each display-group *command-table*))
((? lookup-group group) ((,group) (guard (lookup-group group))
(display-group (lookup-group group))) (display-group (lookup-group group)))
(else (else
(user-error "Unknown command group: ~A" (car args))))) (user-error "Unknown command group: ~A" (car args)))))
@ -162,15 +163,15 @@ Show description/documentation."
(define (option repl . args) (define (option repl . args)
"option [KEY VALUE] "option [KEY VALUE]
List/show/set options." List/show/set options."
(match args (pmatch args
(() (()
(for-each (lambda (key+val) (for-each (lambda (key+val)
(format #t "~A\t~A\n" (car key+val) (cdr key+val))) (format #t "~A\t~A\n" (car key+val) (cdr key+val)))
repl.options)) repl.options))
((key) ((,key)
(display (repl-option-ref repl key)) (display (repl-option-ref repl key))
(newline)) (newline))
((key val) ((,key ,val)
(repl-option-set! repl key val) (repl-option-set! repl key val)
(case key (case key
((trace) ((trace)
@ -191,7 +192,7 @@ Quit this session."
(define (module repl . args) (define (module repl . args)
"module [MODULE] "module [MODULE]
Change modules / Show current module." Change modules / Show current module."
(match args (pmatch args
(() (puts (binding repl.env.module))))) (() (puts (binding repl.env.module)))))
(define (use repl . args) (define (use repl . args)

6
module/system/vm/disasm.scm
View file

@ -20,10 +20,10 @@
;;; Code: ;;; Code:
(define-module (system vm disasm) (define-module (system vm disasm)
:use-module (system base pmatch)
:use-module (system vm core) :use-module (system vm core)
:use-module (system vm conv) :use-module (system vm conv)
:use-module (ice-9 regex) :use-module (ice-9 regex)
:use-module (ice-9 match)
:use-module (ice-9 format) :use-module (ice-9 format)
:use-module (ice-9 receive) :use-module (ice-9 receive)
:export (disassemble-objcode disassemble-program disassemble-bytecode)) :export (disassemble-objcode disassemble-program disassemble-bytecode))
@ -71,8 +71,8 @@
(do ((addr+code (decode) (decode))) (do ((addr+code (decode) (decode)))
((not addr+code) (newline)) ((not addr+code) (newline))
(receive (addr code) addr+code (receive (addr code) addr+code
(match code (pmatch code
(('load-program x) ((load-program ,x)
(let ((sym (gensym ""))) (let ((sym (gensym "")))
(set! programs (acons sym x programs)) (set! programs (acons sym x programs))
(print-info addr (format #f "(load-program #~A)" sym) #f))) (print-info addr (format #f "(load-program #~A)" sym) #f)))