Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (define (make-source src . end)
- (let ((lst (cond
- ((string? src) (string->list src))
- ((vector? src) (vector->list src))
- (else src)))
- (mend (and (not (null? end)) (car end))))
- (cons lst mend)))
- (define (next source)
- (if (null? (car source))
- (cdr source)
- (let ((ret (caar source)))
- (set-car! source (cdar source))
- ret)))
- (define (parse vec)
- (define return 1)
- (define cl 1)
- (define src (make-source vec))
- (define (nl) (set! cl (next src)))
- (define (parse-body)
- (cond
- ((equal? cl 'if) (list cl
- (let loop ((res '()))
- (nl)
- (if (and cl (not (equal? cl 'endif)))
- (loop (cons (parse-body) res))
- (if (equal? cl 'endif)
- (reverse res)
- (return #f))))))
- ((member cl '(end endif define)) (return #f))
- ((symbol? cl) cl)
- ((number? cl) cl)
- (else (return #f))))
- (define (parse-article)
- ;(if (equal? cl 'define)
- (begin
- (nl)
- (list cl
- (let loop ((res '()))
- (nl)
- (if (and cl (not (equal? cl 'end)))
- (let ((tmp (parse-body)))
- (if tmp
- (loop (cons tmp res))
- (return #f)))
- (if (equal? cl 'end)
- (begin (nl) (reverse res))
- (return #f))))))
- ;#f)
- )
- (define (parse-articles)
- (let loop ((rs '()))
- (if (equal? cl 'define)
- (let ((tmp (parse-article)))
- (loop (cons tmp rs)))
- (reverse rs))))
- (define (parse-program)
- (list
- (parse-articles)
- (let loop ((res '()))
- (if cl
- (let ((prev (parse-body)))
- (nl)
- (if prev
- (loop (cons prev res))
- (return #f)))
- (reverse res)))))
- (call/cc (lambda (exit) (set! return exit) (nl) (parse-program))))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement