mescc: Support continue in while.
[mes.git] / module / language / c99 / compiler.mes
index ee80387d48186255ffc0ecca5816414eb6ce40fa..9a2e120bc02930963f0e56295d6d700d95b6467c 100644 (file)
 (define <function> '<function>)
 (define <text> '<text>)
 (define <break> '<break>)
+(define <continue> '<continue>)
 
-(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (function #f) (text '()) (break '()))
+(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (function #f) (text '()) (break '()) (continue '()))
   (pmatch o
     (<info> (list <info>
                   (cons <types> types)
                   (cons <locals> locals)
                   (cons <function> function)
                   (cons <text> text)
-                  (cons <break> break)))))
+                  (cons <break> break)
+                  (cons <continue> continue)))))
 
 (define (.types o)
   (pmatch o
   (pmatch o
     ((<info> . ,alist) (assq-ref alist <break>))))
 
+(define (.continue o)
+  (pmatch o
+    ((<info> . ,alist) (assq-ref alist <continue>))))
+
 (define (info? o)
   (and (pair? o) (eq? (car o) <info>)))
 
                (locals (.locals o))
                (function (.function o))
                (text (.text o))
-               (break (.break o)))
+               (break (.break o))
+               (continue (.continue o)))
            (let-keywords rest
                          #f
                          ((types types)
                           (locals locals)
                           (function function)
                           (text text)
-                          (break break))
-                         (make <info> #:types types #:constants constants #:functions functions #:globals globals  #:locals locals #:function function #:text text #:break break))))))
+                          (break break)
+                          (continue continue))
+                         (make <info> #:types types #:constants constants #:functions functions #:globals globals  #:locals locals #:function function #:text text #:break break #:continue continue))))))
 
 (define (push-global globals)
   (lambda (o)
                (append-text info (wrap-as (i386:Xjump (- label (length (object->list text))))));;REMOVEME
                (append-text info (wrap-as (i386:jump-label `(#:local ,label)))))))
 
+        ((continue)
+         (append-text info (wrap-as (i386:jump-label `(#:local ,(car (.continue info)))))))
+
         ;; FIXME: expr-stmt wrapper?
         (trans-unit info)
         ((expr-stmt) info)
          (let* ((source (with-output-to-string (lambda () (pretty-print-c99 `(while ,test (ellipsis))))))
                 (info (append-text info (wrap-as `(#:comment ,source))))
                 (here (number->string (length text)))
-                (while-label (string-append (.function info) "_while_" here))
-                (skip-label (string-append (.function info) "_skip_" here))
+                (loop-label (string-append (.function info) "_loop_" here))
+                (continue-label (string-append (.function info) "_continue_" here))
                 (break-label (string-append (.function info) "_break_" here))
-                (info (append-text info (wrap-as (i386:jump-label `(#:local ,skip-label)))))
+                (info (append-text info (wrap-as (i386:jump-label `(#:local ,continue-label)))))
                 (info (clone info #:break (cons break-label (.break info))))
-                (info (append-text info (wrap-as `(#:label ,while-label))))
+                (info (clone info #:continue (cons continue-label (.continue info))))
+                (info (append-text info (wrap-as `(#:label ,loop-label))))
                 (info ((ast->info info) body))
-                (info (append-text info (wrap-as `(#:label ,skip-label))))
+                (info (append-text info (wrap-as `(#:label ,continue-label))))
                 (info ((test-jump-label->info info break-label) test))
-                (info (append-text info (wrap-as (i386:jump-label `(#:local ,while-label)))))
+                (info (append-text info (wrap-as (i386:jump-label `(#:local ,loop-label)))))
                 (info (append-text info (wrap-as `(#:label ,break-label)))))
-           (clone info #:break (cdr (.break info)))))
+           (clone info
+                  #:locals locals
+                  #:break (cdr (.break info))
+                  #:continue (cdr (.continue info)))))
 
         ((do-while ,body ,test)
          (let* ((text-length (length text))