mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00
Code Activity

Implement keyword argument parsing

Browse source
This commit is contained in:
Ian Price 2015-06-13 22:41:37 +01:00
parent 46905ec322
commit e84f839463
4 changed files with 69 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

14
module/language/cps/compile-js.scm
View file

@ -47,21 +47,21 @@
(define (extract-clauses self clause)
(let loop ((clause clause) (specs '()) (clauses '()))
(match clause
(($ $cont k ($ $kclause ($ $arity req opts rest _ _) _ #f))
(values (reverse (cons (cons (make-params self req opts rest) k) specs))
(($ $cont k ($ $kclause ($ $arity req opts rest kw allow-other-keys?) _ #f))
(values (reverse (cons (cons (make-params self req opts rest kw allow-other-keys?) k) specs))
(reverse (cons clause clauses))))
(($ $cont k ($ $kclause ($ $arity req opts rest _ _) _ alternate))
(($ $cont k ($ $kclause ($ $arity req opts rest kw allow-other-keys?) _ alternate))
(loop alternate
(cons (cons (make-params self req opts rest) k) specs)
(cons (cons (make-params self req opts rest kw allow-other-keys?) k) specs)
(cons clause clauses))))))
(define (compile-clause clause self tail)
(match clause
(($ $cont k ($ $kclause ($ $arity req opt rest _) body _))
(($ $cont k ($ $kclause ($ $arity req opt rest ((_ _ kw-syms) ...) _) body _))
(make-var
k
(make-continuation
(append (list self) req opt (if rest (list rest) '()))
(append (list self) req opt kw-syms (if rest (list rest) '()))
(match body
(($ $cont k ($ $kargs () () exp))
(compile-term exp))
@ -69,7 +69,7 @@
(make-local (list (compile-cont body))
(make-continue
k
(map make-id (append req opt (if rest (list rest) '()))))))))))))
(map make-id (append req opt kw-syms (if rest (list rest) '()))))))))))))
(define (not-supported msg clause)
(error 'not-supported msg clause))

6
module/language/js-il.scm
View file

@ -52,7 +52,7 @@
(define-js-type program entry body)
(define-js-type function params body)
(define-js-type jump-table spec)
(define-js-type params self req opt rest)
(define-js-type params self req opt rest kw allow-other-keys?)
(define-js-type continuation params body)
(define-js-type local bindings body) ; local scope
(define-js-type var id exp)
@ -77,8 +77,8 @@
`(jump-table ,@(map (lambda (p)
`(,(unparse-js (car p)) . ,(cdr p)))
body)))
(($ params self req opt rest)
`(params ,self ,req ,opt ,rest))
(($ params self req opt rest kw allow-other-keys?)
`(params ,self ,req ,opt ,rest ,kw ,allow-other-keys?))
(($ local bindings body)
`(local ,(map unparse-js bindings) ,(unparse-js body)))
(($ var id exp)

45
module/language/js-il/compile-javascript.scm
View file

@ -21,6 +21,7 @@
(values exp env env))
(define *scheme* (make-id "scheme"))
(define *utils* (make-refine *scheme* (make-const "utils")))
(define (name->id name)
(make-id (rename name)))
@ -85,6 +86,18 @@
opts
(iota (length opts))))
(define (bind-kw-args kws ids num-drop)
(define lookup (make-refine *utils* (make-const "keyword_ref")))
(map (lambda (kw id)
(make-var (rename id)
(make-call lookup
(list (compile-const kw)
(make-id "arguments")
(compile-const num-drop)
(make-refine *scheme* (make-const "UNDEFINED"))))))
kws
ids))
(define (compile-exp exp)
;; TODO: handle ids for js
@ -149,17 +162,17 @@
(define offset 2) ; closure & continuation
(define (compile-test params)
(match params
(($ il:params self req '() #f)
(($ il:params self req '() #f '() #f)
(make-binop '=
(make-refine (make-id "arguments")
(make-const "length"))
(make-const (+ offset (length req)))))
(($ il:params self req '() rest)
(($ il:params self req '() rest '() #f)
(make-binop '>=
(make-refine (make-id "arguments")
(make-const "length"))
(make-const (+ offset (length req)))))
(($ il:params self req opts #f)
(($ il:params self req opts #f '() #f)
(make-binop 'and
(make-binop '<=
(make-const (+ offset (length req)))
@ -169,10 +182,16 @@
(make-refine (make-id "arguments")
(make-const "length"))
(make-const (+ offset (length req) (length opts))))))
;; FIXME: need to handle allow-other-keys? and testing for actual keywords
(($ il:params self req opts #f kwargs _)
(make-binop '<=
(make-const (+ offset (length req)))
(make-refine (make-id "arguments")
(make-const "length"))))
))
(define (compile-jump params k)
(match params
(($ il:params self req '() #f)
(($ il:params self req '() #f '() #f)
(list
(make-return
(make-call (name->id k)
@ -181,7 +200,7 @@
(make-refine (make-id "arguments")
(make-const (+ offset idx))))
(iota (length req))))))))
(($ il:params self req '() rest)
(($ il:params self req '() rest '() #f)
(list
(bind-rest-args rest (+ offset (length req)))
(make-return
@ -192,7 +211,7 @@
(make-const (+ offset idx))))
(iota (length req)))
(list (name->id rest)))))))
(($ il:params self req opts #f)
(($ il:params self req opts #f '() #f)
(append
(bind-opt-args opts (+ offset (length req)))
(list
@ -204,6 +223,20 @@
(make-const (+ offset idx))))
(iota (length req)))
(map name->id opts)))))))
(($ il:params self req opts #f ((kws names ids) ...) _)
(append
(bind-opt-args opts (+ offset (length req)))
(bind-kw-args kws names (+ offset (length req)))
(list
(make-return
(make-call (name->id k)
(append (list (name->id self))
(map (lambda (idx)
(make-refine (make-id "arguments")
(make-const (+ offset idx))))
(iota (length req)))
(map name->id opts)
(map name->id names)))))))
))
(fold-right (lambda (a d)
(make-branch (compile-test (car a))

20
module/language/js-il/runtime.js
View file

@ -1,6 +1,7 @@
var scheme = {
obarray : {},
primitives : {},
utils : {},
env : {},
cache: [],
builtins: [],
@ -117,6 +118,25 @@ scheme.Keyword = function(s) {
return this;
};
scheme.utils.keyword_ref = function(kw, args, start, dflt) {
var l = args.length;
if ((l - start) % 2 == 1) {
// FIXME: should error
return undefined;
}
// Need to loop in reverse because last matching keyword wins
for (var i = l - 2; i >= start; i -= 2) {
if (!(args[i] instanceof scheme.Keyword)) {
return undefined;
}
if (args[i].name === kw.name) {
return args[i + 1];
}
}
return dflt;
};
// Vectors
scheme.Vector = function () {
this.array = Array.prototype.slice.call(arguments);