Linked namespaces

Questions & Answers
1

Is it possible to have linked namespaces? By which I mean that if evaluating something in namespace n1 and it is not defined in n1 it will go look for it in its parent namespace n0 (or even further if the link is longer):

#lang racket/base

(require rackunit)

(define (test n0 n1 ...)
  (displayln ...)
  (eval '(define a 1) n0)
  (eval '(define b 2) n0)
  (eval '(define b 3) n1)
  (eval '(define c 4) n1)

  (check-equal? (eval 'a n0) 1)
  (check-equal? (eval 'a n1) 1)
  (check-equal? (eval 'b n0) 2)
  (check-equal? (eval 'b n1) 3)
  (check-exn #px"" (λ () (eval 'c n0)))
  (check-equal? (eval 'c n1) 4))

;; test 1
(define n0 (make-base-namespace))
(define n1 n0)

(test n0 n1 'test1)

;; test2
(define m0 (make-base-namespace))
(define anchor (eval '(begin (define-namespace-anchor anker) anker) m0))
(define m1 (namespace-anchor->namespace anchor))

(test m0 m1 'test2)

;; test3
(define q0 (make-base-namespace))
(define q1 (make-base-namespace))
(namespace-set-variable-value! '#%top (λ (x) (eval x q0)) #f q1)

(test q0 q1 'test3)
2

My best idea is to write a custom #%top.

3

thanks,

I managed to get something working, more or less. There are some id's I can only get to via eval it seems. And unfortunately that is too slow for my usecase. For example, for a newly created struct QQ : QQ? can be found with namespace-variable-value, but the struct constructor itself QQ seems to be only reachable with eval.
If there is a better way, I would love to hear it.

top.rkt:

#lang racket/base

(require (for-syntax racket/base)
         racket/stxparam)
(provide ;(except-out (all-from-out racket/base) #%top + * - / vector vector-ref)
         (rename-out [new-top #%top])
         ;; #%- bindings
         #%app
         #%datum
         #%declare
         #%expression
         #%foreign-inline
         #%module-begin
         #%plain-app
         #%plain-lambda
         #%plain-module-begin
         #%printing-module-begin
         #%provide
         #%require
         #%stratified-body
         #%top-interaction
         #%variable-reference
         ;; require subforms
         require file submod except-in prefix-in
         ;; define's
         define  ; ...
         struct
         ;; lambda's
         λ case-lambda lambda
         ;; let's
         let  ; ...
         ;; quoting
         quote quasiquote unquote unquote-splicing
         ;; for's
         for* ; ...
         ;; ...
         if case cond else do when unless         
         
         set-parent-ns!)

(define #%parent-ns #f)
(define (set-parent-ns! ns) (set! #%parent-ns ns))

(define not-defined (gensym))

(define (lookup1 id ns no)
  (println (list 'lookup1 id))
  (define x (namespace-variable-value id #t (λ () not-defined) ns))
  (if (eq? not-defined x)
      (cond [(namespace-variable-value '#%parent-ns #f (λ () #f) ns)
             => (λ (ns) (lookup1 id ns no))]
            [else (no)])
      x))

(define (lookup2 id ns no)
  (define x (namespace-variable-value id #t (λ () not-defined) ns))
  (if (eq? not-defined x)
      (if (member id (namespace-mapped-symbols ns))
          ;; again - too slow
          (eval id ns)
          (cond [(namespace-variable-value '#%parent-ns #f (λ () #f) ns)
                 => (λ (ns) (lookup2 id ns no))]
                [else (no)]))
      x))

(define-syntax (new-top stx)
  (syntax-case stx ()
    [(_ . id)
     #'(if #%parent-ns
           (lookup1 'id #%parent-ns (λ () (#%top . id)))
           (#%top . id))]))

#; ;; too slow
(define-syntax (new-top stx)
  (syntax-case stx ()
    [(_ . id)
     #'(if #%parent-ns (eval 'id #%parent-ns)
           (#%top . id))]))

linked.rkt:

#lang racket/base

(require racket/runtime-path)

(provide make-linked-namespace-from)

(define-runtime-module-path top-path "top.rkt")

(define (make-linked-namespace-from parent-ns [base make-base-empty-namespace] #:name [name #f])
  (define linked-ns (base))
  (parameterize ([current-namespace linked-ns])
    (namespace-require top-path)
    (eval `(set-parent-ns! ,parent-ns))
    (namespace-set-variable-value! '#%parent-ns parent-ns #t)
    (when name
      (namespace-set-variable-value! '*environment* name #t)))
  linked-ns)

test:

(require rackunit
         (file "linked.rkt"))

(define (test n0 n1 . ...)
  (displayln ...)
  (define A (gensym))
  (define B (gensym))
  (define C (gensym))
  (eval `(define ,A 1) n0)
  (eval `(define ,B 2) n0)
  (eval `(define ,B 3) n1)
  (eval `(define ,C 4) n1)

  (check-equal? (eval A n0) 1)
  (check-equal? (eval A n1) 1)
  
  (check-equal? (eval B n0) 2)
  (check-equal? (eval B n1) 3)
  
  (check-exn #px"" (λ () (eval C n0)))
  (check-equal? (eval C n1) 4)
  )

;; test 1
(define n0 (make-base-namespace))
(define n1 (make-linked-namespace-from n0))
(define n2 (make-linked-namespace-from n1))

(define n3 (make-linked-namespace-from n0))

(test n0 n1 'test 0 1)
(test n1 n2 'test 1 2)
(test n0 n2 'test 0 2)
(test n1 n3 'test 1 3 'should-fail)

(eval '(struct QQ (f)) n1)

(eval '(QQ 'a) n1)
(eval '(QQ 'a) n2)