From: Ian Price <ianprice90@googlemail.com>
To: guile-user@gnu.org
Subject: Re: and-let* is not composable?
Date: Sat, 02 Nov 2013 19:01:29 +0000 [thread overview]
Message-ID: <87bo22typi.fsf@Kagami.home> (raw)
In-Reply-To: <87wqkrbk77.fsf@Kagami.home> (Ian Price's message of "Sat, 02 Nov 2013 02:39:56 +0000")
[-- Attachment #1: Type: text/plain, Size: 1248 bytes --]
Ian Price <ianprice90@googlemail.com> writes:
> This version of define-macro still fails on the original macros as
> posted by Panicz Maciej Godek, but gives the "right" result using stis's
> ck macro version.
>
> At 2:30am, I'm not liable to get to the bottom of why till tomorrow, but
> I think doing something like this is a positive step.
Turns out it was PEBKAC
/tmp $ guile -q
GNU Guile 2.0.9.95-c9e3-dirty
Copyright (C) 1995-2013 Free Software Foundation, Inc.
Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.
Enter `,help' for help.
scheme@(guile-user)> (include "/tmp/defmacrofix.scm")
scheme@(guile-user)> ,expand ((string-matches "([a-z])") "a")
$1 = (let* ((string "a")
(match-struct (string-match "([a-z])" string)))
(and match-struct
(let ((count (match:count match-struct)))
(and count
(map (lambda (n) (match:substring match-struct n))
(iota (#{1-}# count) 1))))))
--
Ian Price -- shift-reset.com
"Programming is like pinball. The reward for doing it well is
the opportunity to do it again" - from "The Wizardy Compiled"
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: defmacro example --]
[-- Type: text/x-scheme, Size: 4555 bytes --]
(use-modules (ice-9 match)
(srfi srfi-1))
(define-syntax define-macro
(lambda (x)
"Define a defmacro."
(syntax-case x ()
((_ (macro . args) doc body1 body ...)
(string? (syntax->datum #'doc))
#'(define-macro macro doc (lambda args body1 body ...)))
((_ (macro . args) body ...)
#'(define-macro macro #f (lambda args body ...)))
((_ macro transformer)
#'(define-macro macro #f transformer))
((_ macro doc transformer)
(or (string? (syntax->datum #'doc))
(not (syntax->datum #'doc)))
#`(define-syntax macro
(lambda (y)
#,@(if (string? (syntax->datum #'doc))
(list #'doc)
'())
(define (recontextualize form context default)
(define (walk x)
;; is there any possibility of a circular syntax object?
(cond ((hashv-ref context x) => (lambda (x) x))
((pair? x)
(cons (walk (car x))
(walk (cdr x))))
((vector? x)
(vector-map walk x))
((symbol? x)
(datum->syntax default x))
(else x)))
(walk form))
(define (build-context form stx-form)
(define ctx (make-hash-table))
(define (walk x y)
(hashv-set! ctx x y)
;; is there any possibility of a circular syntax object?
(cond ((pair? x)
(walk (car x) (car (syntax-e y)))
(walk (cdr x) (cdr (syntax-e y))))
((vector? x)
(vector-for-each2 walk x (syntax-e y)))))
(walk form stx-form)
ctx)
(define (vector-for-each2 f v1 v2)
(define len (vector-length v1))
(define v* (make-vector len))
(let loop ((i 0))
(unless (= i len)
(vector-set! v* i (f (vector-ref v1 i) (vector-ref v2 i)))
(loop (+ i 1))))
v*)
(define (vector-map f v)
(define len (vector-length v))
(define v* (make-vector len))
(let loop ((i 0))
(unless (= i len)
(vector-set! v* i (f (vector-ref v i)))
(loop (+ i 1))))
v*)
(define (syntax-e obj)
(syntax-case obj ()
[(first . rest)
(cons #'first #'rest)]
[#(value (... ...))
(apply vector #'(value (... ...)))]
[a (syntax->datum #'a)]))
#((macro-type . defmacro)
(defmacro-args args))
(syntax-case y ()
((_ . args)
(let* ((v (syntax->datum #'args))
(ctx (build-context v #'args)))
(recontextualize (apply transformer v) ctx y))))))))))
(define-macro (and-let* vars . body)
(define (expand vars body)
(cond
((null? vars)
(if (null? body)
#t
`(begin ,@body)))
((pair? vars)
(let ((exp (car vars)))
(cond
((pair? exp)
(cond
((null? (cdr exp))
`(and ,(car exp) ,(expand (cdr vars) body)))
(else
(let ((var (car exp)))
`(let (,exp)
(and ,var ,(expand (cdr vars) body)))))))
(else
`(and ,exp ,(expand (cdr vars) body))))))
(else
(error "not a proper list" vars))))
(expand vars body))
(define-macro (define-curried signature . body)
(match signature
((name args ...)
`(define-syntax ,name
(syntax-rules ()
((_ ,@args)
(begin ,@body))
,@(let loop ((args* args))
(match args*
(() '())
((first ... last)
(cons `((_ ,@first #;...)
(lambda(,last)(,name ,@args*)))
(loop first #;...))))))))))
(define-curried (matches? pattern x)
(match x
(pattern #t)
(else #f)))
(define-curried (string-matches pattern string)
;;CAUTION: buggy version
(and-let* ((match-struct (string-match pattern string))
(count (match:count match-struct)))
(map (lambda(n)(match:substring match-struct n))
(iota (1- count) 1))))
next prev parent reply other threads:[~2013-11-02 19:01 UTC|newest]
Thread overview: 14+ messages / expand[flat|nested] mbox.gz Atom feed top
2013-09-09 17:35 and-let* is not composable? Panicz Maciej Godek
2013-09-09 20:26 ` Stefan Israelsson Tampe
2013-09-09 21:34 ` Ian Price
2013-09-10 13:42 ` Stefan Israelsson Tampe
2013-09-10 13:51 ` Ian Price
2013-11-02 2:39 ` Ian Price
2013-11-02 19:01 ` Ian Price [this message]
2013-09-10 17:57 ` Ian Price
2013-09-11 12:25 ` Panicz Maciej Godek
2013-09-11 14:05 ` Ian Price
2013-09-13 18:40 ` Panicz Maciej Godek
2013-09-14 8:19 ` Stefan Israelsson Tampe
2013-10-04 22:27 ` Panicz Maciej Godek
2013-10-05 8:00 ` Ian Price
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
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87bo22typi.fsf@Kagami.home \
--to=ianprice90@googlemail.com \
--cc=guile-user@gnu.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).