Welcome to the CHICKEN Scheme pasting service

(define (lexer-aux inport res)
  (let ((token (read inport)))
    (if (eof-object? token)
        (reverse res)
        (lexer-aux inport (cons token res)))))

(define (lexer filename)
  (call-with-input-file filename
     (lambda (inport) 
        (lexer-aux inport '()))))

(define (parse-success val)
  (lambda (tokens idx)
    (list val idx)))

(define (parse-fail) 
  (lambda (tokens idx)
     (list #f #f)))

(define (parse-if pred?)
  (lambda (tokens idx)
     (let ((v (list-ref tokens idx)))
       (if (pred? v)
           (list v (+ idx 1))
           (list #f #f)))))

(define (parse-seq . parsers)
  (lambda (tokens idx)
     (let seq-loop ((parsers parsers)
                    (start idx)
                    (stop idx)
                    (seq-val '()))
         (if (null? parsers)
             (list (reverse seq-val) stop)
             (let ((v1 ((car parsers) tokens stop)))
                (if (cadr v1)
                    (seq-loop (cdr parsers) start (cadr v1)
                              (cons (car v1) seq-val))
                    (list #f #f)))))))

(define (parse-choice . parsers)
  (lambda (tokens idx)
     (let choice-loop ((parsers parsers))
         (if (null? parsers)
             (list #f #f)
             (let ((v1 ((car parsers) tokens idx)))
                (if (cadr v1)
                    v1 
                    (choice-loop (cdr parsers))))))))

(define (parse-repetition parser)
  (lambda (tokens idx)
    (let rep-loop ((start idx)
                   (res '()))
       (let ((v1 (parser tokens start)))
          (if (cadr v1)
              (rep-loop (cadr v1) (cons (car v1) res))
              (list (reverse res) start))))))

(define (parse-number n)
  (parse-if (lambda (x) (and (number? x) (= x n)))))

(define (parse-symbol s)
  (parse-if (lambda (x) (and (symbol? x) (eq? x s)))))
  
(define my-parser (parse-seq (parse-if (lambda (x) (eq? x 'hurz)))
                             (parse-if (lambda (x) (and (number? x) (= x 42))))))

(define my-parser-1
   (parse-seq (parse-if (lambda (x) (eq? x 'hurz)))
              (parse-if (lambda (x) (and (number? x) (= x 42))))
              (parse-if (lambda (x) (and (number? x) (= x 33))))))

(define my-parser-2 
   (parse-seq (parse-if (lambda (x) (eq? x 'hurz)))
              (parse-number 42)
              (parse-choice (parse-number 666) (parse-number 33))))

(display (my-parser '(hurz 42 33) 0))
(newline)
(display (my-parser-1 '(hurz 42 33) 0))
(newline)
(display (my-parser-2 '(hurz 42 33) 0))
(newline)
(display (my-parser-2 '(hurz 42 666) 0))
(newline)
(display (my-parser-2 '(hurz 42 555) 0))
(newline)

(define stl-parser
  (parse-seq (parse-symbol 'solid)
             (parse-if symbol?)
             (parse-repetition
               (parse-seq (parse-symbol 'facet)
                          (parse-seq (parse-symbol 'normal)
                                     (parse-if number?)
                                     (parse-if number?)
                                     (parse-if number?))
                          (parse-symbol 'outer)
                          (parse-symbol 'loop)
                          (parse-seq (parse-symbol 'vertex)
                                     (parse-if number?)
                                     (parse-if number?)
                                     (parse-if number?))
                          (parse-seq (parse-symbol 'vertex)
                                     (parse-if number?)
                                     (parse-if number?)
                                     (parse-if number?))
                          (parse-seq (parse-symbol 'vertex)
                                     (parse-if number?)
                                     (parse-if number?)
                                     (parse-if number?))
                          (parse-symbol 'endloop)
                          (parse-symbol 'endfacet)))
               (parse-symbol 'endsolid)
               (parse-if symbol?)))

(display (stl-parser (lexer "./sphere.stl") 0))
(newline)