#lang s-exp "lang.ss"
(require "env.ss")
(require "toplevel.ss")
(require "permission.ss")
(require "modules.ss")
(define-struct pinfo (env modules used-bindings-hash gensym-counter
enduring-names ))
(define empty-pinfo
(make-pinfo empty-env
empty
(make-immutable-hasheq empty)
0
empty))
(define (pinfo-used-bindings a-pinfo)
(hash-map (pinfo-used-bindings-hash a-pinfo)
(lambda (k v) v)))
(define (pinfo-clear-enduring-names a-pinfo)
(make-pinfo (pinfo-env a-pinfo)
(pinfo-modules a-pinfo)
(pinfo-used-bindings-hash a-pinfo)
(pinfo-gensym-counter a-pinfo)
empty))
(define (pinfo-update-env a-pinfo an-env)
(make-pinfo
an-env
(pinfo-modules a-pinfo)
(pinfo-used-bindings-hash a-pinfo)
(pinfo-gensym-counter a-pinfo)
(pinfo-enduring-names a-pinfo)))
(define (pinfo-accumulate-binding a-binding a-pinfo)
(make-pinfo
(env-extend (pinfo-env a-pinfo) a-binding)
(pinfo-modules a-pinfo)
(pinfo-used-bindings-hash a-pinfo)
(pinfo-gensym-counter a-pinfo)
(pinfo-enduring-names a-pinfo)))
(define (pinfo-accumulate-bindings bindings a-pinfo)
(foldl pinfo-accumulate-binding
a-pinfo
bindings))
(define (pinfo-accumulate-module a-module a-pinfo)
(make-pinfo (pinfo-env a-pinfo)
(cons a-module (pinfo-modules a-pinfo))
(pinfo-used-bindings-hash a-pinfo)
(pinfo-gensym-counter a-pinfo)
(pinfo-enduring-names a-pinfo)))
(define (pinfo-accumulate-binding-use a-binding a-pinfo)
(make-pinfo (pinfo-env a-pinfo)
(pinfo-modules a-pinfo)
(hash-set (pinfo-used-bindings-hash a-pinfo)
(binding-id a-binding)
a-binding)
(pinfo-gensym-counter a-pinfo)
(pinfo-enduring-names a-pinfo)))
(define (pinfo-gensym a-pinfo a-label)
(list (make-pinfo (pinfo-env a-pinfo)
(pinfo-modules a-pinfo)
(pinfo-used-bindings-hash a-pinfo)
(add1 (pinfo-gensym-counter a-pinfo))
(pinfo-enduring-names a-pinfo))
(string->symbol
(string-append (symbol->string a-label)
(number->string (pinfo-gensym-counter a-pinfo))))))
(define (pinfo-permissions a-pinfo)
(local [ (define (unique lst)
(cond [(empty? lst)
empty]
[(member? (first lst)
(rest lst))
(unique (rest lst))]
[else
(cons (first lst)
(unique (rest lst)))]))
(define (member? x lst)
(cond
[(empty? lst)
false]
[(eq? (first lst) x)
true]
[else
(member? x (rest lst))]))]
(unique
(foldl (lambda (a-binding permissions)
(cond [(binding:function? a-binding)
(append (binding:function-permissions a-binding)
permissions)]
[(binding:constant? a-binding)
(append (binding:constant-permissions a-binding)
permissions)]))
empty
(pinfo-used-bindings a-pinfo)))))
(define (get-base-pinfo language)
(cond
[(symbol=? language 'moby)
(pinfo-update-env empty-pinfo
(extend-env/module-binding (get-toplevel-env language)
moby-module-binding))]
[(symbol=? language 'base)
(pinfo-update-env empty-pinfo
(get-toplevel-env language))]))
(provide/contract [struct pinfo ([env env?]
[modules (listof module-binding?)]
[used-bindings-hash hash?]
[gensym-counter number?]
[enduring-names (listof symbol?)])]
[empty-pinfo pinfo?]
[get-base-pinfo (symbol? . -> . pinfo?)]
[pinfo-used-bindings (pinfo? . -> . (listof binding?))]
[pinfo-accumulate-module (module-binding? pinfo? . -> . pinfo?)]
[pinfo-accumulate-binding (binding? pinfo? . -> . pinfo?)]
[pinfo-accumulate-binding-use (binding? pinfo? . -> . pinfo?)]
[pinfo-accumulate-bindings ((listof binding?) pinfo? . -> . pinfo?)]
[pinfo-update-env (pinfo? env? . -> . pinfo?)]
[pinfo-gensym (pinfo? symbol? . -> . (list/c pinfo? symbol?))]
[pinfo-permissions (pinfo? . -> . (listof permission?))])