(module normalizing-module-name-resolver mzscheme
  (require (lib "file.ss")
           (lib "moddep.ss" "syntax"))
  
  ;; This code is an ugly ugly kludge.
  ;; It's meant to normalize all module paths so that,
  ;; if they involve symlinks, we apply normalize-path to them and force
  ;; any module to have a stable, canonical path.
  ;;
  ;; The only external function here will be normalizing-module-name-resolver:
  
  
  ;; original-module-name-resolver is the name resolver we'll be overriding (or reusing!)
  (define original-module-name-resolver (current-module-name-resolver))
  

  ;; The module name resolver that comes standard with mzscheme doesn't
  ;; normalize paths --- this becomes a problem if we use symbolic links,
  ;; since a module then is not uniquely identified by path.  This module
  ;; provides a custom name resolver for dungeon that ensures all paths
  ;; are normalized to remove symlinks.
  ;;
  ;; normalizing-module-name-resolver: (union module-path #f)
  ;;                                   (union symbol #f)
  ;;                                   (union stx #f) -> symbol 
  (provide normalizing-module-name-resolver)
  (define (normalizing-module-name-resolver module-path module-name stx-or-#f)
    (original-module-name-resolver 
     (module-path->normalized-path module-path module-name)
     module-name
     stx-or-#f))
  

  ;; normalize-file-path/memo: path -> path
  ;; Given a file path, normalizes the file path, using an internal cache
  ;; to speed up normalizing the base of the file path.
  (define (normalize-file-path/memo file-path)
    ;; normalize-base-path/memo: path -> path
    ;; a memoized version of normalize-path.
    (define normalize-base-path/memo 
      (memoize (lambda (path) (normalize-path path))))
    
    (let-values ([(base name is-dir?) (split-path file-path)])
      (build-path (normalize-base-path/memo base) name)))
  

  ;; module-path->normalized-path: module-path module-name -> module-path
  ;; Fully normalizes the module-path and turns it into an absolute, canonical
  ;; path.
  (define (module-path->normalized-path module-path module-name)
    (normalize-file-path/memo
     (resolve-module-path 
      module-path 
      ;; Third arg to resolve-module-path
      ;; must be a lambda, or else resolve-module-path
      ;; does the wrong thing:
      (lambda () (get-dir module-path module-name)))))
  
  

  ;; get-dir: module-path (union symbol #f)
  ;; 
  ;; Ugly kludge that I'm adapting from the standard module name resolver
  ;; in mzscheme/src/startup.ss.  When we're given relative paths,
  ;; what the standard module name resolver appears
  ;; to do sometimes is encode the base relative path in module-name.
  ;; We repeat the same weirdness here, but I would like to know if there's
  ;; a better way to do this.
  (define (get-dir module-path module-name)
    (define (id x) x)
    
    (define -re:auto (byte-regexp #"^,"))
    
    (define module-name->path 
      (memoize 
       (lambda (module-name)
         (let ([rts (string->bytes/latin-1 (symbol->string module-name))])
           (cond 
             [(regexp-match -re:auto rts)
              (let-values ([(base n d?) (split-path (bytes->path (subbytes rts 1)))])
                base)]
             [else #f])))))
    
    (cond
      [(and module-name (module-name->path module-name)) => id]
      [(current-load-relative-directory) => id]
      [else (current-directory)]))


  (define (memoize f)
    (let ([ht (make-hash-table 'equal)])
      (lambda (x)
        (hash-table-get ht x
                        (lambda ()
                          (hash-table-put! ht x (f x))
                          (hash-table-get ht x)))))))