|
2851 | 2851 | (or (valid-name? e) |
2852 | 2852 | (error (string "invalid identifier name \"" e "\"")))) |
2853 | 2853 |
|
| 2854 | +(define (push-var! tab var val) (put! tab var (cons val (get tab var #f)))) |
| 2855 | +(define (pop-var! tab var) (put! tab var (cdr (get tab var)))) |
| 2856 | + |
2854 | 2857 | (define (make-scope (lam #f) (args '()) (locals '()) (globals '()) (sp '()) (renames '()) (prev #f) |
2855 | 2858 | (soft? #f) (hard? #f) (implicit-globals '()) (warn-vars #f)) |
2856 | | - (vector lam args locals globals sp renames prev soft? hard? implicit-globals warn-vars)) |
| 2859 | + (let ((tab (if prev (scope:table prev) (table)))) |
| 2860 | + (for-each (lambda (v) (push-var! tab v v)) sp) |
| 2861 | + (for-each (lambda (v) (push-var! tab v v)) locals) |
| 2862 | + (for-each (lambda (pair) (push-var! tab (car pair) (cdr pair))) renames) |
| 2863 | + (for-each (lambda (v) (push-var! tab v `(outerref ,v))) globals) |
| 2864 | + (for-each (lambda (v) (push-var! tab v v)) args) |
| 2865 | + (vector lam args locals globals sp renames prev soft? hard? implicit-globals warn-vars tab))) |
| 2866 | + |
| 2867 | +(define (pop-scope! scope) |
| 2868 | + (let ((tab (scope:table scope))) |
| 2869 | + (for-each (lambda (v) (pop-var! tab v)) (scope:sp scope)) |
| 2870 | + (for-each (lambda (v) (pop-var! tab v)) (scope:locals scope)) |
| 2871 | + (for-each (lambda (pair) (pop-var! tab (car pair))) (scope:renames scope)) |
| 2872 | + (for-each (lambda (v) (pop-var! tab v)) (scope:globals scope)) |
| 2873 | + (for-each (lambda (v) (pop-var! tab v)) (scope:args scope)))) |
| 2874 | + |
2857 | 2875 | (define (scope:lam s) (aref s 0)) |
2858 | 2876 | (define (scope:args s) (aref s 1)) |
2859 | 2877 | (define (scope:locals s) (aref s 2)) |
|
2865 | 2883 | (define (scope:hard? s) (aref s 8)) |
2866 | 2884 | (define (scope:implicit-globals s) (aref s 9)) |
2867 | 2885 | (define (scope:warn-vars s) (aref s 10)) |
| 2886 | +(define (scope:table s) (aref s 11)) |
2868 | 2887 |
|
2869 | 2888 | (define (var-kind var scope (exclude-top-level-globals #f)) |
2870 | 2889 | (if scope |
|
2902 | 2921 | ;; returns lambdas in the form (lambda (args...) (locals...) body) |
2903 | 2922 | (define (resolve-scopes- e scope (sp '()) (loc #f)) |
2904 | 2923 | (cond ((symbol? e) |
2905 | | - (let lookup ((scope scope)) |
2906 | | - (if scope |
2907 | | - (cond ((memq e (scope:args scope)) e) |
2908 | | - ((memq e (scope:globals scope)) `(outerref ,e)) |
2909 | | - (else |
2910 | | - (let ((r (assq e (scope:renames scope)))) |
2911 | | - (cond (r (cdr r)) |
2912 | | - ((memq e (scope:locals scope)) e) |
2913 | | - ((memq e (scope:sp scope)) e) |
2914 | | - (else |
2915 | | - (lookup (scope:prev scope))))))) |
2916 | | - (if (underscore-symbol? e) |
2917 | | - e |
2918 | | - `(outerref ,e))))) |
| 2924 | + (let ((val (and scope (get (scope:table scope) e #f)))) |
| 2925 | + (cond (val (car val)) |
| 2926 | + ((underscore-symbol? e) e) |
| 2927 | + (else `(outerref ,e))))) |
2919 | 2928 | ((or (not (pair? e)) (quoted? e) (memq (car e) '(toplevel symbolicgoto symboliclabel toplevel-only))) |
2920 | 2929 | e) |
2921 | 2930 | ((eq? (car e) 'global) |
|
2953 | 2962 | '(true))) |
2954 | 2963 | ((eq? (car e) 'lambda) |
2955 | 2964 | (let* ((args (lam:argnames e)) |
2956 | | - (body (resolve-scopes- (lam:body e) (make-scope e args '() '() sp '() scope)))) |
| 2965 | + (new-scope (make-scope e args '() '() sp '() scope)) |
| 2966 | + (body (resolve-scopes- (lam:body e) new-scope))) |
| 2967 | + (pop-scope! new-scope) |
2957 | 2968 | `(lambda ,(cadr e) ,(caddr e) ,body))) |
2958 | 2969 | ((eq? (car e) 'scope-block) |
2959 | 2970 | (let* ((blok (cadr e)) ;; body of scope-block expression |
|
3034 | 3045 | (append (caddr lam) newnames newnames-def))) |
3035 | 3046 | (insert-after-meta ;; return the new, expanded scope-block |
3036 | 3047 | (blockify |
3037 | | - (resolve-scopes- blok |
3038 | | - (make-scope lam |
| 3048 | + (let ((new-scope (make-scope lam |
3039 | 3049 | '() |
3040 | 3050 | (append locals-nondef locals-def) |
3041 | 3051 | globals |
|
3048 | 3058 | (if toplevel? |
3049 | 3059 | implicit-globals |
3050 | 3060 | (scope:implicit-globals scope)) |
3051 | | - warn-vars) |
3052 | | - '() |
3053 | | - loc)) |
| 3061 | + warn-vars))) |
| 3062 | + (begin0 |
| 3063 | + (resolve-scopes- blok new-scope '() loc) |
| 3064 | + (pop-scope! new-scope)))) |
3054 | 3065 | (append! (map (lambda (v) `(local ,v)) newnames) |
3055 | 3066 | (map (lambda (v) `(local-def ,v)) newnames-def))) |
3056 | 3067 | )) |
|
0 commit comments