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

Change local type representation and remove var type

This commit is contained in:
Ian Price 2015-06-21 01:56:01 +01:00
parent e9f37e6a31
commit a680a4cb9d
4 changed files with 39 additions and 42 deletions

View file

@ -74,36 +74,32 @@
(make-continuation
(cons (make-id self) ids)
(match body
(($ $cont k _)
(make-local (list (compile-cont body))
(($ $cont k cont)
(make-local `((,(make-kid k) . ,(compile-cont cont)))
(make-continue (make-kid k) ids)))))))))
(define (compile-term term)
(match term
(($ $letk conts body)
(make-local (map compile-cont conts) (compile-term body)))
(($ $letk (($ $cont ks conts) ...) body)
(make-local (map (lambda (k cont)
(cons (make-kid k)
(compile-cont cont)))
ks
conts)
(compile-term body)))
(($ $continue k src exp)
(compile-exp exp k))))
(define (compile-cont cont)
(match cont
(($ $cont k ($ $kargs names syms body))
;; use the name part?
(make-var (make-kid k)
(make-continuation (map make-id syms)
(compile-term body))))
(($ $cont k ($ $kreceive ($ $arity req _ (? symbol? rest) _ _) k2))
(make-var
(make-kid k)
(make-continuation (append (map make-id req) (list (make-id rest)))
(make-continue (make-kid k2)
(append (map make-id req)
(list (make-id rest)))))))
(($ $cont k ($ $kreceive ($ $arity req _ #f _ _) k2))
(make-var (make-kid k)
(make-continuation (map make-id req)
(make-continue (make-kid k2)
(map make-id req)))))))
(($ $kargs names syms body)
(make-continuation (map make-id syms) (compile-term body)))
(($ $kreceive ($ $arity req _ (? symbol? rest) _ _) k2)
(let ((ids (map make-id (append req (list rest)))))
(make-continuation ids (make-continue (make-kid k2) ids))))
(($ $kreceive ($ $arity req _ #f _ _) k2)
(let ((ids (map make-id req)))
(make-continuation ids (make-continue (make-kid k2) ids))))))
(define (compile-exp exp k)
(match exp

View file

@ -7,7 +7,6 @@
make-params params
make-continuation continuation
make-local local
make-var var
make-continue continue
make-const const
make-primcall primcall
@ -55,7 +54,6 @@
(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)
(define-js-type continue cont args)
(define-js-type const value)
(define-js-type primcall name args)
@ -96,9 +94,12 @@
kws)
,allow-other-keys?))
(($ local bindings body)
`(local ,(map unparse-js bindings) ,(unparse-js body)))
(($ var id exp)
`(var ,id ,(unparse-js exp)))
`(local ,(map (match-lambda
((a . d)
(cons (unparse-js a)
(unparse-js d))))
bindings)
,(unparse-js body)))
(($ continue ($ kid k) args)
`(continue ,k ,(map unparse-js args)))
(($ branch test then else)

View file

@ -149,11 +149,13 @@
clauses)
(list (compile-jump-table clauses)))))
(($ il:local bindings body)
(make-block (append (map compile-exp bindings) (list (compile-exp body)))))
(($ il:var id exp)
(make-var (rename-id id) (compile-exp exp)))
(($ il:local ((ids . bindings) ...) body)
(make-block
(append (map (lambda (id binding)
(make-var (rename-id id) (compile-exp binding)))
ids
bindings)
(list (compile-exp body)))))
(($ il:continue k exps)
(make-return (make-call (compile-id k) (map compile-exp exps))))

View file

@ -31,12 +31,11 @@
(analyse body))
(($ local bindings body)
(for-each analyse bindings)
(for-each (match-lambda
((i . b) (analyse b)))
bindings)
(analyse body))
(($ var id exp)
(analyse exp))
(($ continue ($ kid cont) args)
(count-inc! cont)
(for-each analyse args))
@ -103,12 +102,12 @@
(define (split-inlinable bindings)
(partition (match-lambda
(($ var ($ kid id) _) (inlinable? id)))
((($ kid id) . _) (inlinable? id)))
bindings))
(define (lookup kont substs)
(match substs
((($ var ($ kid id) exp) . rest)
(((($ kid id) . exp) . rest)
(if (= id kont)
exp
(lookup kont rest)))
@ -140,7 +139,7 @@
(($ continuation kargs body)
(if (not (= (length args) (length kargs)))
(throw 'args-dont-match cont args kargs)
(make-local (map make-var kargs args)
(make-local (map cons kargs args)
;; gah, this doesn't work
;; identifiers need to be separated earlier
;; not just as part of compilation
@ -162,13 +161,12 @@
(split-inlinable bindings))
(lambda (new-substs uninlinable-bindings)
(define substs* (append new-substs substs))
(make-local (map (lambda (x) (inline x substs*))
(make-local (map (match-lambda
((id . val)
`(,id . ,(inline val substs*))))
uninlinable-bindings)
(inline body substs*)))))
(($ var id exp)
(make-var id (inline exp substs)))
(($ seq body)
(make-seq (map (lambda (x) (inline x substs))
body)))