Welcome to the CHICKEN Scheme pasting service
Ciode to parse a STL file -- how to improve? added by alexshendi on Thu Jul 25 22:37:31 2013
(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)