debitrot the ecmascript compiler
* module/Makefile.am (ECMASCRIPT_LANG_SOURCES): * module/language/ecmascript/compile-ghil.scm: * module/language/ecmascript/compile-tree-il.scm: SOURCES): Replace the GHIL compiler with a ->tree-il compiler. Not fully functional, but the basics work. * module/language/ecmascript/spec.scm: Only include the tree-il compiler. * module/language/ecmascript/tokenize.scm (read-punctuation): Avoid mutating a constant.
This commit is contained in:
Andy Wingo
parent
6e5c02b8a3
commit
eb1482ac46
5 changed files with 553 additions and 565 deletions
|
|
@ -1,561 +0,0 @@
|
|||
;;; ECMAScript for Guile
|
||||
|
||||
;; Copyright (C) 2009 Free Software Foundation, Inc.
|
||||
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
;;;; License as published by the Free Software Foundation; either
|
||||
;;;; version 3 of the License, or (at your option) any later version.
|
||||
;;;;
|
||||
;;;; This library is distributed in the hope that it will be useful,
|
||||
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
;;;; Lesser General Public License for more details.
|
||||
;;;;
|
||||
;;;; You should have received a copy of the GNU Lesser General Public
|
||||
;;;; License along with this library; if not, write to the Free Software
|
||||
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
;;; Code:
|
||||
|
||||
(define-module (language ecmascript compile-ghil)
|
||||
#:use-module (language ghil)
|
||||
#:use-module (ice-9 receive)
|
||||
#:use-module (system base pmatch)
|
||||
#:export (compile-ghil))
|
||||
|
||||
(define-macro (-> form)
|
||||
`(,(symbol-append 'make-ghil- (car form)) e l . ,(cdr form)))
|
||||
|
||||
(define-macro (@implv sym)
|
||||
`(-> (ref (ghil-var-at-module! e '(language ecmascript impl) ',sym #t))))
|
||||
(define-macro (@impl sym args)
|
||||
`(-> (call (@implv ,sym) ,args)))
|
||||
|
||||
(define (compile-ghil exp env opts)
|
||||
(values
|
||||
(call-with-ghil-environment (make-ghil-toplevel-env) '()
|
||||
(lambda (e vars)
|
||||
(let ((l #f))
|
||||
(-> (lambda vars #f '()
|
||||
(-> (begin (list (@impl js-init '())
|
||||
(comp exp e)))))))))
|
||||
env
|
||||
env))
|
||||
|
||||
(define (location x)
|
||||
(and (pair? x)
|
||||
(let ((props (source-properties x)))
|
||||
(and (not (null? props))
|
||||
props))))
|
||||
|
||||
(define (comp x e)
|
||||
(let ((l (location x)))
|
||||
(define (let1 what proc)
|
||||
(call-with-ghil-bindings e '(%tmp)
|
||||
(lambda (vars)
|
||||
(-> (bind vars (list what)
|
||||
(proc (car vars)))))))
|
||||
(define (begin1 what proc)
|
||||
(call-with-ghil-bindings e '(%tmp)
|
||||
(lambda (vars)
|
||||
(-> (bind vars (list what)
|
||||
(-> (begin (list (proc (car vars))
|
||||
(-> (ref (car vars)))))))))))
|
||||
(pmatch x
|
||||
(null
|
||||
;; FIXME, null doesn't have much relation to EOL...
|
||||
(-> (quote '())))
|
||||
(true
|
||||
(-> (quote #t)))
|
||||
(false
|
||||
(-> (quote #f)))
|
||||
((number ,num)
|
||||
(-> (quote num)))
|
||||
((string ,str)
|
||||
(-> (quote str)))
|
||||
(this
|
||||
(@impl get-this '()))
|
||||
((+ ,a)
|
||||
(-> (inline 'add
|
||||
(list (@impl ->number (list (comp a e)))
|
||||
(-> (quote 0))))))
|
||||
((- ,a)
|
||||
(-> (inline 'sub (list (-> (quote 0)) (comp a e)))))
|
||||
((~ ,a)
|
||||
(@impl bitwise-not (list (comp a e))))
|
||||
((! ,a)
|
||||
(@impl logical-not (list (comp a e))))
|
||||
((+ ,a ,b)
|
||||
(-> (inline 'add (list (comp a e) (comp b e)))))
|
||||
((- ,a ,b)
|
||||
(-> (inline 'sub (list (comp a e) (comp b e)))))
|
||||
((/ ,a ,b)
|
||||
(-> (inline 'div (list (comp a e) (comp b e)))))
|
||||
((* ,a ,b)
|
||||
(-> (inline 'mul (list (comp a e) (comp b e)))))
|
||||
((% ,a ,b)
|
||||
(@impl mod (list (comp a e) (comp b e))))
|
||||
((<< ,a ,b)
|
||||
(@impl shift (list (comp a e) (comp b e))))
|
||||
((>> ,a ,b)
|
||||
(@impl shift (list (comp a e) (comp `(- ,b) e))))
|
||||
((< ,a ,b)
|
||||
(-> (inline 'lt? (list (comp a e) (comp b e)))))
|
||||
((<= ,a ,b)
|
||||
(-> (inline 'le? (list (comp a e) (comp b e)))))
|
||||
((> ,a ,b)
|
||||
(-> (inline 'gt? (list (comp a e) (comp b e)))))
|
||||
((>= ,a ,b)
|
||||
(-> (inline 'ge? (list (comp a e) (comp b e)))))
|
||||
((in ,a ,b)
|
||||
(@impl has-property? (list (comp a e) (comp b e))))
|
||||
((== ,a ,b)
|
||||
(-> (inline 'equal? (list (comp a e) (comp b e)))))
|
||||
((!= ,a ,b)
|
||||
(-> (inline 'not
|
||||
(list (-> (inline 'equal?
|
||||
(list (comp a e) (comp b e))))))))
|
||||
((=== ,a ,b)
|
||||
(-> (inline 'eqv? (list (comp a e) (comp b e)))))
|
||||
((!== ,a ,b)
|
||||
(-> (inline 'not
|
||||
(list (-> (inline 'eqv?
|
||||
(list (comp a e) (comp b e))))))))
|
||||
((& ,a ,b)
|
||||
(@impl band (list (comp a e) (comp b e))))
|
||||
((^ ,a ,b)
|
||||
(@impl bxor (list (comp a e) (comp b e))))
|
||||
((bor ,a ,b)
|
||||
(@impl bior (list (comp a e) (comp b e))))
|
||||
((and ,a ,b)
|
||||
(-> (and (list (comp a e) (comp b e)))))
|
||||
((or ,a ,b)
|
||||
(-> (or (list (comp a e) (comp b e)))))
|
||||
((if ,test ,then ,else)
|
||||
(-> (if (@impl ->boolean (list (comp test e)))
|
||||
(comp then e)
|
||||
(comp else e))))
|
||||
((if ,test ,then ,else)
|
||||
(-> (if (@impl ->boolean (list (comp test e)))
|
||||
(comp then e)
|
||||
(@implv *undefined*))))
|
||||
((postinc (ref ,foo))
|
||||
(begin1 (comp `(ref ,foo) e)
|
||||
(lambda (var)
|
||||
(-> (set (ghil-var-for-set! e foo)
|
||||
(-> (inline 'add
|
||||
(list (-> (ref var))
|
||||
(-> (quote 1))))))))))
|
||||
((postinc (pref ,obj ,prop))
|
||||
(let1 (comp obj e)
|
||||
(lambda (objvar)
|
||||
(begin1 (@impl pget
|
||||
(list (-> (ref objvar))
|
||||
(-> (quote prop))))
|
||||
(lambda (tmpvar)
|
||||
(@impl pput
|
||||
(list (-> (ref objvar))
|
||||
(-> (quote prop))
|
||||
(-> (inline 'add
|
||||
(list (-> (ref tmpvar))
|
||||
(-> (quote 1))))))))))))
|
||||
((postinc (aref ,obj ,prop))
|
||||
(let1 (comp obj e)
|
||||
(lambda (objvar)
|
||||
(let1 (comp prop e)
|
||||
(lambda (propvar)
|
||||
(begin1 (@impl pget
|
||||
(list (-> (ref objvar))
|
||||
(-> (ref propvar))))
|
||||
(lambda (tmpvar)
|
||||
(@impl pput
|
||||
(list (-> (ref objvar))
|
||||
(-> (ref propvar))
|
||||
(-> (inline 'add
|
||||
(list (-> (ref tmpvar))
|
||||
(-> (quote 1))))))))))))))
|
||||
((postdec (ref ,foo))
|
||||
(begin1 (comp `(ref ,foo) e)
|
||||
(lambda (var)
|
||||
(-> (set (ghil-var-for-set! e foo)
|
||||
(-> (inline 'sub
|
||||
(list (-> (ref var))
|
||||
(-> (quote 1))))))))))
|
||||
((postdec (pref ,obj ,prop))
|
||||
(let1 (comp obj e)
|
||||
(lambda (objvar)
|
||||
(begin1 (@impl pget
|
||||
(list (-> (ref objvar))
|
||||
(-> (quote prop))))
|
||||
(lambda (tmpvar)
|
||||
(@impl pput
|
||||
(list (-> (ref objvar))
|
||||
(-> (quote prop))
|
||||
(-> (inline 'sub
|
||||
(list (-> (ref tmpvar))
|
||||
(-> (quote 1))))))))))))
|
||||
((postdec (aref ,obj ,prop))
|
||||
(let1 (comp obj e)
|
||||
(lambda (objvar)
|
||||
(let1 (comp prop e)
|
||||
(lambda (propvar)
|
||||
(begin1 (@impl pget
|
||||
(list (-> (ref objvar))
|
||||
(-> (ref propvar))))
|
||||
(lambda (tmpvar)
|
||||
(@impl pput
|
||||
(list (-> (ref objvar))
|
||||
(-> (ref propvar))
|
||||
(-> (inline
|
||||
'sub (list (-> (ref tmpvar))
|
||||
(-> (quote 1))))))))))))))
|
||||
((preinc (ref ,foo))
|
||||
(let ((v (ghil-var-for-set! e foo)))
|
||||
(-> (begin
|
||||
(list
|
||||
(-> (set v
|
||||
(-> (inline 'add
|
||||
(list (-> (ref v))
|
||||
(-> (quote 1)))))))
|
||||
(-> (ref v)))))))
|
||||
((preinc (pref ,obj ,prop))
|
||||
(let1 (comp obj e)
|
||||
(lambda (objvar)
|
||||
(begin1 (-> (inline 'add
|
||||
(list (@impl pget
|
||||
(list (-> (ref objvar))
|
||||
(-> (quote prop))))
|
||||
(-> (quote 1)))))
|
||||
(lambda (tmpvar)
|
||||
(@impl pput (list (-> (ref objvar))
|
||||
(-> (quote prop))
|
||||
(-> (ref tmpvar)))))))))
|
||||
((preinc (aref ,obj ,prop))
|
||||
(let1 (comp obj e)
|
||||
(lambda (objvar)
|
||||
(let1 (comp prop e)
|
||||
(lambda (propvar)
|
||||
(begin1 (-> (inline 'add
|
||||
(list (@impl pget
|
||||
(list (-> (ref objvar))
|
||||
(-> (ref propvar))))
|
||||
(-> (quote 1)))))
|
||||
(lambda (tmpvar)
|
||||
(@impl pput
|
||||
(list (-> (ref objvar))
|
||||
(-> (ref propvar))
|
||||
(-> (ref tmpvar)))))))))))
|
||||
((predec (ref ,foo))
|
||||
(let ((v (ghil-var-for-set! e foo)))
|
||||
(-> (begin
|
||||
(list
|
||||
(-> (set v
|
||||
(-> (inline 'sub
|
||||
(list (-> (ref v))
|
||||
(-> (quote 1)))))))
|
||||
(-> (ref v)))))))
|
||||
((predec (pref ,obj ,prop))
|
||||
(let1 (comp obj e)
|
||||
(lambda (objvar)
|
||||
(begin1 (-> (inline 'sub
|
||||
(list (@impl pget
|
||||
(list (-> (ref objvar))
|
||||
(-> (quote prop))))
|
||||
(-> (quote 1)))))
|
||||
(lambda (tmpvar)
|
||||
(@impl pput
|
||||
(list (-> (ref objvar))
|
||||
(-> (quote prop))
|
||||
(-> (ref tmpvar)))))))))
|
||||
((predec (aref ,obj ,prop))
|
||||
(let1 (comp obj e)
|
||||
(lambda (objvar)
|
||||
(let1 (comp prop e)
|
||||
(lambda (propvar)
|
||||
(begin1 (-> (inline 'sub
|
||||
(list (@impl pget
|
||||
(list (-> (ref objvar))
|
||||
(-> (ref propvar))))
|
||||
(-> (quote 1)))))
|
||||
(lambda (tmpvar)
|
||||
(@impl pput
|
||||
(list (-> (ref objvar))
|
||||
(-> (ref propvar))
|
||||
(-> (ref tmpvar)))))))))))
|
||||
((ref ,id)
|
||||
(-> (ref (ghil-var-for-ref! e id))))
|
||||
((var . ,forms)
|
||||
(-> (begin
|
||||
(map (lambda (form)
|
||||
(pmatch form
|
||||
((,x ,y)
|
||||
(-> (define (ghil-var-define! (ghil-env-parent e) x)
|
||||
(comp y e))))
|
||||
((,x)
|
||||
(-> (define (ghil-var-define! (ghil-env-parent e) x)
|
||||
(@implv *undefined*))))
|
||||
(else (error "bad var form" form))))
|
||||
forms))))
|
||||
((begin . ,forms)
|
||||
(-> (begin
|
||||
(map (lambda (x) (comp x e)) forms))))
|
||||
((lambda ,formals ,body)
|
||||
(call-with-ghil-environment e '(%args)
|
||||
(lambda (e vars)
|
||||
(-> (lambda vars #t '()
|
||||
(comp-body env l body formals '%args))))))
|
||||
((call/this ,obj ,prop ,args)
|
||||
(@impl call/this*
|
||||
(list obj
|
||||
(-> (lambda '() #f '()
|
||||
(-> (call (@impl pget (list obj prop))
|
||||
args)))))))
|
||||
((call (pref ,obj ,prop) ,args)
|
||||
(comp `(call/this ,(comp obj e)
|
||||
,(-> (quote prop))
|
||||
,(map (lambda (x) (comp x e)) args))
|
||||
e))
|
||||
((call (aref ,obj ,prop) ,args)
|
||||
(comp `(call/this ,(comp obj e)
|
||||
,(comp prop e)
|
||||
,(map (lambda (x) (comp x e)) args))
|
||||
e))
|
||||
((call ,proc ,args)
|
||||
(-> (call (comp proc e)
|
||||
(map (lambda (x) (comp x e)) args))))
|
||||
((return ,expr)
|
||||
(-> (inline 'return
|
||||
(list (comp expr e)))))
|
||||
((array . ,args)
|
||||
(@impl new-array
|
||||
(map (lambda (x) (comp x e)) args)))
|
||||
((object . ,args)
|
||||
(@impl new-object
|
||||
(map (lambda (x)
|
||||
(pmatch x
|
||||
((,prop ,val)
|
||||
(-> (inline 'cons
|
||||
(list (-> (quote prop))
|
||||
(comp val e)))))
|
||||
(else
|
||||
(error "bad prop-val pair" x))))
|
||||
args)))
|
||||
((pref ,obj ,prop)
|
||||
(@impl pget
|
||||
(list (comp obj e)
|
||||
(-> (quote prop)))))
|
||||
((aref ,obj ,index)
|
||||
(@impl pget
|
||||
(list (comp obj e)
|
||||
(comp index e))))
|
||||
((= (ref ,name) ,val)
|
||||
(let ((v (ghil-var-for-set! e name)))
|
||||
(-> (begin
|
||||
(list (-> (set v (comp val e)))
|
||||
(-> (ref v)))))))
|
||||
((= (pref ,obj ,prop) ,val)
|
||||
(@impl pput
|
||||
(list (comp obj e)
|
||||
(-> (quote prop))
|
||||
(comp val e))))
|
||||
((= (aref ,obj ,prop) ,val)
|
||||
(@impl pput
|
||||
(list (comp obj e)
|
||||
(comp prop e)
|
||||
(comp val e))))
|
||||
((+= ,what ,val)
|
||||
(comp `(= ,what (+ ,what ,val)) e))
|
||||
((-= ,what ,val)
|
||||
(comp `(= ,what (- ,what ,val)) e))
|
||||
((/= ,what ,val)
|
||||
(comp `(= ,what (/ ,what ,val)) e))
|
||||
((*= ,what ,val)
|
||||
(comp `(= ,what (* ,what ,val)) e))
|
||||
((%= ,what ,val)
|
||||
(comp `(= ,what (% ,what ,val)) e))
|
||||
((>>= ,what ,val)
|
||||
(comp `(= ,what (>> ,what ,val)) e))
|
||||
((<<= ,what ,val)
|
||||
(comp `(= ,what (<< ,what ,val)) e))
|
||||
((>>>= ,what ,val)
|
||||
(comp `(= ,what (>>> ,what ,val)) e))
|
||||
((&= ,what ,val)
|
||||
(comp `(= ,what (& ,what ,val)) e))
|
||||
((bor= ,what ,val)
|
||||
(comp `(= ,what (bor ,what ,val)) e))
|
||||
((^= ,what ,val)
|
||||
(comp `(= ,what (^ ,what ,val)) e))
|
||||
((new ,what ,args)
|
||||
(@impl new
|
||||
(map (lambda (x) (comp x e))
|
||||
(cons what args))))
|
||||
((delete (pref ,obj ,prop))
|
||||
(@impl pdel
|
||||
(list (comp obj e)
|
||||
(-> (quote prop)))))
|
||||
((delete (aref ,obj ,prop))
|
||||
(@impl pdel
|
||||
(list (comp obj e)
|
||||
(comp prop e))))
|
||||
((void ,expr)
|
||||
(-> (begin
|
||||
(list (comp expr e)
|
||||
(@implv *undefined*)))))
|
||||
((typeof ,expr)
|
||||
(@impl typeof
|
||||
(list (comp expr e))))
|
||||
((do ,statement ,test)
|
||||
(call-with-ghil-bindings e '(%loop %continue)
|
||||
(lambda (vars)
|
||||
(-> (bind vars
|
||||
(list (call-with-ghil-environment e '()
|
||||
(lambda (e _)
|
||||
(-> (lambda '() #f '()
|
||||
(-> (begin
|
||||
(list (comp statement e)
|
||||
(-> (call
|
||||
(-> (ref (ghil-var-for-ref! e '%continue)))
|
||||
'())))))))))
|
||||
(call-with-ghil-environment e '()
|
||||
(lambda (e _)
|
||||
(-> (lambda '() #f '()
|
||||
(-> (if (@impl ->boolean (list (comp test e)))
|
||||
(-> (call
|
||||
(-> (ref (ghil-var-for-ref! e '%loop)))
|
||||
'()))
|
||||
(@implv *undefined*))))))))
|
||||
(-> (call (-> (ref (car vars))) '())))))))
|
||||
((while ,test ,statement)
|
||||
(call-with-ghil-bindings e '(%continue)
|
||||
(lambda (vars)
|
||||
(-> (begin
|
||||
(list
|
||||
(-> (set (car vars)
|
||||
(call-with-ghil-environment e '()
|
||||
(lambda (e _)
|
||||
(-> (lambda '() #f '()
|
||||
(-> (if (@impl ->boolean (list (comp test e)))
|
||||
(-> (begin
|
||||
(list (comp statement e)
|
||||
(-> (call
|
||||
(-> (ref (ghil-var-for-ref! e '%continue)))
|
||||
'())))))
|
||||
(@implv *undefined*)))))))))
|
||||
(-> (call (-> (ref (car vars))) '()))))))))
|
||||
((for ,init ,test ,inc ,statement)
|
||||
(call-with-ghil-bindings e '(%continue)
|
||||
(lambda (vars)
|
||||
(-> (begin
|
||||
(list
|
||||
(comp (or init '(begin)) e)
|
||||
(-> (set (car vars)
|
||||
(call-with-ghil-environment e '()
|
||||
(lambda (e _)
|
||||
(-> (lambda '() #f '()
|
||||
(-> (if (if test
|
||||
(@impl ->boolean (list (comp test e)))
|
||||
(comp 'true e))
|
||||
(-> (begin
|
||||
(list (comp statement e)
|
||||
(comp (or inc '(begin)) e)
|
||||
(-> (call
|
||||
(-> (ref (ghil-var-for-ref! e '%continue)))
|
||||
'())))))
|
||||
(@implv *undefined*)))))))))
|
||||
(-> (call (-> (ref (car vars))) '()))))))))
|
||||
((for-in ,var ,object ,statement)
|
||||
(call-with-ghil-bindings e '(%continue %enum)
|
||||
(lambda (vars)
|
||||
(-> (begin
|
||||
(list
|
||||
(-> (set (car vars)
|
||||
(call-with-ghil-environment e '()
|
||||
(lambda (e _)
|
||||
(-> (lambda '() #f '()
|
||||
(-> (if (@impl ->boolean
|
||||
(list (@impl pget
|
||||
(list (-> (ref (ghil-var-for-ref! e '%enum)))
|
||||
(-> (quote 'length))))))
|
||||
(-> (begin
|
||||
(list
|
||||
(comp `(= ,var (call/this ,(-> (ref (ghil-var-for-ref! e '%enum)))
|
||||
,(-> (quote 'pop))
|
||||
()))
|
||||
e)
|
||||
(comp statement e)
|
||||
(-> (call (-> (ref (ghil-var-for-ref! e '%continue)))
|
||||
'())))))
|
||||
(@implv *undefined*)))))))))
|
||||
(-> (set (cadr vars)
|
||||
(@impl make-enumerator (list (comp object e)))))
|
||||
(-> (call (-> (ref (car vars))) '()))))))))
|
||||
((break)
|
||||
(let ((var (ghil-var-for-ref! e '%continue)))
|
||||
(if (and (ghil-env? (ghil-var-env var))
|
||||
(eq? (ghil-var-env var) (ghil-env-parent e)))
|
||||
(-> (inline 'return (@implv *undefined*)))
|
||||
(error "bad break, yo"))))
|
||||
((continue)
|
||||
(let ((var (ghil-var-for-ref! e '%continue)))
|
||||
(if (and (ghil-env? (ghil-var-env var))
|
||||
(eq? (ghil-var-env var) (ghil-env-parent e)))
|
||||
(-> (inline 'goto/args (list (-> (ref var)))))
|
||||
(error "bad continue, yo"))))
|
||||
((block ,x)
|
||||
(comp x e))
|
||||
(else
|
||||
(error "compilation not yet implemented:" x)))))
|
||||
|
||||
(define (comp-body e l body formals %args)
|
||||
(define (process)
|
||||
(let lp ((in body) (out '()) (rvars (reverse formals)))
|
||||
(pmatch in
|
||||
(((var (,x) . ,morevars) . ,rest)
|
||||
(lp `((var . ,morevars) . ,rest)
|
||||
out
|
||||
(if (memq x rvars) rvars (cons x rvars))))
|
||||
(((var (,x ,y) . ,morevars) . ,rest)
|
||||
(lp `((var . ,morevars) . ,rest)
|
||||
`((= (ref ,x) ,y) . ,out)
|
||||
(if (memq x rvars) rvars (cons x rvars))))
|
||||
(((var) . ,rest)
|
||||
(lp rest out rvars))
|
||||
((,x . ,rest) (guard (and (pair? x) (eq? (car x) 'lambda)))
|
||||
(lp rest
|
||||
(cons x out)
|
||||
rvars))
|
||||
((,x . ,rest) (guard (pair? x))
|
||||
(receive (sub-out rvars)
|
||||
(lp x '() rvars)
|
||||
(lp rest
|
||||
(cons sub-out out)
|
||||
rvars)))
|
||||
((,x . ,rest)
|
||||
(lp rest
|
||||
(cons x out)
|
||||
rvars))
|
||||
(()
|
||||
(values (reverse! out)
|
||||
rvars)))))
|
||||
(receive (out rvars)
|
||||
(process)
|
||||
(call-with-ghil-bindings e (reverse rvars)
|
||||
(lambda (vars)
|
||||
(let ((%argv (assq-ref (ghil-env-table e) %args)))
|
||||
(-> (begin
|
||||
`(,@(map
|
||||
(lambda (f)
|
||||
(-> (if (-> (inline 'null?
|
||||
(list (-> (ref %argv)))))
|
||||
(-> (begin '()))
|
||||
(-> (begin
|
||||
(list (-> (set (ghil-var-for-ref! e f)
|
||||
(-> (inline 'car
|
||||
(list (-> (ref %argv)))))))
|
||||
(-> (set %argv
|
||||
(-> (inline 'cdr
|
||||
(list (-> (ref %argv)))))))))))))
|
||||
formals)
|
||||
;; fixme: here check for too many args
|
||||
,(comp out e)))))))))
|
||||
549
module/language/ecmascript/compile-tree-il.scm
Normal file
549
module/language/ecmascript/compile-tree-il.scm
Normal file
|
|
@ -0,0 +1,549 @@
|
|||
;;; ECMAScript for Guile
|
||||
|
||||
;; Copyright (C) 2009 Free Software Foundation, Inc.
|
||||
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
;;;; License as published by the Free Software Foundation; either
|
||||
;;;; version 3 of the License, or (at your option) any later version.
|
||||
;;;;
|
||||
;;;; This library is distributed in the hope that it will be useful,
|
||||
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
;;;; Lesser General Public License for more details.
|
||||
;;;;
|
||||
;;;; You should have received a copy of the GNU Lesser General Public
|
||||
;;;; License along with this library; if not, write to the Free Software
|
||||
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
;;; Code:
|
||||
|
||||
(define-module (language ecmascript compile-tree-il)
|
||||
#:use-module (language tree-il)
|
||||
#:use-module (ice-9 receive)
|
||||
#:use-module (system base pmatch)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:export (compile-tree-il))
|
||||
|
||||
(define-syntax ->
|
||||
(syntax-rules ()
|
||||
((_ (type arg ...))
|
||||
`(type ,arg ...))))
|
||||
|
||||
(define-syntax @implv
|
||||
(syntax-rules ()
|
||||
((_ sym)
|
||||
(-> (module-ref '(language ecmascript impl) 'sym #t)))))
|
||||
|
||||
(define-syntax @impl
|
||||
(syntax-rules ()
|
||||
((_ sym arg ...)
|
||||
(-> (apply (@implv sym) arg ...)))))
|
||||
|
||||
(define (empty-lexical-environment)
|
||||
'())
|
||||
|
||||
(define (econs name gensym env)
|
||||
(acons name gensym env))
|
||||
|
||||
(define (lookup name env)
|
||||
(or (assq-ref env name)
|
||||
(-> (toplevel name))))
|
||||
|
||||
(define (compile-tree-il exp env opts)
|
||||
(values
|
||||
(parse-tree-il (comp exp (empty-lexical-environment)))
|
||||
env
|
||||
env))
|
||||
|
||||
(define (location x)
|
||||
(and (pair? x)
|
||||
(let ((props (source-properties x)))
|
||||
(and (not (null? props))
|
||||
props))))
|
||||
|
||||
;; for emacs:
|
||||
;; (put 'pmatch/source 'scheme-indent-function 1)
|
||||
|
||||
(define-syntax pmatch/source
|
||||
(syntax-rules ()
|
||||
((_ x clause ...)
|
||||
(let ((x x))
|
||||
(let ((res (pmatch x
|
||||
clause ...)))
|
||||
(let ((loc (location x)))
|
||||
(if loc
|
||||
(set-source-properties! res (location x))))
|
||||
res)))))
|
||||
|
||||
(define (comp x e)
|
||||
(let ((l (location x)))
|
||||
(define (let1 what proc)
|
||||
(let ((sym (gensym)))
|
||||
(-> (let (list sym) (list sym) (list what)
|
||||
(proc sym)))))
|
||||
(define (begin1 what proc)
|
||||
(let1 what (lambda (v)
|
||||
(-> (begin (proc v)
|
||||
(-> (lexical v v)))))))
|
||||
(pmatch/source x
|
||||
(null
|
||||
;; FIXME, null doesn't have much relation to EOL...
|
||||
(-> (const '())))
|
||||
(true
|
||||
(-> (const #t)))
|
||||
(false
|
||||
(-> (const #f)))
|
||||
((number ,num)
|
||||
(-> (const num)))
|
||||
((string ,str)
|
||||
(-> (const str)))
|
||||
(this
|
||||
(@impl get-this '()))
|
||||
((+ ,a)
|
||||
(-> (apply (-> (primitive '+))
|
||||
(@impl ->number (comp a e))
|
||||
(-> (const 0)))))
|
||||
((- ,a)
|
||||
(-> (apply (-> (primitive '-)) (-> (const 0)) (comp a e))))
|
||||
((~ ,a)
|
||||
(@impl bitwise-not (comp a e)))
|
||||
((! ,a)
|
||||
(@impl logical-not (comp a e)))
|
||||
((+ ,a ,b)
|
||||
(-> (apply (-> (primitive '+)) (comp a e) (comp b e))))
|
||||
((- ,a ,b)
|
||||
(-> (apply (-> (primitive '-)) (comp a e) (comp b e))))
|
||||
((/ ,a ,b)
|
||||
(-> (apply (-> (primitive '/)) (comp a e) (comp b e))))
|
||||
((* ,a ,b)
|
||||
(-> (apply (-> (primitive '*)) (comp a e) (comp b e))))
|
||||
((% ,a ,b)
|
||||
(@impl mod (comp a e) (comp b e)))
|
||||
((<< ,a ,b)
|
||||
(@impl shift (comp a e) (comp b e)))
|
||||
((>> ,a ,b)
|
||||
(@impl shift (comp a e) (comp `(- ,b) e)))
|
||||
((< ,a ,b)
|
||||
(-> (apply (-> (primitive '<)) (comp a e) (comp b e))))
|
||||
((<= ,a ,b)
|
||||
(-> (apply (-> (primitive '<=)) (comp a e) (comp b e))))
|
||||
((> ,a ,b)
|
||||
(-> (apply (-> (primitive '>)) (comp a e) (comp b e))))
|
||||
((>= ,a ,b)
|
||||
(-> (apply (-> (primitive '>=)) (comp a e) (comp b e))))
|
||||
((in ,a ,b)
|
||||
(@impl has-property? (comp a e) (comp b e)))
|
||||
((== ,a ,b)
|
||||
(-> (apply (-> (primitive 'equal?)) (comp a e) (comp b e))))
|
||||
((!= ,a ,b)
|
||||
(-> (apply (-> (primitive 'not))
|
||||
(-> (apply (-> (primitive 'equal?))
|
||||
(comp a e) (comp b e))))))
|
||||
((=== ,a ,b)
|
||||
(-> (apply (-> (primitive 'eqv?)) (comp a e) (comp b e))))
|
||||
((!== ,a ,b)
|
||||
(-> (apply (-> (primitive 'not))
|
||||
(-> (apply (-> (primitive 'eqv?))
|
||||
(comp a e) (comp b e))))))
|
||||
((& ,a ,b)
|
||||
(@impl band (comp a e) (comp b e)))
|
||||
((^ ,a ,b)
|
||||
(@impl bxor (comp a e) (comp b e)))
|
||||
((bor ,a ,b)
|
||||
(@impl bior (comp a e) (comp b e)))
|
||||
((and ,a ,b)
|
||||
(-> (if (@impl ->boolean (comp a e))
|
||||
(comp b e)
|
||||
(-> (const #f)))))
|
||||
((or ,a ,b)
|
||||
(let1 (comp a e)
|
||||
(lambda (v)
|
||||
(-> (if (@impl ->boolean (-> (lexical v v)))
|
||||
(-> (lexical v v))
|
||||
(comp b e))))))
|
||||
((if ,test ,then ,else)
|
||||
(-> (if (@impl ->boolean (comp test e))
|
||||
(comp then e)
|
||||
(comp else e))))
|
||||
((if ,test ,then ,else)
|
||||
(-> (if (@impl ->boolean (comp test e))
|
||||
(comp then e)
|
||||
(@implv *undefined*))))
|
||||
((postinc (ref ,foo))
|
||||
(begin1 (comp `(ref ,foo) e)
|
||||
(lambda (var)
|
||||
(-> (set! (lookup foo e)
|
||||
(-> (apply (-> (primitive '+))
|
||||
(-> (lexical var var))
|
||||
(-> (const 1)))))))))
|
||||
((postinc (pref ,obj ,prop))
|
||||
(let1 (comp obj e)
|
||||
(lambda (objvar)
|
||||
(begin1 (@impl pget
|
||||
(-> (lexical objvar objvar))
|
||||
(-> (const prop)))
|
||||
(lambda (tmpvar)
|
||||
(@impl pput
|
||||
(-> (lexical objvar objvar))
|
||||
(-> (const prop))
|
||||
(-> (apply (-> (primitive '+))
|
||||
(-> (lexical tmpvar tmpvar))
|
||||
(-> (const 1))))))))))
|
||||
((postinc (aref ,obj ,prop))
|
||||
(let1 (comp obj e)
|
||||
(lambda (objvar)
|
||||
(let1 (comp prop e)
|
||||
(lambda (propvar)
|
||||
(begin1 (@impl pget
|
||||
(-> (lexical objvar objvar))
|
||||
(-> (lexical propvar propvar)))
|
||||
(lambda (tmpvar)
|
||||
(@impl pput
|
||||
(-> (lexical objvar objvar))
|
||||
(-> (lexical propvar propvar))
|
||||
(-> (apply (-> (primitive '+))
|
||||
(-> (lexical tmpvar tmpvar))
|
||||
(-> (const 1))))))))))))
|
||||
((postdec (ref ,foo))
|
||||
(begin1 (comp `(ref ,foo) e)
|
||||
(lambda (var)
|
||||
(-> (set (lookup foo e)
|
||||
(-> (apply (-> (primitive '-))
|
||||
(-> (lexical var var))
|
||||
(-> (const 1)))))))))
|
||||
((postdec (pref ,obj ,prop))
|
||||
(let1 (comp obj e)
|
||||
(lambda (objvar)
|
||||
(begin1 (@impl pget
|
||||
(-> (lexical objvar objvar))
|
||||
(-> (const prop)))
|
||||
(lambda (tmpvar)
|
||||
(@impl pput
|
||||
(-> (lexical objvar objvar))
|
||||
(-> (const prop))
|
||||
(-> (apply (-> (primitive '-))
|
||||
(-> (lexical tmpvar tmpvar))
|
||||
(-> (const 1))))))))))
|
||||
((postdec (aref ,obj ,prop))
|
||||
(let1 (comp obj e)
|
||||
(lambda (objvar)
|
||||
(let1 (comp prop e)
|
||||
(lambda (propvar)
|
||||
(begin1 (@impl pget
|
||||
(-> (lexical objvar objvar))
|
||||
(-> (lexical propvar propvar)))
|
||||
(lambda (tmpvar)
|
||||
(@impl pput
|
||||
(-> (lexical objvar objvar))
|
||||
(-> (lexical propvar propvar))
|
||||
(-> (inline
|
||||
'- (-> (lexical tmpvar tmpvar))
|
||||
(-> (const 1))))))))))))
|
||||
((preinc (ref ,foo))
|
||||
(let ((v (lookup foo e)))
|
||||
(-> (begin
|
||||
(-> (set! v
|
||||
(-> (apply (-> (primitive '+))
|
||||
v
|
||||
(-> (const 1))))))
|
||||
v))))
|
||||
((preinc (pref ,obj ,prop))
|
||||
(let1 (comp obj e)
|
||||
(lambda (objvar)
|
||||
(begin1 (-> (apply (-> (primitive '+))
|
||||
(@impl pget
|
||||
(-> (lexical objvar objvar))
|
||||
(-> (const prop)))
|
||||
(-> (const 1))))
|
||||
(lambda (tmpvar)
|
||||
(@impl pput (-> (lexical objvar objvar))
|
||||
(-> (const prop))
|
||||
(-> (lexical tmpvar tmpvar))))))))
|
||||
((preinc (aref ,obj ,prop))
|
||||
(let1 (comp obj e)
|
||||
(lambda (objvar)
|
||||
(let1 (comp prop e)
|
||||
(lambda (propvar)
|
||||
(begin1 (-> (apply (-> (primitive '+))
|
||||
(@impl pget
|
||||
(-> (lexical objvar objvar))
|
||||
(-> (lexical propvar propvar)))
|
||||
(-> (const 1))))
|
||||
(lambda (tmpvar)
|
||||
(@impl pput
|
||||
(-> (lexical objvar objvar))
|
||||
(-> (lexical propvar propvar))
|
||||
(-> (lexical tmpvar tmpvar))))))))))
|
||||
((predec (ref ,foo))
|
||||
(let ((v (lookup foo e)))
|
||||
(-> (begin
|
||||
(-> (set! v
|
||||
(-> (apply (-> (primitive '-))
|
||||
v
|
||||
(-> (const 1))))))
|
||||
v))))
|
||||
((predec (pref ,obj ,prop))
|
||||
(let1 (comp obj e)
|
||||
(lambda (objvar)
|
||||
(begin1 (-> (apply (-> (primitive '-))
|
||||
(@impl pget
|
||||
(-> (lexical objvar objvar))
|
||||
(-> (const prop)))
|
||||
(-> (const 1))))
|
||||
(lambda (tmpvar)
|
||||
(@impl pput
|
||||
(-> (lexical objvar objvar))
|
||||
(-> (const prop))
|
||||
(-> (lexical tmpvar tmpvar))))))))
|
||||
((predec (aref ,obj ,prop))
|
||||
(let1 (comp obj e)
|
||||
(lambda (objvar)
|
||||
(let1 (comp prop e)
|
||||
(lambda (propvar)
|
||||
(begin1 (-> (apply (-> (primitive '-))
|
||||
(@impl pget
|
||||
(-> (lexical objvar objvar))
|
||||
(-> (lexical propvar propvar)))
|
||||
(-> (const 1))))
|
||||
(lambda (tmpvar)
|
||||
(@impl pput
|
||||
(-> (lexical objvar objvar))
|
||||
(-> (lexical propvar propvar))
|
||||
(-> (lexical tmpvar tmpvar))))))))))
|
||||
((ref ,id)
|
||||
(lookup id e))
|
||||
((var . ,forms)
|
||||
(-> (begin
|
||||
(map (lambda (form)
|
||||
(pmatch form
|
||||
((,x ,y)
|
||||
(-> (define x (comp y e))))
|
||||
((,x)
|
||||
(-> (define x (@implv *undefined*))))
|
||||
(else (error "bad var form" form))))
|
||||
forms))))
|
||||
((begin . ,forms)
|
||||
`(begin ,@(map (lambda (x) (comp x e)) forms)))
|
||||
((lambda ,formals ,body)
|
||||
(let ((%args (gensym "%args ")))
|
||||
(-> (lambda '%args %args '()
|
||||
(comp-body (econs '%args %args e) body formals '%args)))))
|
||||
((call/this ,obj ,prop . ,args)
|
||||
(@impl call/this*
|
||||
obj
|
||||
(-> (lambda '() '() '()
|
||||
`(apply ,(@impl pget obj prop) ,@args)))))
|
||||
((call (pref ,obj ,prop) ,args)
|
||||
(comp `(call/this ,(comp obj e)
|
||||
,(-> (const prop))
|
||||
,@(map (lambda (x) (comp x e)) args))
|
||||
e))
|
||||
((call (aref ,obj ,prop) ,args)
|
||||
(comp `(call/this ,(comp obj e)
|
||||
,(comp prop e)
|
||||
,@(map (lambda (x) (comp x e)) args))
|
||||
e))
|
||||
((call ,proc ,args)
|
||||
`(apply ,(comp proc e)
|
||||
,@(map (lambda (x) (comp x e)) args)))
|
||||
((return ,expr)
|
||||
(-> (apply (-> (primitive 'return))
|
||||
(comp expr e))))
|
||||
((array . ,args)
|
||||
`(apply ,(@implv new-array)
|
||||
,@(map (lambda (x) (comp x e)) args)))
|
||||
((object . ,args)
|
||||
(@impl new-object
|
||||
(map (lambda (x)
|
||||
(pmatch x
|
||||
((,prop ,val)
|
||||
(-> (apply (-> (primitive 'cons))
|
||||
(-> (const prop))
|
||||
(comp val e))))
|
||||
(else
|
||||
(error "bad prop-val pair" x))))
|
||||
args)))
|
||||
((pref ,obj ,prop)
|
||||
(@impl pget
|
||||
(comp obj e)
|
||||
(-> (const prop))))
|
||||
((aref ,obj ,index)
|
||||
(@impl pget
|
||||
(comp obj e)
|
||||
(comp index e)))
|
||||
((= (ref ,name) ,val)
|
||||
(let ((v (lookup name e)))
|
||||
(-> (begin
|
||||
(-> (set! v (comp val e)))
|
||||
v))))
|
||||
((= (pref ,obj ,prop) ,val)
|
||||
(@impl pput
|
||||
(comp obj e)
|
||||
(-> (const prop))
|
||||
(comp val e)))
|
||||
((= (aref ,obj ,prop) ,val)
|
||||
(@impl pput
|
||||
(comp obj e)
|
||||
(comp prop e)
|
||||
(comp val e)))
|
||||
((+= ,what ,val)
|
||||
(comp `(= ,what (+ ,what ,val)) e))
|
||||
((-= ,what ,val)
|
||||
(comp `(= ,what (- ,what ,val)) e))
|
||||
((/= ,what ,val)
|
||||
(comp `(= ,what (/ ,what ,val)) e))
|
||||
((*= ,what ,val)
|
||||
(comp `(= ,what (* ,what ,val)) e))
|
||||
((%= ,what ,val)
|
||||
(comp `(= ,what (% ,what ,val)) e))
|
||||
((>>= ,what ,val)
|
||||
(comp `(= ,what (>> ,what ,val)) e))
|
||||
((<<= ,what ,val)
|
||||
(comp `(= ,what (<< ,what ,val)) e))
|
||||
((>>>= ,what ,val)
|
||||
(comp `(= ,what (>>> ,what ,val)) e))
|
||||
((&= ,what ,val)
|
||||
(comp `(= ,what (& ,what ,val)) e))
|
||||
((bor= ,what ,val)
|
||||
(comp `(= ,what (bor ,what ,val)) e))
|
||||
((^= ,what ,val)
|
||||
(comp `(= ,what (^ ,what ,val)) e))
|
||||
((new ,what ,args)
|
||||
(@impl new
|
||||
(map (lambda (x) (comp x e))
|
||||
(cons what args))))
|
||||
((delete (pref ,obj ,prop))
|
||||
(@impl pdel
|
||||
(comp obj e)
|
||||
(-> (const prop))))
|
||||
((delete (aref ,obj ,prop))
|
||||
(@impl pdel
|
||||
(comp obj e)
|
||||
(comp prop e)))
|
||||
((void ,expr)
|
||||
(-> (begin
|
||||
(comp expr e)
|
||||
(@implv *undefined*))))
|
||||
((typeof ,expr)
|
||||
(@impl typeof
|
||||
(comp expr e)))
|
||||
((do ,statement ,test)
|
||||
(let ((%loop (gensym "%loop "))
|
||||
(%continue (gensym "%continue ")))
|
||||
(let ((e (econs '%loop %loop (econs '%continue %continue e))))
|
||||
(-> (letrec '(%loop %continue) (list %loop %continue)
|
||||
(list (-> (lambda '() '() '()
|
||||
(-> (begin
|
||||
(comp statement e)
|
||||
(-> (apply (-> (lexical '%continue %continue)))
|
||||
)))))
|
||||
|
||||
(-> (lambda '() '() '()
|
||||
(-> (if (@impl ->boolean (comp test e))
|
||||
(-> (apply (-> (lexical '%loop %loop))))
|
||||
(@implv *undefined*))))))
|
||||
(-> (apply (-> (lexical '%loop %loop)))))))))
|
||||
((while ,test ,statement)
|
||||
(let ((%continue (gensym "%continue ")))
|
||||
(let ((e (econs '%continue %continue e)))
|
||||
(-> (letrec '(%continue) (list %continue)
|
||||
(list (-> (lambda '() '() '()
|
||||
(-> (if (@impl ->boolean (comp test e))
|
||||
(-> (begin (comp statement e)
|
||||
(-> (apply (-> (lexical '%continue %continue))))))
|
||||
(@implv *undefined*))))))
|
||||
(-> (apply (-> (lexical '%continue %continue)))))))))
|
||||
|
||||
((for ,init ,test ,inc ,statement)
|
||||
(let ((%continue (gensym "%continue ")))
|
||||
(let ((e (econs '%continue %continue e)))
|
||||
(-> (letrec '(%continue) (list %continue)
|
||||
(list (-> (lambda '() '() '()
|
||||
(-> (if (if test
|
||||
(@impl ->boolean (comp test e))
|
||||
(comp 'true e))
|
||||
(-> (begin (comp statement e)
|
||||
(comp (or inc '(begin)) e)
|
||||
(-> (apply (-> (lexical '%continue %continue))))))
|
||||
(@implv *undefined*))))))
|
||||
(-> (begin (comp (or init '(begin)) e)
|
||||
(-> (apply (-> (lexical '%continue %continue)))))))))))
|
||||
|
||||
((for-in ,var ,object ,statement)
|
||||
(let ((%enum (gensym "%enum "))
|
||||
(%continue (gensym "%continue ")))
|
||||
(let ((e (econs '%enum %enum (econs '%continue %continue e))))
|
||||
(-> (letrec '(%enum %continue) (list %enum %continue)
|
||||
(list (@impl make-enumerator (comp object e))
|
||||
(-> (lambda '() '() '()
|
||||
(-> (if (@impl ->boolean
|
||||
(@impl pget
|
||||
(-> (lexical '%enum %enum))
|
||||
(-> (const 'length))))
|
||||
(-> (begin
|
||||
(comp `(= ,var (call/this ,(-> (lexical '%enum %enum))
|
||||
,(-> (const 'pop))))
|
||||
e)
|
||||
(comp statement e)
|
||||
(-> (apply (-> (lexical '%continue %continue))))))
|
||||
(@implv *undefined*))))))
|
||||
(-> (apply (-> (lexical '%continue %continue)))))))))
|
||||
|
||||
((block ,x)
|
||||
(comp x e))
|
||||
(else
|
||||
(error "compilation not yet implemented:" x)))))
|
||||
|
||||
(define (comp-body e body formals %args)
|
||||
(define (process)
|
||||
(let lp ((in body) (out '()) (rvars (reverse formals)))
|
||||
(pmatch in
|
||||
(((var (,x) . ,morevars) . ,rest)
|
||||
(lp `((var . ,morevars) . ,rest)
|
||||
out
|
||||
(if (memq x rvars) rvars (cons x rvars))))
|
||||
(((var (,x ,y) . ,morevars) . ,rest)
|
||||
(lp `((var . ,morevars) . ,rest)
|
||||
`((= (ref ,x) ,y) . ,out)
|
||||
(if (memq x rvars) rvars (cons x rvars))))
|
||||
(((var) . ,rest)
|
||||
(lp rest out rvars))
|
||||
((,x . ,rest) (guard (and (pair? x) (eq? (car x) 'lambda)))
|
||||
(lp rest
|
||||
(cons x out)
|
||||
rvars))
|
||||
((,x . ,rest) (guard (pair? x))
|
||||
(receive (sub-out rvars)
|
||||
(lp x '() rvars)
|
||||
(lp rest
|
||||
(cons sub-out out)
|
||||
rvars)))
|
||||
((,x . ,rest)
|
||||
(lp rest
|
||||
(cons x out)
|
||||
rvars))
|
||||
(()
|
||||
(values (reverse! out)
|
||||
rvars)))))
|
||||
(receive (out rvars)
|
||||
(process)
|
||||
(let* ((names (reverse rvars))
|
||||
(syms (map (lambda (x)
|
||||
(gensym (string-append (symbol->string x) " ")))
|
||||
names))
|
||||
(e (fold acons e names syms)))
|
||||
(let ((%argv (lookup %args e)))
|
||||
(let lp ((names names) (syms syms))
|
||||
(if (null? names)
|
||||
;; fixme: here check for too many args
|
||||
(comp out e)
|
||||
(-> (let (list (car names)) (list (car syms))
|
||||
(list (-> (if (-> (apply (-> (primitive 'null?)) %argv))
|
||||
(-> (@implv *undefined*))
|
||||
(-> (let1 (-> (apply (-> (primitive 'car)) %argv))
|
||||
(lambda (v)
|
||||
(-> (set! %argv
|
||||
(-> (apply (-> (primitive 'cdr)) %argv))))
|
||||
(-> (lexical v v))))))))
|
||||
(lp (cdr names) (cdr syms))))))))))
|
||||
|
|
@ -21,7 +21,7 @@
|
|||
(define-module (language ecmascript spec)
|
||||
#:use-module (system base language)
|
||||
#:use-module (language ecmascript parse)
|
||||
#:use-module (language ecmascript compile-ghil)
|
||||
#:use-module (language ecmascript compile-tree-il)
|
||||
#:export (ecmascript))
|
||||
|
||||
;;;
|
||||
|
|
@ -32,7 +32,7 @@
|
|||
#:title "Guile ECMAScript"
|
||||
#:version "3.0"
|
||||
#:reader (lambda () (read-ecmascript/1 (current-input-port)))
|
||||
#:compilers `((ghil . ,compile-ghil))
|
||||
#:compilers `((tree-il . ,compile-tree-il))
|
||||
;; a pretty-printer would be interesting.
|
||||
#:printer write
|
||||
)
|
||||
|
|
|
|||
|
|
@ -365,7 +365,7 @@
|
|||
. ,(cdar puncs))))))
|
||||
(lp nodes (cdr puncs))))
|
||||
(else
|
||||
(lp (cons `(,(string-ref (caar puncs) 0) #f) nodes)
|
||||
(lp (cons (list (string-ref (caar puncs) 0) #f) nodes)
|
||||
puncs))))))
|
||||
(lambda (port)
|
||||
(let lp ((c (peek-char port)) (tree punc-tree) (candidate #f))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue