;;; -*-scheme-*-

;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; compiler.mes produces an i386 binary from the C produced by
;;; Nyacc c99.

;;; Code:

(cond-expand
 (guile-2
  (set-port-encoding! (current-output-port) "ISO-8859-1"))
 (guile)
 (mes
  (mes-use-module (nyacc lang c99 parser))
  (mes-use-module (mes elf-util))
  (mes-use-module (mes pmatch))
  (mes-use-module (mes elf))
  (mes-use-module (mes libc-i386))
  (mes-use-module (mes optargs))))

(define (logf port string . rest)
  (apply format (cons* port string rest))
  (force-output port)
  #t)

(define (stderr string . rest)
  (apply logf (cons* (current-error-port) string rest)))

(define (gnuc-xdef? name mode) (if (equal? name "__GNUC__") #f (eq? mode 'code)))

(define (mescc)
  (parse-c99
   #:inc-dirs (string-split (getenv "C_INCLUDE_PATH") #\:)
   #:cpp-defs '(
                ("__GNUC__" . "0")
                ("__NYACC__" . "1")
                ("VERSION" . "0.4")
                ("PREFIX" . "")
                )
   #:xdef? gnuc-xdef?
   #:mode 'code
   ))

(define (write-any x)
  (write-char (cond ((char? x) x)
                    ((and (number? x) (< (+ x 256) 0)) (format (current-error-port) "***BROKEN*** x=~a\n" x) (integer->char #xaa))
                    ((number? x) (integer->char (if (>= x 0) x (+ x 256))))
                    (else (stderr "write-any: ~a\n" x) barf))))

(define (ast:function? o)
  (and (pair? o) (eq? (car o) 'fctn-defn)))

(define (.name o)
  (pmatch o
    ((fctn-defn _ (ftn-declr (ident ,name) _) _) name)
    ((fctn-defn _ (ptr-declr (pointer) (ftn-declr (ident ,name) _)) _) name)
    ((param-decl _ (param-declr (ident ,name))) name)
    ((param-decl _ (param-declr (ptr-declr (pointer) (ident ,name)))) name)
    ((param-decl _ (param-declr (ptr-declr (pointer) (array-of (ident ,name))))) name)
    (_
     (format (current-error-port) "SKIP .name =~a\n" o))))

(define (.statements o)
  (pmatch o
    ((fctn-defn _ (ftn-declr (ident ,name) _) (compd-stmt (block-item-list . ,statements))) statements)
    ((fctn-defn _ (ptr-declr (pointer) (ftn-declr (ident ,name) _)) (compd-stmt (block-item-list . ,statements))) statements)))

(define <info> '<info>)
(define <functions> '<functions>)
(define <globals> '<globals>)
(define <locals> '<locals>)
(define <function> '<function>)
(define <text> '<text>)
(define* (make o #:key (functions '()) (globals '()) (locals '()) (function #f) (text '()))
  (pmatch o
    (<info> (list <info>
                  (cons <functions> functions)
                  (cons <globals> globals)
                  (cons <locals> locals)
                  (cons <function> function)
                  (cons <text> text)))))

(define (.functions o)
  (pmatch o
    ((<info> . ,alist) (assq-ref alist <functions>))))

(define (.globals o)
  (pmatch o
    ((<info> . ,alist) (assq-ref alist <globals>))))

(define (.locals o)
  (pmatch o
    ((<info> . ,alist) (assq-ref alist <locals>))))

(define (.function o)
  (pmatch o
    ((<info> . ,alist) (assq-ref alist <function>))))

(define (.text o)
  (pmatch o
    ((<info> . ,alist) (assq-ref alist <text>))))

(define (info? o)
  (and (pair? o) (eq? (car o) <info>)))

(define (clone o . rest)
  (cond ((info? o)
         (let ((functions (.functions o))
               (globals (.globals o))
               (locals (.locals o))
               (function (.function o))
               (text (.text o)))
           (let-keywords rest
                         #f
                         ((functions functions)
                          (globals globals)
                          (locals locals)
                          (function function)
                          (text text))
                         (make <info> #:functions functions #:globals globals #:locals locals #:function function #:text text))))))

(define (ref-local locals)
  (lambda (o)
    ;; (stderr "IDENT REF[~a]: ~a => ~a\n" o (assoc-ref locals o) (i386:ref-local (assoc-ref locals o)))
    (i386:ref-local (assoc-ref locals o))))

(define (ref-global globals)
  (lambda (o)
    (lambda (f g t d)
      (i386:ref-global (+ (data-offset o g;;lobals
                                       ) d)))))

(define (expr->arg globals locals) ;; FIXME: get Mes curried-definitions
  (lambda (o)
    (pmatch o
      ((p-expr (fixed ,value)) (string->number value))
      ((p-expr (string ,string)) ((ref-global globals) string))
      ((p-expr (ident ,name)) ((ref-local locals) name))

      ((array-ref (p-expr (fixed ,value)) (p-expr (ident ,name)))
       (let ((value (string->number value))
             (size 4)) ;; FIXME: type: int
         (lambda (f g t d)
           (append
            ((ident->base locals) name)
            (i386:value->accu (* size value)) ;; FIXME: type: int
            (i386:mem->accu) ;; FIXME: type: int
            (i386:push-accu) ;; hmm
            ))))

      (_
       (format (current-error-port) "SKIP expr->arg=~a\n" o)     
       0))))

(define (ident->accu locals)
  (lambda (o)
    (i386:local->accu (assoc-ref locals o))))

(define (accu->ident locals)
  (lambda (o)
    (i386:accu->local (assoc-ref locals o))))

(define (ident->base locals)
  (lambda (o)
    (i386:local->base (assoc-ref locals o))))

(define (expr->accu info)
  (lambda (o)
    (pmatch o
      ((p-expr (fixed ,value)) (string->number value))
      ((p-expr (ident ,name)) ((ident->accu (.locals info)) name))
      ((fctn-call . _) ((ast->info info) `(expr-stmt ,o)))
      ((sub . _) ((ast->info info) o)) ;; FIXME: expr-stmt
      (_
       (format (current-error-port) "SKIP expr->accu=~a\n" o)
       0)
      )))

(define (string->global string)
  (cons string (append (string->list string) (list #\nul))))

(define (expr->global o)
  (pmatch o
    ((p-expr (string ,string)) (string->global string))
    (_ #f)))

(define (dec->hex o)
  (number->string o 16))

(define (byte->hex o)
  (string->number (string-drop o 2) 16))

(define (asm->hex o)
  (let ((prefix ".byte "))
    (if (not (string-prefix? prefix o)) (begin (stderr "SKIP:~a\n" o)'())
        (let ((s (string-drop o (string-length prefix))))
          (map byte->hex (string-split s #\space))))))

(define (ast->info info)
  (lambda (o)
    (let ((globals (.globals info))
          (locals (.locals info))
          (text (.text info)))
      (define (add-local name)
         (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals))

      ;; (stderr "\nS=~a\n" o)
      ;; (stderr "  text=~a\n" text)
      ;; (stderr "   info=~a\n" info)
      ;; (stderr "   globals=~a\n" globals)
      (pmatch o
        (((trans-unit . _) . _) ((ast-list->info info) o))
        ((trans-unit . ,elements) ((ast-list->info info) elements))
        ((fctn-defn . _) ((function->info info) o))
        ((comment . _) info)
        ((cpp-stmt (define (name ,name) (repl ,value)))
         (stderr "SKIP: #define ~s ~s\n" name value)
         info)

        ((compd-stmt (block-item-list . ,statements)) ((ast-list->info info) statements))
        
        ((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))
         (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
                                   (clone info #:text (append text (list (lambda (f g t d) (asm->hex arg0))))))
             (let* ((globals (append globals (filter-map expr->global expr-list)))
                    (args (map (expr->arg globals locals) expr-list)))
               (clone info #:text
                      (append text (list (lambda (f g t d)
                                           (apply i386:call (cons* f g t d
                                                                   (+ t (function-offset name f)) args)))))
                      #:globals globals))))

        ((if ,test ,body)
         (let* ((jump (pmatch test
                        ((lt ,a ,b) i386:jump-nc)
                        ((gt ,a ,b) i386:jump-nc)
                        (_ i386:jump-z)))
                (jump-text (lambda (body-length)
                             (list (lambda (f g t d) (jump body-length)))))
                (test-info ((ast->info info) test))
                (test+jump-info (clone test-info #:text (append (.text test-info)
                                                                (jump-text 0))))
                (text-length (length (.text test+jump-info)))
                (body-info ((ast->info test+jump-info) body))
                (body-text (list-tail (.text body-info) text-length))
                (body-length (length (text->list body-text))))

           (clone info #:text
                  (append (.text test-info)
                          (jump-text body-length)
                          body-text)
                  #:globals (.globals body-info))))

        ((for ,init ,test ,step ,body)
         (let* ((jump (pmatch test
                        ((lt ,a ,b) i386:jump-c)
                        ((gt ,a ,b) i386:jump-c)
                        (_ i386:jump-nz)))
                (jump-text (lambda (body-length)
                             (list (lambda (f g t d) (jump body-length)))))

                (info (clone info #:text '()))

                (info ((ast->info info) init))

                (init-text (.text info))
                (init-locals (.locals info))
                (info (clone info #:text '()))

                (body-info ((ast->info info) body))
                (body-text (.text body-info))
                (body-length (length (text->list body-text)))

                (step-info ((ast->info info) `(expr-stmt ,step)))
                (step-text (.text step-info))
                (step-length (length (text->list step-text)))

                (test-info ((ast->info info) test))
                (test-text (.text test-info))
                (test-length (length (text->list test-text))))

           (clone info #:text
                  (append text
                          init-text
                          (list (lambda (f g t d) (i386:jump (+ 2 body-length)))) ;; FIXME: 2
                          body-text
                          step-text
                          test-text
                          (jump-text (- (+ body-length step-length test-length))))
                  #:globals (append globals (.globals body-info)) ;; FIXME
                  #:locals locals)))

        ((while ,test ,body)
         (let* ((jump (pmatch test
                        ((lt ,a ,b) i386:jump-c)
                        ((gt ,a ,b) i386:jump-c)
                        ;;(_ i386:jump-nz)
                        (_ i386:jump-byte-nz) ;; FIXME
                        ))
                (jump-text (lambda (body-length)
                             (list (lambda (f g t d) (jump body-length)))))

                (info (clone info #:text '()))
                (body-info ((ast->info info) body))
                (body-text (.text body-info))
                (body-length (length (text->list body-text)))

                (test-info ((ast->info info) test))
                (test-text (.text test-info))
                (test-length (length (text->list test-text))))

           (clone info #:text
                  (append text
                          (list (lambda (f g t d) (i386:jump (+ 2 body-length)))) ;; FIXME: 2
                          body-text
                          test-text
                          (jump-text (- (+ body-length test-length))))
                  #:globals (.globals body-info))))

        ((labeled-stmt (ident ,label) ,statement)
         (let ((info (clone info #:text (append text (list label)))))
           ((ast->info info) statement)))

        ((goto (ident ,label))
         (let ((offset (length (text->list text))))
           (clone info #:text
                  (append text
                          (list (lambda (f g t d)
                                  (i386:jump (- (label-offset (.function info) label f) offset))))))))

        ((p-expr (ident ,name))
         (clone info #:text
                (append text
                        (list (lambda (f g t d)
                                (append
                                 (i386:local->accu (assoc-ref locals name))
                                 (i386:accu-zero?)))))))

        ((p-expr (fixed ,value))
         (let ((value (string->number value)))
          (clone info #:text
                 (append text
                         (list (lambda (f g t d)
                                 (append (i386:value->accu value)
                                         (i386:accu-zero?))))))))

        ((de-ref (p-expr (ident ,name)))
         (clone info #:text
                (append text
                        (list (lambda (f g t d)
                                (append (i386:local->accu (assoc-ref locals name))
                                        (i386:byte-mem->accu)))))))

        ((fctn-call . ,call)
         (let ((info ((ast->info info) `(expr-stmt ,o))))
           (clone info #:text
                  (append (.text info)
                          (list (lambda (f g t d)
                                  (i386:accu-zero?)))))))

        ;; i++
        ((expr-stmt (post-inc (p-expr (ident ,name))))
         (clone info #:text
                (append text (list (lambda (f g t d)
                                     (i386:local-add (assoc-ref locals name) 1))))))

        ;; ++i -- same for now FIXME
        ((expr-stmt (pre-inc (p-expr (ident ,name))))
         (clone info #:text
                (append text (list (lambda (f g t d)
                                     (i386:local-add (assoc-ref locals name) 1))))))

        ((not ,expr)
         (let* ((test-info ((ast->info info) expr)))
           (clone info #:text
                  (append (.text test-info)
                          (list (lambda (f g t d)
                                  (i386:xor-zf))))
                  #:globals (.globals test-info))))

        ((and ,a ,b)
         (let* ((info (clone info #:text '()))
                (a-info ((ast->info info) a))
                (a-text (.text a-info))
                (a-length (length (text->list a-text)))

                (b-info ((ast->info info) b))
                (b-text (.text b-info))
                (b-length (length (text->list b-text))))

           (clone info #:text
                  (append text
                          a-text
                          (list (lambda (f g t d) (i386:jump-byte-z (+ b-length
                                                                       2))))  ;; FIXME: need jump after last test
                          b-text))))

        ;; FIXME and, gt
        ((eq (de-ref (p-expr (ident ,a))) (de-ref (p-expr (ident ,b))))
           (clone info #:text
                  (append text
                          (list (lambda (f g t d)
                                  (append
                                   (append (i386:local->accu (assoc-ref locals a))
                                           (i386:byte-mem->base)
                                           (i386:local->accu (assoc-ref locals b))
                                           (i386:byte-mem->accu)
                                           (i386:byte-test-base))))))))

        ((gt (p-expr (ident ,a)) (p-expr (fixed ,b)))
         ;; (stderr "GT: ~a > ~a\n" a b)
         (let ((b (string->number b)))
           (clone info #:text
                  (append text
                          (list (lambda (f g t d)
                                  (append 
                                   (i386:local->base (assoc-ref locals a))
                                   (i386:value->accu b)
                                   (i386:sub-base))))))))

        
        ((eq (p-expr (ident ,a)) (p-expr (fixed ,b)))
         ;;(stderr "EQ: ~a > ~a\n" a b)
         (let ((b (string->number b)))
           (clone info #:text
                  (append text
                          (list (lambda (f g t d)
                                  (append 
                                   (i386:local->base (assoc-ref locals a))
                                   (i386:value->accu b)
                                   (i386:sub-base)
                                   (i386:xor-zf))))))))

        
        ((ne (p-expr (ident ,a)) (p-expr (fixed ,b)))
         ;;(stderr "NE: ~a > ~a\n" a b)
         (let ((b (string->number b)))
           (clone info #:text
                  (append text
                          (list (lambda (f g t d)
                                  (append 
                                   (i386:local->base (assoc-ref locals a))
                                   (i386:value->accu b)
                                   (i386:sub-base))))))))
        
        ((lt (p-expr (ident ,a)) (p-expr (fixed ,b)))
         ;;(stderr "LT: ~a < ~a\n" a b)
         (let ((b (string->number b)))
           (clone info #:text
                  (append text
                          (list (lambda (f g t d)
                                  (append 
                                   (i386:local->base (assoc-ref locals a))
                                   (i386:value->accu b)
                                   (i386:base-sub))))))))

        ((sub (de-ref (p-expr (ident ,a))) (de-ref (p-expr (ident ,b))))
         (clone info #:text
                (append text
                        (list (lambda (f g t d)
                                (append (i386:local->accu (assoc-ref locals a))
                                        (i386:byte-mem->base)
                                        (i386:local->accu (assoc-ref locals b))
                                        (i386:byte-mem->accu)
                                        (i386:byte-sub-base)))))))

        ((array-ref (p-expr (fixed ,value)) (p-expr (ident ,name)))
         (let ((value (string->number value)))
           (clone info #:text
                  (append text (list (lambda (f g t d)
                                       (append
                                        ((ident->base locals) name)
                                        (i386:value->accu value)
                                        (i386:byte-mem->accu)))))))) ; FIXME: type: char
        
        ((array-ref (p-expr (ident ,name)) (p-expr (ident ,index)))
         (clone info #:text
                (append text (list (lambda (f g t d)
                                     (append
                                      ((ident->base locals) name)
                                      ((ident->accu locals) index)
                                      (i386:byte-mem->accu))))))) ; FIXME: type: char
        
        ((return ,expr)
         (let ((accu ((expr->accu info) expr)))
           (if (info? accu)
               (clone accu #:text
                      (append (.text accu) (list (i386:ret (lambda _ '())))))
               (clone info #:text
                      (append text (list (i386:ret ((expr->accu info) expr))))))))

        ;; int i;
        ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name))))
         (clone info #:locals (add-local name)))

        ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (fixed ,value))))))
         (let ((locals (add-local name)))
           (let ((value (string->number value)))
             (clone info #:text
                    (append text (list (lambda (f g t d)
                                       (i386:local-assign (assoc-ref locals name) value))))
                  #:locals locals))))

        ;; int i = argc;
        ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local))))))
         (let ((locals (add-local name)))
          (clone info #:text
                 (append text (list (lambda (f g t d)
                                      (append
                                       ((ident->accu locals) local)
                                       ((accu->ident locals) name)))))
                 #:locals locals)))

        ;; SCM i = argc;
        ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local))))))
         (let ((locals (add-local name)))
           (clone info #:text
                (append text (list (lambda (f g t d)
                                     (append
                                      ((ident->accu locals) local)
                                      ((accu->ident locals) name)))))
                #:locals locals)))
        
        ;; int i = f ();
        ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (fctn-call . ,call)))))
         (let* ((locals (add-local name))
                (info (clone info #:locals locals)))
           (let ((info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
             (clone info
                    #:text
                    (append (.text info)
                            (list (lambda (f g t d)
                                    (i386:ret-local (assoc-ref locals name)))))
                    #:locals locals))))
        
        ;; i = 0;
        ((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (p-expr (fixed ,value))))
         ;;(stderr "RET LOCAL[~a]: ~a\n" name (assoc-ref locals name))
         (let ((value (string->number value)))
           (clone info #:text (append text (list (lambda (f g t d) (i386:local-assign (assoc-ref locals name) value)))))))

        ;; i = 0; ...from for init FIXME
        ((assn-expr (p-expr (ident ,name)) (op _) (p-expr (fixed ,value)))
         (let ((value (string->number value)))
           (clone info #:text (append text (list (lambda (f g t d) (i386:local-assign (assoc-ref locals name) value)))))))
        
        ((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (fctn-call . ,call)))
         (let* ((info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
           (clone info #:text (append (.text info) (list (lambda (f g t d) (i386:ret-local (assoc-ref locals name))))))))

        (_
         (format (current-error-port) "SKIP statement=~s\n" o)
         info)))))

(define (info->exe info)
  (display "dumping elf\n" (current-error-port))
  (map write-any (make-elf (.functions info) (.globals info))))

(define (.formals o)
  (pmatch o
    ((fctn-defn _ (ftn-declr _ ,formals) _) formals)
    ((fctn-defn _ (ptr-declr (pointer) (ftn-declr _ ,formals)) _) formals)
    (_ (format (current-error-port) ".formals: no match: ~a\n" o)
       barf)))

(define (formal->text n)
  (lambda (o i)
    ;;(i386:formal i n)
    '()
    ))

(define (formals->text o)
  (pmatch o
    ((param-list . ,formals)
     (let ((n (length formals)))
       (list (lambda (f g t d)
               (append
                (i386:function-preamble)
                (append-map (formal->text n) formals (iota n))
                (i386:function-locals))))))
    (_ (format (current-error-port) "formals->text: no match: ~a\n" o)
       barf)))

(define (formals->locals o)
  (pmatch o
    ((param-list . ,formals)
     (let ((n (length formals)))
       ;;(stderr "FORMALS: ~a ==> ~a\n" formals n)
       (map cons (map .name formals) (iota n -2 -1))))
    (_ (format (current-error-port) "formals->info: no match: ~a\n" o)
       barf)))

(define (function->info info)
  (lambda (o)
    ;;(stderr "\n")
    ;;(stderr "formals=~a\n" (.formals o))
    (let* ((name (.name o))
           (text (formals->text (.formals o)))
           (locals (formals->locals (.formals o))))
      (format (current-error-port) "compiling ~a\n" name)
      ;;(stderr "locals=~a\n" locals)
      (let loop ((statements (.statements o))
                 (info (clone info #:locals locals #:function name #:text text)))
        (if (null? statements) (clone info
                                      #:function #f
                                      #:functions (append (.functions info) (list (cons (.name o) (.text info)))))
            (let* ((statement (car statements)))
              (loop (cdr statements)
                    ((ast->info info) (car statements)))))))))

(define (ast-list->info info)
  (lambda (elements)
    (let loop ((elements elements) (info info))
      (if (null? elements) info
          (loop (cdr elements) ((ast->info info) (car elements)))))))

(define _start
  (let* ((argc-argv
          (string-append ".byte"
                         " 0x89 0xe8"      ; mov    %ebp,%eax
                         " 0x83 0xc0 0x08" ; add    $0x8,%eax
                         " 0x50"           ; push   %eax
                         " 0x89 0xe8"      ; mov    %ebp,%eax
                         " 0x83 0xc0 0x04" ; add    $0x4,%eax
                         " 0x0f 0xb6 0x00" ; movzbl (%eax),%eax
                         " 0x50"           ; push   %eax
                         ))
         (ast (with-input-from-string
                  
                  (string-append "int _start () {int i;asm(\"" argc-argv "\");i=main ();exit (i);}")
                parse-c99)))
    ast))

(define strlen
  (let* ((ast (with-input-from-string
                  "
int
strlen (char const* s)
{
  int i = 0;
  while (s[i]) i++;
  return i;
}
"
;;paredit:"
                parse-c99)))
    ast))

(define eputs
  (let* ((ast (with-input-from-string
                  "
int
eputs (char const* s)
{
  //write (STDERR, s, strlen (s));
  //write (2, s, strlen (s));
  int i = strlen (s);
  write (2, s, i);
  return 0;
}
"
;;paredit:"
                parse-c99)))
    ast))

(define fputs
  (let* ((ast (with-input-from-string
                  "
int
fputs (char const* s, int fd)
{
 int i = strlen (s);
  write (fd, s, i);
  return 0;
}
"
;;paredit:"
                parse-c99)))
    ast))

(define puts
  (let* ((ast (with-input-from-string
                  "
int
puts (char const* s)
{
  //write (STDOUT, s, strlen (s));
  //int i = write (STDOUT, s, strlen (s));
  int i = strlen (s);
  write (1, s, i);
  return 0;
}
"
;;paredit:"
                parse-c99)))
    ast))

(define strcmp
  (let* ((ast (with-input-from-string
                  "
int
strcmp (char const* a, char const* b)
{
  while (*a && *b && *a == *b) 
    {
      a++;b++;
    }
  return *a - *b;
}
"
;;paredit:"
                parse-c99)))
    ast))

(define i386:libc
  (list
   (cons "exit" (list i386:exit))
   (cons "write" (list i386:write))))

(define libc
  (list
   strlen
   eputs
   fputs
   puts
   strcmp))

(define (compile)
  (let* ((ast (mescc))
         (info (make <info> #:functions i386:libc))
         (info ((ast->info info) libc))
         (info ((ast->info info) ast))
         (info ((ast->info info) _start)))
    (info->exe info)))