X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=jars.git;a=blobdiff_plain;f=parser.scm;h=c112cf9ccd9da9eda8b1d25ce9124374e6917260;hp=7bc3f907c3ad6afb324aca1408bec44459b5062a;hb=7281b0c1eefce213d11cada1cb9f86a2d8fb0779;hpb=5df4e85a21e1577f0589e5ca2907157ec4e4e392

diff --git a/parser.scm b/parser.scm
index 7bc3f90..c112cf9 100644
--- a/parser.scm
+++ b/parser.scm
@@ -15,7 +15,7 @@
           (newline-irx (irregex "^\n"))
           (comma-irx (irregex "^,"))
           (period-irx (irregex "^\\."))
-          (redcode-irx (irregex "^;redcode\n"))
+          (redcode-irx (irregex "^;redcode.*\n"))
           (name-start-irx (irregex "^;[ \t]*name "))
           (name-irx (irregex "^[^\n]*"))
           (author-start-irx (irregex "^;[ \t]*author "))
@@ -56,6 +56,7 @@
           (mode-post-indirect-A-irx (irregex "^\\}"))
           (mode-post-indirect-B-irx (irregex "^>"))
           (number-irx (irregex "^(\\+|-)?[0-9]+")))
+
       (define (accept-token irx . rest)
         (let ((wsmatch (irregex-search whitespace-irx (substring str idx))))
           (if wsmatch
@@ -69,6 +70,7 @@
               (if mandatory
                   (error "Unexpected token at input string index" idx)
                   #f))))
+
       (define (load-file)
         (accept-token redcode-irx #t)
         (let loop ((instrs '())
@@ -84,28 +86,34 @@
                   ((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-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)
             '(comment)
             #f))
+
       (define (org-line)
         (if (accept-token org-irx)
             (cons 'org (string->number (accept-token number-irx #t)))
             #f))
+
       (define (instruction-line)
         (let ((oc (opcode)))
           (if oc
@@ -119,6 +127,7 @@
                     (z (accept-token comment-irx #t)))
                 (cons 'instr (make-instr oc modif A-mode A-num B-mode B-num)))
               #f)))
+
       (define (opcode)
         (let ((res (or (accept-token opcode-DAT-irx)
                        (accept-token opcode-MOV-irx)
@@ -138,6 +147,7 @@
                        (accept-token opcode-SPL-irx)
                        (accept-token opcode-NOP-irx))))
           (if res (string->symbol res) #f)))
+
       (define (modifier)
         (string->symbol
          (or (accept-token modifier-AB-irx)
@@ -147,6 +157,7 @@
              (accept-token modifier-F-irx)
              (accept-token modifier-X-irx)
              (accept-token modifier-I-irx))))
+
       (define (mode)
         (or (mode-immediate)
             (mode-direct)
@@ -156,28 +167,37 @@
             (mode-pre-indirect-B)
             (mode-post-indirect-A)
             (mode-post-indirect-B)))
+
       (define (mode-immediate)
         (and (accept-token mode-immediate-irx)
              'immediate))
+
       (define (mode-direct)
         (and (accept-token mode-direct-irx)
              'direct))
+
       (define (mode-indirect-A)
         (and (accept-token mode-indirect-A-irx)
              'indirect-A))
+
       (define (mode-indirect-B)
         (and (accept-token mode-indirect-B-irx)
              'indirect-B))
+
       (define (mode-pre-indirect-A)
         (and (accept-token mode-pre-indirect-A-irx)
              'pre-indirect-A))
+
       (define (mode-pre-indirect-B)
         (and (accept-token mode-pre-indirect-B-irx)
              'pre-indirect-B))
+
       (define (mode-post-indirect-A)
         (and (accept-token mode-post-indirect-A-irx)
              'post-indirect-A))
+
       (define (mode-post-indirect-B)
         (and (accept-token mode-post-indirect-B-irx)
              'post-indirect-B))
+
       (load-file))))