From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Ian Price Newsgroups: gmane.lisp.guile.user Subject: Re: and-let* is not composable? Date: Sat, 02 Nov 2013 19:01:29 +0000 Message-ID: <87bo22typi.fsf@Kagami.home> References: <15322456.2mtMPoYDS9@warperdoze> <87hadtof0z.fsf@Kagami.home> <87wqkrbk77.fsf@Kagami.home> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1383418920 15545 80.91.229.3 (2 Nov 2013 19:02:00 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sat, 2 Nov 2013 19:02:00 +0000 (UTC) To: guile-user@gnu.org Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Sat Nov 02 20:02:04 2013 Return-path: Envelope-to: guile-user@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1VcgSK-0002Jr-A7 for guile-user@m.gmane.org; Sat, 02 Nov 2013 20:01:56 +0100 Original-Received: from localhost ([::1]:42896 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VcgSJ-0005vG-V9 for guile-user@m.gmane.org; Sat, 02 Nov 2013 15:01:55 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:50151) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VcgS7-0005vA-6g for guile-user@gnu.org; Sat, 02 Nov 2013 15:01:47 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VcgS3-0006mC-22 for guile-user@gnu.org; Sat, 02 Nov 2013 15:01:43 -0400 Original-Received: from mail-wi0-x229.google.com ([2a00:1450:400c:c05::229]:55849) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VcgS2-0006lz-Mt for guile-user@gnu.org; Sat, 02 Nov 2013 15:01:38 -0400 Original-Received: by mail-wi0-f169.google.com with SMTP id cb5so522601wib.4 for ; Sat, 02 Nov 2013 12:01:37 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=googlemail.com; s=20120113; h=from:to:subject:references:mail-followup-to:date:in-reply-to :message-id:user-agent:mime-version:content-type; bh=Cg7SK/GfR5agZUpOdZHMwDKPrIOy22FLjcYgjYWiEG0=; b=H3vAofPIWJWGEtdtJVZzUd4Je4OaXOk9T26fWSFGFcNC0iCQR/ThD6IGtd6GZuDM4c 5zRXDoeJiPZbg2/2GE8A8cUWiduKkt0xKX6yz+tfPpHpQueswho3caRx55dA/6ks5WEb S2Wz0Go8KX2zt462SwYxh85HYYJRL3bkZgIpGHPduSx6+0weluTHGtmZs+7COLfRHpN7 TQR+4xFbs9OwIIBEVk+3/ToLtBx5S+YlMRjvEuEcvkyNeDsttRqIRcNv4Ql3cET4v7Aw t4FRaIpmYTKhrsKfexLW5v1lpdg8rGPL0/ORtFSebAdixMgc1EHKKgTNKcq9z+Rj+Arx QOzw== X-Received: by 10.180.108.82 with SMTP id hi18mr6353448wib.53.1383418897763; Sat, 02 Nov 2013 12:01:37 -0700 (PDT) Original-Received: from Kagami.home (host86-132-92-201.range86-132.btcentralplus.com. [86.132.92.201]) by mx.google.com with ESMTPSA id fr4sm18676787wib.0.2013.11.02.12.01.35 for (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Sat, 02 Nov 2013 12:01:36 -0700 (PDT) Mail-Followup-To: guile-user@gnu.org In-Reply-To: <87wqkrbk77.fsf@Kagami.home> (Ian Price's message of "Sat, 02 Nov 2013 02:39:56 +0000") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.1 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2a00:1450:400c:c05::229 X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane.org@gnu.org Original-Sender: guile-user-bounces+guile-user=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.user:10868 Archived-At: --=-=-= Content-Type: text/plain Ian Price 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" --=-=-= Content-Type: text/x-scheme Content-Disposition: inline; filename=defmacrofix.scm Content-Description: defmacro example (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)))) --=-=-=--