| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253 |
- #lang racket
- ;; this code implements a parser using racket specific functions
- ;;
- ;; in future it needs to be reimplemented in plain scheme
- (require racket/match)
- (provide parse-file
- sid sid? sid-id sid-metadata set-sid-id! set-sid-metadata!
- special special? special-id special-metadata set-special-id! set-special-metadata!
- syx->datum)
- (define (parse-file filename)
- (call-with-input-file filename
- (lambda (in)
- (port-count-lines! in)
- (let loop ()
- (let ((object (read-syntax filename in)))
- (if (eof-object? object)
- '()
- (cons (process-syntax-object object) (loop))))))))
- (struct sid ((id #:mutable) (metadata #:mutable)) #:transparent)
- (struct special ((id #:mutable) (metadata #:mutable)) #:transparent)
- (define (syntax-metadata stx)
- (list (cons 'source (syntax-source stx))
- (cons 'line (syntax-line stx))
- (cons 'column (syntax-column stx))))
- (define (process-syntax-object stx)
- (let ((e (if (syntax? stx) (syntax-e stx) stx)))
- (cond ((or (number? e) (boolean? e) (string? e)) e)
- ((symbol? e) (sid e (syntax-metadata stx)))
- ((pair? e) (cons (process-syntax-object (car e))
- (process-syntax-object (cdr e))))
- ((null? e) '())
- (else (error "unknown syntax object" stx)))))
- ;; > (parse-file "t1.scm")
- ;; (list
- ;; (list
- ;; (sid 'define '((source . "t1.scm") (line . 1) (column . 1)))
- ;; (sid 'main '((source . "t1.scm") (line . 1) (column . 8)))
- ;; (list (sid 'print '((source . "t1.scm") (line . 1) (column . 14))) "hello world!")))
- (define (syx->datum e)
- (cond ((or (number? e) (boolean? e) (string? e)) e)
- ((sid? e) (sid-id e))
- ((special? e) (special-id e))
- ((list? e) (map syx->datum e))
- (else (error "syx->datum" e))))
|
