SHARE
TWEET

Untitled

ZOOOO Nov 20th, 2015 7,323 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (define (make-source src . end)
  2.   (let ((lst (cond
  3.                ((string? src) (string->list src))
  4.                ((vector? src) (vector->list src))
  5.                (else src)))
  6.         (mend (and (not (null? end)) (car end))))
  7.     (cons lst mend)))
  8. (define (next source)
  9.   (if (null? (car source))
  10.       (cdr source)
  11.       (let ((ret (caar source)))
  12.         (set-car! source (cdar source))
  13.         ret)))
  14.  
  15. (define (parse vec)
  16.   (define return 1)
  17.   (define cl 1)
  18.   (define src (make-source vec))
  19.   (define (nl) (set! cl (next src)))
  20.   (define (parse-body)
  21.     (cond
  22.       ((equal? cl 'if) (list cl
  23.                              (let loop ((res '()))
  24.                                (nl)
  25.                                (if (and cl (not (equal? cl 'endif)))
  26.                                    (loop (cons (parse-body) res))
  27.                                    (if (equal? cl 'endif)
  28.                                        (reverse res)
  29.                                        (return #f))))))
  30.       ((member cl '(end endif define)) (return #f))
  31.       ((symbol? cl) cl)
  32.       ((number? cl) cl)
  33.       (else (return #f))))
  34.   (define (parse-article)
  35.     ;(if (equal? cl 'define)
  36.     (begin
  37.       (nl)
  38.       (list cl
  39.             (let loop ((res '()))
  40.               (nl)
  41.               (if (and cl (not (equal? cl 'end)))
  42.                   (let ((tmp (parse-body)))
  43.                     (if tmp
  44.                         (loop (cons tmp res))
  45.                         (return #f)))
  46.                   (if (equal? cl 'end)
  47.                       (begin (nl) (reverse res))
  48.                       (return #f))))))
  49.     ;#f)
  50.     )
  51.   (define (parse-articles)
  52.     (let loop ((rs '()))
  53.       (if (equal? cl 'define)
  54.           (let ((tmp (parse-article)))
  55.             (loop (cons tmp rs)))
  56.           (reverse rs))))
  57.   (define (parse-program)
  58.     (list
  59.      (parse-articles)
  60.      (let loop ((res '()))
  61.        (if cl
  62.            (let ((prev (parse-body)))
  63.              (nl)
  64.              (if prev
  65.                  (loop (cons prev res))
  66.                  (return #f)))
  67.            (reverse res)))))
  68.   (call/cc (lambda (exit) (set! return exit) (nl) (parse-program))))
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top