On Jan 30, 2008, at 10:31 AM, Joe Hosteny wrote:

Marc pointed me to some URI parsing code in the Gambit distribution. I took a quick look at that, and it may be sufficient. I'll know more later. If it is, I'll look into partitioning it into a Snow package as well.

...

Please keep us posted if you get something working. I'm very interested in that stuff.

I'm currently stuck with some difficulties getting Gambit (4.0.22 or 4.1.2) working with Snow. I posted two bugs to Bugzilla for the problems I was having. But I did get a start on a URI package from the code Marc wrote.

The only real difference, so far, is that I changed the encode-for-uri and encode-x-www-form-urlencoded to not escape the full set of unreserved chars - the existing code was escaping [-_.~]. Strictly speaking, I don't think RFC 3986 requires this, but I believe that that is the encouraged behavior (and certainly, the URIs for the EC2 API expect the non-percent-encoded unreserved characters).

Also, the string package doesn't seem to have a snow variant of the with-output-to-string, so I also changed the write routines in encode- x-www-form-urlencoded to take a port so that snow-call-with-output- string can be used. Perhaps those could be added to the string package (unless they aren't there for a reason)?

This was just a start. Perhaps some more utility methods should be added, for example, to break up the authority component to username, port, etc.?

Cheers,

--Joe

":";exec snow -- "$0" "$@"

(package* uri/v1.0.0 (provide: (define (string->uri str decode?)) (define (encode-for-uri str)) (define (encode-x-www-form-urlencoded fields)) (define (decode-x-www-form-urlencoded str))

(define-record* uri scheme authority path query fragment))

(maintainer: "Scheme Now! <snow at iro.uontreal.ca>")

(author: "Marc Feeley <feeley at iro.umontreal.ca>")

(homepage: "http://snow.iro.umontreal.ca")

(description: "URI encoding / decoding and parsing.")

(keywords: uri snow)

(license: lgpl/v2.1)

(require: string/v1))

(cond-expand

(gambit

(declare (standard-bindings) (extended-bindings) (block) (not safe)))

(else

#f))

;= = = = = = ========================================================================

; URI parsing.

(define hex-digit (lambda (str i) (let ((n (char->integer (string-ref str i)))) (cond ((and (>= n 48) (<= n 57)) (- n 48)) ((and (>= n 65) (<= n 70)) (- n 55)) ((and (>= n 97) (<= n 102)) (- n 87)) (else #f)))))

(define hex-octet (lambda (str i) (let ((n1 (hex-digit str i))) (and n1 (let ((n2 (hex-digit str (+ i 1)))) (and n2 (+ (* n1 16) n2)))))))

(define plausible-hex-escape? (lambda (str end j) (and (< (+ j 2) end) (not (control-or-space-char? (string-ref str (+ j 1)))) (not (control-or-space-char? (string-ref str (+ j 2)))))))

(define control-or-space-char? (lambda (c) (or (not (char<? #\space c)) (not (char<? c #\x7f)))))

(define excluded-char? (lambda (c) (or (not (char<? #\space c)) (not (char<? c #\x7f)) (char=? c #<) (char=? c #>) (char=? c ##) (char=? c #%) (char=? c #") (char=? c #{) (char=? c #}) (char=? c #|) (char=? c #\) (char=? c #^) (char=? c #[) (char=? c #]) (char=? c #`))))

(define unreserved-char? (lambda (c) (or (and (char>=? c #\a) (char<=? c #\z)) (and (char>=? c #\A) (char<=? c #\Z)) (and (char>=? c #\0) (char<=? c #\9)) (char=? c #-) (char=? c #.) (char=? c #_) (char=? c #~))))

(define extract-escaped (lambda (str start n) (let ((result (make-string n))) (let loop ((i start) (j 0)) (if (< j n) (let ((c (string-ref str i))) (if (char=? c #%) (let ((n (hex-octet str (+ i 1)))) (and n (begin (string-set! result j (integer->char n)) (loop (+ i 3) (+ j 1))))) (begin (string-set! result j (if (char=? c #+) #\space c)) (loop (+ i 1) (+ j 1))))) result)))))

(define parse-uri (lambda (str start end decode? cont) (let ((uri (make-uri #f #f "" #f #f)))

(define extract-string (lambda (i j n) (if decode? (extract-escaped str i n) (substring str i j))))

(define extract-query (lambda (i j n) (if decode? (parse-uri-query str i j decode? (lambda (bindings end) bindings)) (substring str i j))))

(define state0 ; possibly inside the "scheme" part (lambda (i j n) (if (< j end) (let ((c (string-ref str j))) (cond ((char=? c #:) (if (= n 0) (state2 j (+ j 1) 1) ; the ":" is in the "path" part (let ((scheme (extract-string i j n))) (and scheme (begin (uri-scheme-set! uri scheme) (if (and (< (+ j 2) end) (char=? (string-ref str (+ j 1)) #/) (char=? (string-ref str (+ j 2)) #/)) (state1 (+ j 3) (+ j 3) 0) (state2 (+ j 1) (+ j 1) 0))))))) ((char=? c #/) (if (and (= n 0) (< (+ j 1) end) (char=? (string-ref str (+ j 1)) #/)) (state1 (+ j 2) (+ j 2) 0) (state2 i (+ j 1) (+ n 1)))) ((char=? c #?) (let ((path (extract-string i j n))) (and path (begin (uri-path-set! uri path) (state3 (+ j 1) (+ j 1) 0))))) ((char=? c ##) (let ((path (extract-string i j n))) (and path (begin (uri-path-set! uri path) (state4 (+ j 1) (+ j 1) 0))))) ((char=? c #%) (and (plausible-hex-escape? str end j) (state0 i (+ j 3) (+ n 1)))) ((control-or-space-char? c) (let ((path (extract-string i j n))) (and path (begin (uri-path-set! uri path) j)))) (else (state0 i (+ j 1) (+ n 1))))) (let ((path (extract-string i j n))) (and path (begin (uri-path-set! uri path) j))))))

(define state1 ; inside the "authority" part (lambda (i j n) (if (< j end) (let ((c (string-ref str j))) (cond ((char=? c #/) (let ((authority (extract-string i j n))) (and authority (begin (uri-authority-set! uri authority) (state2 j (+ j 1) 1))))) ((char=? c #?) (let ((authority (extract-string i j n))) (and authority (begin (uri-authority-set! uri authority) (state3 (+ j 1) (+ j 1) 0))))) ((char=? c ##) (let ((authority (extract-string i j n))) (and authority (begin (uri-authority-set! uri authority) (state4 (+ j 1) (+ j 1) 0))))) ((char=? c #%) (and (plausible-hex-escape? str end j) (state1 i (+ j 3) (+ n 1)))) ((control-or-space-char? c) (let ((authority (extract-string i j n))) (and authority (begin (uri-authority-set! uri authority) j)))) (else (state1 i (+ j 1) (+ n 1))))) (let ((authority (extract-string i j n))) (and authority (begin (uri-authority-set! uri authority) j))))))

(define state2 ; inside the "path" part (lambda (i j n) (if (< j end) (let ((c (string-ref str j))) (cond ((char=? c #?) (let ((path (extract-string i j n))) (and path (begin (uri-path-set! uri path) (state3 (+ j 1) (+ j 1) 0))))) ((char=? c ##) (let ((path (extract-string i j n))) (and path (begin (uri-path-set! uri path) (state4 (+ j 1) (+ j 1) 0))))) ((char=? c #%) (and (plausible-hex-escape? str end j) (state2 i (+ j 3) (+ n 1)))) ((control-or-space-char? c) (let ((path (extract-string i j n))) (and path (begin (uri-path-set! uri path) j)))) (else (state2 i (+ j 1) (+ n 1))))) (let ((path (extract-string i j n))) (and path (begin (uri-path-set! uri path) j))))))

(define state3 ; inside the "query" part (lambda (i j n) (if (< j end) (let ((c (string-ref str j))) (cond ((char=? c ##) (let ((query (extract-query i j n))) (and query (begin (uri-query-set! uri query) (state4 (+ j 1) (+ j 1) 0))))) ((char=? c #%) (and (plausible-hex-escape? str end j) (state3 i (+ j 3) (+ n 1)))) ((control-or-space-char? c) (let ((query (extract-query i j n))) (and query (begin (uri-query-set! uri query) j)))) (else (state3 i (+ j 1) (+ n 1))))) (let ((query (extract-query i j n))) (and query (begin (uri-query-set! uri query) j))))))

(define state4 ; inside the "fragment" part (lambda (i j n) (if (< j end) (let ((c (string-ref str j))) (cond ((char=? c #%) (and (plausible-hex-escape? str end j) (state4 i (+ j 3) (+ n 1)))) ((control-or-space-char? c) (let ((fragment (extract-string i j n))) (and fragment (begin (uri-fragment-set! uri fragment) j)))) (else (state4 i (+ j 1) (+ n 1))))) (let ((fragment (extract-string i j n))) (and fragment (begin (uri-fragment-set! uri fragment) j))))))

(let ((i (state0 start start 0))) (cont (and i uri) (or i start))))))

(define parse-uri-query (lambda (str start end decode? cont) (let ((rev-bindings '()))

(define extract-string (lambda (i j n) (if decode? (extract-escaped str i n) (substring str i j))))

(define state0 (lambda (i j n) (if (< j end) (let ((c (string-ref str j))) (cond ((char=? c #%) (and (plausible-hex-escape? str end j) (state0 i (+ j 3) (+ n 1)))) ((char=? c #=) (let ((name (extract-string i j n))) (and name (let ((j (+ j 1))) (state1 j j 0 name))))) ((char=? c #&) #f) ((excluded-char? c) (if (= n 0) j #f)) (else (state0 i (+ j 1) (+ n 1))))) (if (= n 0) j #f))))

(define state1 (lambda (i j n name) (if (< j end) (let ((c (string-ref str j))) (cond ((char=? c #%) (and (plausible-hex-escape? str end j) (state1 i (+ j 3) (+ n 1) name))) ((char=? c #&) (let ((val (extract-string i j n))) (and val (let ((j (+ j 1))) (set! rev-bindings (cons (cons name val) rev- bindings)) (and (< j end) (state0 j j 0)))))) ((char=? c #=) #f) ((excluded-char? c) (let ((val (extract-string i j n))) (and val (begin (set! rev-bindings (cons (cons name val) rev- bindings)) j)))) (else (state1 i (+ j 1) (+ n 1) name)))) (let ((val (extract-string i j n))) (and val (begin (set! rev-bindings (cons (cons name val) rev-bindings)) j))))))

(let ((i (state0 start start 0))) (cont (and i (reverse rev-bindings)) (or i start))))))

(define string->uri (lambda (str decode?) (parse-uri str 0 (string-length str) decode? (lambda (uri end) (and (= end (string-length str)) uri)))))

(define string->uri-query (lambda (str decode?) (parse-uri-query str 0 (string-length str) decode? (lambda (query end) (and (= end (string-length str)) query)))))

(define encode-for-uri (lambda (str) (let ((end (string-length str)))

(define copy (lambda (result i j n) (if (< i j) (let ((new-j (- j 1)) (new-n (- n 1))) (string-set! result new-n (string-ref str new-j)) (copy result i new-j new-n)) result)))

(define hex (lambda (x) (string-ref "0123456789ABCDEF" (bitwise-and x 15))))

(define encode (lambda (i j n) (if (< j end) (let ((c (string-ref str j))) (cond ((char=? c #\space) (let ((result (encode (+ j 1) (+ j 1) (+ n 1)))) (string-set! result n #+) (copy result i j n))) ((unreserved-char? c) (let ((result (encode (+ j 1) (+ j 1) (+ n 1)))) (string-set! result n c) (copy result i j n))) ((or (char=? c #+) (excluded-char? c)) (let ((result (encode (+ j 1) (+ j 1) (+ n 3)))) (let* ((x (char->integer c)) (hi (hex (arithmetic-shift x -4))) (lo (hex x))) (string-set! result n #%) (string-set! result (+ n 1) hi) (string-set! result (+ n 2) lo)) (copy result i j n))) (else (encode i (+ j 1) (+ n 1))))) (let ((result (make-string n))) (copy result i j n)))))

(encode 0 0 0))))

;= = = = = = ========================================================================

; x-www-form-urlencoded encoding and decoding.

(define encode-x-www-form-urlencoded (lambda (fields)

(define write-urlencoded (lambda (str port)

(define write-nibble (lambda (n port) (write-char (string-ref "0123456789ABCDEF" n) port)))

(let loop ((i 0)) (if (< i (string-length str)) (let ((c (string-ref str i))) (cond ((unreserved-char? c) (write-char c port)) ((char=? c #\space) (write-char #+ port)) (else (let ((n (char->integer c))) (write-char #% port) (write-nibble (bitwise-and (arithmetic-shift n -4) 15) port) (write-nibble (bitwise-and n 15) port)))) (loop (+ i 1)))))))

(define write-field (lambda (field port) (write-urlencoded (car field) port) (write-char #= port) (write-urlencoded (cdr field) port)))

(if (null? fields) "" (snow-call-with-output-string (lambda (port) (let ((field1 (car fields))) (write-field field1 port) (for-each (lambda (field) (write-char #& port) (write-field field port)) (cdr fields))))))))

(define decode-x-www-form-urlencoded (lambda (str) (let ((n (string-length str)))

(define extract (lambda (start len) (let ((s (make-string len))) (let loop ((i start) (j 0)) (if (< j len) (let ((c (string-ref str i))) (cond ((char=? c #%) (cond ((hex (+ i 1)) => (lambda (x) (string-set! s j (integer->char x)) (loop (+ i 3) (+ j 1)))) (else #f))) ((char=? c #+) (string-set! s j #\space) (loop (+ i 1) (+ j 1))) (else (string-set! s j c) (loop (+ i 1) (+ j 1))))) s)))))

(define hex (lambda (i) (if (< (+ i 1) n) (let ((h1 (nibble i)) (h2 (nibble (+ i 1)))) (and h1 h2 (+ (* h1 16) h2))) #f)))

(define nibble (lambda (i) (let ((c (string-ref str i))) (cond ((and (char>=? c #\0) (char<=? c #\9)) (- (char->integer c) (char->integer #\0))) ((and (char>=? c #\a) (char<=? c #\f)) (+ 10 (- (char->integer c) (char->integer #\a)))) ((and (char>=? c #\A) (char<=? c #\F)) (+ 10 (- (char->integer c) (char->integer #\A)))) (else #f)))))

(define state0 ; at beginning of string (lambda (i rev-fields) (if (< i n) (state1 i i 0 rev-fields) (reverse rev-fields))))

(define state1 ; in field name (lambda (i start len rev-fields) (if (< i n) (let ((c (string-ref str i))) (cond ((char=? c #=) (state2 (+ i 1) (+ i 1) 0 (extract start len) rev-fields)) ((char=? c #%) (and (hex (+ i 1)) (state1 (+ i 3) start (+ len 1) rev-fields))) (else (state1 (+ i 1) start (+ len 1) rev-fields)))) #f)))

(define state2 ; in field value (lambda (i start len name rev-fields)

(define end-of-field (lambda () (cons (cons name (extract start len)) rev-fields)))

(if (< i n) (let ((c (string-ref str i))) (cond ((char=? c #&) (state1 (+ i 1) (+ i 1) 0 (end-of-field))) ((char=? c #%) (and (hex (+ i 1)) (state2 (+ i 3) start (+ len 1) name rev-fields))) (else (state2 (+ i 1) start (+ len 1) name rev-fields)))) (reverse (end-of-field)))))

(state0 0 '()))))

This may not be my place, but just a thought on module systems since we're discussing the future of them.

Am I the only one that would like to see Scheme48's module system become the de-facto standard? I know that's a pipe dream, but after fiddling around with it, it's the only one that really makes sense (there are many I haven't used, but that's also what I hear from a few others). I'm not even sure what Scheme48's take on conforming to either R6RS or ERR5RS is, because it definitely wouldn't forego its module system. I suppose it could build a compatibility layer of some sort.

I know hygienic macros are hard - but from what I know Snow doesn't even attempt to fix the problem of cross-module macros (I think it only fixes loading macros from compiled modules). I like how Snow handles versioning though, but I'd like to see some of the deeper problems addressed in a module system (hygienic macros, reflective tower, etc.).

On Feb 1, 2008 6:13 AM, Adrien Pierard pierarda@iro.umontreal.ca wrote:

On Tue, Jan 29, 2008 at 11:29:19PM -0500, Joe Hosteny wrote :

...

  Also, does anyone have a feel for what is going on with Snow? It

seems like the traffic on the mailing list is a bit slow, and the number of packages is still relatively few. Don't get me wrong - my

Since R6RS and ERR5RS both provide modules/libraries/else, shouldn't we focus on the latter, and use the implementors lobby to insert some cond-expand in the library and therefore, define the new de-facto standard for portable code?

(library (foo) (export x) (import (err5rs)) (define (my-fun x) (cond-expand (gambit (if (version< (current-version) "4.1.2") (error "Need at least gambit 4.1.2") (+ x 1))) (else (error "Sorry, this code currently runs on Gambit only")))))

This raises the issue of the fork of Scheme (ERR5RS), whereas Snow is intended to be Scheme compatible (R4RS), but could be a solution.

This could somehow enforce a common framework for portable code for the next release of Scheme that is supported by at least 60% of *implementors*, wouldn't it? We could then use Snow as the global repository for all this code, and require SRFIs implementors upload their reference implementation on this new Snow...

Adrien

-- "I am not a Church numeral; I am a free variable!" (The Scheme Underground) For every complex problem, there is a solution that is simple, neat, and wrong.

---

Gambit-list mailing list Gambit-list@iro.umontreal.ca https://webmail.iro.umontreal.ca/mailman/listinfo/gambit-list

I've already mentioned that for example, I want modules in a lazy-by-default Language. You can't really get that only with macros, you need more (source processing like a compiler, and possibly make some info public that's more than just identifyers). There are already people out there playing with type systems, and it's something that I'm interested in looking into after the lazyness thing; it's also something that one should be able to fit into Snow in the long term.

I agree. (as a side note, is there any code released for those type systems? I'd be very interested.) Even besides lazy code or type systems, modules have a direct impact on evaluation. For example, the following simple scenario doesn't work with gambit:

-- test.scm

(namespace ("foo#")) (##include "~~/lib/gambit#.scm")

(define a 5)

(namespace ("bar#")) (##include "~~/lib/gambit#.scm") (namespace ("foo#" a))

(eval '(display a))

--

0 james@james% gsc

[17:39] Gambit v4.1.2

(compile-file "test.scm")

#t

(load "test")

*** ERROR -- Unbound variable: a 1> ,q

It's obvious why it doesn't work - namespaces are compile time environments. I'm far from being an expert on how to fix this, and how much overhead it would occur (it doesn't seem like much, eval simply needs to respect environments for starters, which could use name mangling for fast lookup). And I respect Snow's decision to use macros, as it's much easier to make it portable. But you can't get real modules without a proper evaluator, and there's the kludge - evaluators are implementation specific.

My first things I want to tackle is lazyness and module parametrization in chjmodule; for this I want to publish a versioning repository of chjmodule real soon now™, and then go on tackling the parametrization and lazyness issues. After having succeeded at those (or while I'm (or while we are, if anybody is taking part) at them) I want to see how to integrate them with Snow.

So I think Snow is right in starting simple. It can get better with time, slowly integrating the good bits being around when people see how they fit together well.

I don't see how you could possibly integrate something like lazyness with Snow. It's completely based on macro expansion.

I suppose I'm a little worried about backwards compatibility. I'd really like Snow to use a separate config language for modules like Scheme48. I like writing my code in whatever structure I want, and then writing the interfaces in one file, the packages in another (which tie everything together, hook interfaces with groups of files), and the build instructions in a third (that's only with gambit of course).

I'm not claiming to be an expert at all (or even any) of those areas. But I'm hoping to get expertise by working through them.

I'm not claiming to be an expert either! I hope to study these issues further. I also don't mean to sound negative - Snow is a noble accomplishment, and I hope to see it improved over time!

So I've got an own humble question: could you refer me to some documentation / a paper on what you mean with "reflective tower"? Is one of the following links a good start?:

http://www.daimi.au.dk/~danvy/Papers/danvy-malmkjaer-LFP88.pdf http://portal.acm.org/citation.cfm?id=319871&coll=Portal

Unfortunately I don't have an ACM account right now. The first paper is a bit over my head, but that sounds like a very generalized version of what I was referring to (honestly, I don't know much about them besides the general description I'm about to give). You could look at Scheme48's snippet on the towers which give a little more practical description of their usage:

http://s48.org/1.7/manual/manual-Z-H-5.html#node_sec_4.9

A better term is a 'syntactic tower', and it's like a stack of evaluation environments, and are usually used to manage environments for macros. Modules should be able to import other packages for the next level in the tower (or "macro time"), and export symbols for the next level.

On Feb 2, 2008 10:47 PM, Marc Feeley feeley@iro.umontreal.ca wrote:

Of course it doesn't work! You are mixing two different levels of evaluation. What you should have written is:

Right. I'll crawl back in my hole now :)

Note that the semantics you were expecting requires dynamic binding. In other words, for the call to "eval", the caller's namespace environment must be accessed by the callee (eval in this case). This inheritance of the namespace environment would be very messy. For example consider:

I suppose I was thinking of something simpler where that ambiguity wouldn't exist - like passing an environment to eval as the third parameter. However, I'll need more experience with evaluators before I can say anything more.

Sorry if conversation was derailed - I hope the original poster got his questions answered.