From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Ian Price Newsgroups: gmane.lisp.guile.devel Subject: Re: Guile Lua Date: Mon, 14 Jan 2013 21:02:23 +0000 Message-ID: <87ehhn5vhc.fsf@Kagami.home> References: <87d2zc6vla.fsf@googlemail.com> <1353292230.5256.23.camel@Renee-desktop.suse> <87lidxti7b.fsf@gnu.org> <1353468038.5256.84.camel@Renee-desktop.suse> <87lidvhyuu.fsf@gnu.org> <1357980226.23443.44.camel@Renee-desktop.suse> <87ehhp9kvj.fsf@Kagami.home> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1358197354 31614 80.91.229.3 (14 Jan 2013 21:02:34 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 14 Jan 2013 21:02:34 +0000 (UTC) Cc: guile-devel To: Stefan Israelsson Tampe Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Mon Jan 14 22:02:52 2013 Return-path: Envelope-to: guile-devel@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 1TurBE-0006nD-0I for guile-devel@m.gmane.org; Mon, 14 Jan 2013 22:02:52 +0100 Original-Received: from localhost ([::1]:57164 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TurAx-0006HR-Mv for guile-devel@m.gmane.org; Mon, 14 Jan 2013 16:02:35 -0500 Original-Received: from eggs.gnu.org ([208.118.235.92]:54802) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TurAu-0006H8-2C for guile-devel@gnu.org; Mon, 14 Jan 2013 16:02:33 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1TurAs-0006o1-Ih for guile-devel@gnu.org; Mon, 14 Jan 2013 16:02:32 -0500 Original-Received: from mail-wi0-f171.google.com ([209.85.212.171]:39467) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TurAs-0006ns-8u for guile-devel@gnu.org; Mon, 14 Jan 2013 16:02:30 -0500 Original-Received: by mail-wi0-f171.google.com with SMTP id hn14so1640902wib.4 for ; Mon, 14 Jan 2013 13:02:29 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=x-received:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version:content-type; bh=2x1Vo4jVUw1Zs08lw/Bk0WtGePiSTuoCXNucqKJXtsQ=; b=FT1us+FZhrZzduTdoPxcGjbU5dyoNtrOqfZOU02nAx9otHrNjd1nvt0rkOQanTQMLa v+hWU1GvaON+wyZeRjDoWXVINtHO3bOpyLA2gFCM/1LzesE5l2M9u85fVy+hVJFtbAl4 uf+dCFkhLbNPT+kaMnFpNxOD0fc1vNN4+K/DiOK/v/n55GZBH6S9WfwQ6jwgPQ/JBvqN pwuSZvrtGIgWXIC1TePVKbVTsMh7gJVYDTy0fmcs7awrw+2yzdwekPLwUBUhiP4Nn/JS rL1CFagNMRBq+Kq1xl+1jx26jAfi30pBjZd+mqibeOApSNBruLM+LJBKxdIqVLI27e0P l+Eg== X-Received: by 10.194.108.229 with SMTP id hn5mr11336399wjb.8.1358197348976; Mon, 14 Jan 2013 13:02:28 -0800 (PST) Original-Received: from Kagami.home (host86-174-96-59.range86-174.btcentralplus.com. [86.174.96.59]) by mx.google.com with ESMTPS id u6sm507474wif.2.2013.01.14.13.02.27 (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Mon, 14 Jan 2013 13:02:27 -0800 (PST) In-Reply-To: (Stefan Israelsson Tampe's message of "Mon, 14 Jan 2013 21:51:59 +0100") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.3 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x [fuzzy] X-Received-From: 209.85.212.171 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:15422 Archived-At: --=-=-= Stefan Israelsson Tampe writes: > To note is that in order to implement common lisp one need to bypass tree-il > and generate directly to glil, the reason is that tagbody is poorly > represented > by tree-il. If we intend to be multilingual it would be nice to be able to > effectively > represent those ideoms. Any thoughts on it? At one point I implemented tagbody for a laugh using call/cc. I've attached the code, but it's kinda lame. I was much less experienced with continuations and macros then, and I could certainly write it better now. -- 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-Disposition: attachment; filename=tagbody.scm Content-Description: tagbody (library (tagbody) (export tagbody go) (import (rnrs) (for (tagbody utils) expand) (for (srfi :8 receive) expand)) (define (go tag) (tag #f)) (define-syntax tagbody (lambda (stx) (define (make-group tag statements next) #`(call/cc (lambda (escape) (call/cc (lambda (k) (set! #,tag k) (escape k))) #,@statements #,(if next #`(go #,next) #'#f)))) (define (exprs->groups first-tag list) (unzip (plist->alist identifier? (cons first-tag list)))) (syntax-case stx () [(tagbody tags-or-statements ...) (let ((init #'init)) (receive (tags groups) (exprs->groups init (syntax->list #'(tags-or-statements ...))) (with-syntax (((entry-point ...) (generate-temporaries tags)) ((tag ...) tags) ((group ...) (map make-group tags groups (shift-left tags #f)))) #`(let ((tag #f) ... (done #f)) (let ((entry-point group) ...) (unless done (set! done #t) (go #,init)))))))]))) ) --=-=-= Content-Disposition: attachment; filename=utils.sls Content-Description: various utilities (library (tagbody utils) (export plist->alist shift-left unzip syntax->list ) (import (rnrs)) (define (syntax->list stxobj) (define (inner stx) (syntax-case stx () [() '()] [(x . rest) (cons #'x (inner #'rest))])) (assert (list? (syntax->datum stxobj))) (inner stxobj)) (define (plist->alist car? plist) ;; assumes head of (car? plist) is true (define (rcons a b) (cons (reverse a) b)) (if (null? plist) '() (let loop ((plist (cdr plist)) (current-field (list (car plist))) (return-list '())) (cond ((null? plist) (reverse (if (null? current-field) return-list (rcons current-field return-list)))) ((car? (car plist)) (loop (cdr plist) (list (car plist)) (rcons current-field return-list))) (else (loop (cdr plist) (cons (car plist) current-field) return-list)))))) (define (unzip list-of-pairs) (let loop ((pairs list-of-pairs) (cars '()) (cdrs '())) (if (null? pairs) (values (reverse cars) (reverse cdrs)) (loop (cdr pairs) (cons (caar pairs) cars) (cons (cdar pairs) cdrs))))) (define (shift-left old-list end) (append (cdr old-list) (list end))) ) --=-=-=--