artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mescc: cleanups.

Browse source 
* guile/mescc.scm: Cleanups.
* module/language/c99/compiler.mes:
* module/language/c99/compiler.scm:
* module/language/c99/info.mes:
* module/language/c99/info.scm:
* module/mes/getopt-long.mes:
* module/mes/optargs.mes:
* module/mes/optargs.scm:
* module/mes/repl.mes:
* module/mes/scm.mes:
* scripts/mescc.mes:
This commit is contained in:
Jan Nieuwenhuizen 2018-01-02 21:35:55 +01:00
parent 5757ef3069
commit 1f8a217694
11 changed files with 40 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
guile/mescc.scm
View file

@ -88,9 +88,7 @@ Usage: mescc.scm [OPTION]... FILE...
(define (main:ast->info file)
(let ((ast (with-input-from-file file read)))
(with-input-from-file file
(lambda ()
(c99-ast->info ast)))))
(c99-ast->info ast)))
(define (source->ast defines includes)
(lambda (file)

20
module/language/c99/compiler.mes
View file

@ -1,7 +1,7 @@
;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
@ -63,9 +63,9 @@
(define mes? (pair? (current-module)))
(define* (c99-input->full-ast #:key (defines '()) (includes '()))
(let ((include (if (equal? %prefix "") "include" (string-append %prefix "/share/include"))))
(let ((sys-include (if (equal? %prefix "") "include" (string-append %prefix "/share/include"))))
(parse-c99
#:inc-dirs (append includes (cons* include "include" "lib" (or (and=> (getenv "C_INCLUDE_PATH") (cut string-split <> #\:)) '())))
#:inc-dirs (append includes (cons* sys-include "include" "lib" (or (and=> (getenv "C_INCLUDE_PATH") (cut string-split <> #\:)) '())))
#:cpp-defs `(
"NULL=0"
"__linux__=1"
@ -105,9 +105,6 @@
(cons (ast-strip-const h) (ast-strip-const t))))
(_ o)))
(define* (c99-input->ast #:key (defines '()) (includes '()))
((compose ast-strip-const ast-strip-comment) (c99-input->full-ast #:defines defines #:includes includes)))
(define (ast:function? o)
(and (pair? o) (eq? (car o) 'fctn-defn)))
@ -2434,12 +2431,20 @@
(loop (cdr statements)
((ast->info info) (car statements)))))))))
;; exports
(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* (c99-ast->info ast)
((ast->info (make <info> #:types i386:type-alist)) ast))
(define* (c99-input->ast #:key (defines '()) (includes '()))
((compose ast-strip-const ast-strip-comment) (c99-input->full-ast #:defines defines #:includes includes)))
(define* (c99-input->info #:key (defines '()) (includes '()))
(lambda ()
(let* ((info (make <info> #:types i386:type-alist))
@ -2454,9 +2459,6 @@
`((functions . ,(.functions o))
(globals . ,(map (lambda (g) (cons (car g) (global:value (cdr g)))) (.globals o)))))
(define* (c99-ast->info ast)
((ast->info (make <info> #:types i386:type-alist)) ast))
(define* (c99-input->elf #:key (defines '()) (includes '()))
((compose object->elf info->object (c99-input->info #:defines defines #:includes includes))))

1
module/language/c99/compiler.scm
View file

@ -41,7 +41,6 @@
c99-input->elf
c99-input->info
c99-input->object
clone
info->object))
(cond-expand

4
module/language/c99/info.mes
View file

@ -23,6 +23,8 @@
;;; Code:
(mes-use-module (srfi srfi-9))
(define define-immutable-record-type define-record-type)
(define-macro (define-immutable-record-type type constructor+params predicate . fields)
`(define-record-type ,type ,constructor+params ,predicate ,@fields))
(include-from-path "language/c99/info.scm")

4
module/language/c99/info.scm
View file

@ -26,7 +26,6 @@
#:use-module (ice-9 optargs)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
#:use-module (system base pmatch)
#:export (<info>
make
make-<info>
@ -66,8 +65,7 @@
(guile
(use-modules (ice-9 syncase)))
(mes
(mes-use-module (mes optargs))
(mes-use-module (mes pmatch))))
(mes-use-module (mes optargs))))
(define-immutable-record-type <info>
(make-<info> types constants functions globals locals function text break continue)

8
module/mes/getopt-long.mes
View file

@ -1,7 +1,7 @@
;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
@ -20,10 +20,10 @@
;;; Commentary:
;;; portable matcher
;;; Code:
(mes-use-module (mes syntax))
(mes-use-module (srfi srfi-1))
(mes-use-module (srfi srfi-9))
(mes-use-module (mes guile))
(mes-use-module (srfi srfi-13))
(define-macro (define-module module . rest) #t)
(include-from-path "mes/getopt-long.scm")

3
module/mes/optargs.mes
View file

@ -1,7 +1,7 @@
;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016,2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
@ -32,4 +32,5 @@
(define-macro (set-procedure-property! proc key value)
proc)
(define-macro (define-module module . rest) #t)
(include-from-path "mes/optargs.scm")

22
module/mes/optargs.scm
View file

@ -57,17 +57,17 @@
;;; Code:
;; (define-module (ice-9 optargs)
;; #:use-module (system base pmatch)
;; #:replace (lambda*)
;; #:export-syntax (let-optional
;; let-optional*
;; let-keywords
;; let-keywords*
;; define*
;; define*-public
;; defmacro*
;; defmacro*-public))
(define-module (ice-9 optargs)
#:use-module (system base pmatch)
#:replace (lambda*)
#:export-syntax (let-optional
let-optional*
let-keywords
let-keywords*
define*
define*-public
defmacro*
defmacro*-public))
;; let-optional rest-arg (binding ...) . body
;; let-optional* rest-arg (binding ...) . body

4
module/mes/repl.mes
View file

@ -28,7 +28,7 @@
(define welcome
(string-append "Mes " %version "
Copyright (C) 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
Copyright (C) 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
Mes comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
@ -165,7 +165,7 @@ along with Mes. If not, see <http://www.gnu.org/licenses/>.
(set! count (+ count 1))
(display id)
(display " = ")
(display e)
(write e)
(newline)
(loop (acons id e a)))))))))
(lambda (key . args)

5
module/mes/scm.mes
View file

@ -1,7 +1,7 @@
;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Mes.
;;;
@ -209,6 +209,9 @@
;;; Strings/srfi-13
(define (make-string n . fill)
(list->string (apply make-list n fill)))
(define (string-length s)
(length (string->list s)))

4
scripts/mescc.mes
View file

@ -101,9 +101,7 @@ Usage: mescc.mes [OPTION]... FILE...
(define (main:ast->info file)
(let ((ast (with-input-from-file file read)))
(with-input-from-file file
(lambda ()
(c99-ast->info ast)))))
(c99-ast->info ast)))
(define (source->ast defines includes)
(lambda (file)