adt-init.rkt (1958B)
1 #lang at-exp typed/racket 2 (provide adt-init) 3 (require remember 4 "ctx.hl.rkt" 5 phc-toolkit 6 (for-syntax (only-in '#%kernel [#%app #%plain-app]) 7 syntax/parse 8 syntax/parse/experimental/template 9 phc-toolkit/untyped 10 racket/port 11 mzlib/etc)) 12 13 (define-for-syntax ((the-trampoline srcdir pre-declarations-filename) stx2) 14 (syntax-case stx2 () 15 [(_ self2) 16 #`(adt-init-2 self2 17 #,srcdir 18 #,pre-declarations-filename)])) 19 20 (define-syntax adt-init 21 (syntax-parser 22 [(self (~optional pre-declarations-filename 23 #:defaults ([pre-declarations-filename 24 #'"adt-pre-declarations.rkt"]))) 25 #'(begin (define-syntaxes (trampoline) 26 (#%plain-app the-trampoline 27 (this-expression-source-directory self) 28 'pre-declarations-filename)) 29 (begin-for-syntax (set-adt-context #'self)) 30 (trampoline self))])) 31 32 (define-syntax/parse (adt-init-2 ctx pre-declarations-dir pre-declarations-file) 33 (define pre-declarations-path 34 (build-path (syntax-e #'pre-declarations-dir) 35 (syntax-e #'pre-declarations-file))) 36 (define pre-declarations-path-string 37 (path->string pre-declarations-path)) 38 39 ;; Initialize the pre-declarations file if it is empty: 40 (init-file pre-declarations-path 41 "#lang s-exp phc-adt/declarations\n") 42 43 (remember-output-file-parameter pre-declarations-path-string) 44 ;(set-adt-context #'ctx) 45 #`(require #,(datum->syntax #'ctx (syntax-e #'pre-declarations-file)))) 46 47 (define-for-syntax (init-file path string-contents) 48 (unless (file-exists? path) 49 (with-handlers ([exn:fail:filesystem (λ (exn) (void))]) 50 (with-output-file [port path] #:exists 'error 51 (display string-contents port)))))