(chicken irregex)
(chicken io)
(chicken string)
- mars)
+ srfi-13 mars)
(define (string->prog str)
(let ((idx 0)
(period-irx (irregex "^\\."))
(redcode-irx (irregex "^;redcode\n"))
(name-start-irx (irregex "^;[ \t]*name "))
- (name-irx (irregex "^[a-zA-Z0-9]+"))
+ (name-irx (irregex "^[^\n]*"))
+ (author-start-irx (irregex "^;[ \t]*author "))
+ (author-irx (irregex "^[^\n]*"))
(comment-irx (irregex "^(;[^\n]*)?\n"))
(org-irx (irregex "^ORG"))
(opcode-DAT-irx (irregex "^DAT"))
(accept-token redcode-irx #t)
(let loop ((instrs '())
(offset 0)
- (name '()))
+ (name '())
+ (author '()))
(let ((this-line (line)))
(if this-line
(case (car this-line)
- ((name) (loop instrs offset (cdr this-line)))
- ((comment) (loop instrs offset name))
- ((org) (loop instrs (cdr this-line) name))
- ((instr) (loop (cons (cdr this-line) instrs) offset name)))
- (make-prog name (reverse instrs) offset)))))
+ ((name) (loop instrs offset (cdr this-line) author))
+ ((author) (loop instrs offset name (cdr this-line)))
+ ((comment) (loop instrs offset name author))
+ ((org) (loop instrs (cdr this-line) name author))
+ ((instr) (loop (cons (cdr this-line) instrs) offset name author)))
+ (make-prog name author (reverse instrs) offset)))))
(define (line)
(or (name-line)
+ (author-line)
(comment-line)
(org-line)
(instruction-line)))
(define (name-line)
(if (accept-token name-start-irx)
- (cons 'name (string->symbol (accept-token name-irx #t)))
+ (cons 'name (string-trim (accept-token name-irx #t)))
+ #f))
+ (define (author-line)
+ (if (accept-token author-start-irx)
+ (cons 'author (string-trim (accept-token author-irx #t)))
#f))
(define (comment-line)
(if (accept-token comment-irx)
(let ((x (accept-token period-irx #t))
(modif (modifier))
(A-mode (mode))
- (A-num (accept-token number-irx #t))
+ (A-num (string->number (accept-token number-irx #t)))
(y (accept-token comma-irx #t))
(B-mode (mode))
- (B-num (accept-token number-irx #t))
+ (B-num (string->number (accept-token number-irx #t)))
(z (accept-token comment-irx #t)))
(cons 'instr (make-instr oc modif A-mode A-num B-mode B-num)))
#f)))