From 1f8a217694ae44bab08bfeb55d3ee073b054b21f Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Tue, 2 Jan 2018 21:35:55 +0100 Subject: [PATCH] mescc: cleanups. * 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: --- guile/mescc.scm | 4 +--- module/language/c99/compiler.mes | 20 +++++++++++--------- module/language/c99/compiler.scm | 1 - module/language/c99/info.mes | 4 +++- module/language/c99/info.scm | 4 +--- module/mes/getopt-long.mes | 8 ++++---- module/mes/optargs.mes | 3 ++- module/mes/optargs.scm | 22 +++++++++++----------- module/mes/repl.mes | 4 ++-- module/mes/scm.mes | 5 ++++- scripts/mescc.mes | 4 +--- 11 files changed, 40 insertions(+), 39 deletions(-) diff --git a/guile/mescc.scm b/guile/mescc.scm index bcdbd50b..5c5fcab8 100755 --- a/guile/mescc.scm +++ b/guile/mescc.scm @@ -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) diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index f07edbb6..d6338f33 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -1,7 +1,7 @@ ;;; -*-scheme-*- ;;; Mes --- Maxwell Equations of Software -;;; Copyright © 2016,2017 Jan Nieuwenhuizen +;;; Copyright © 2016,2017,2018 Jan Nieuwenhuizen ;;; ;;; 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 #: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 #: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 #:types i386:type-alist)) ast)) - (define* (c99-input->elf #:key (defines '()) (includes '())) ((compose object->elf info->object (c99-input->info #:defines defines #:includes includes)))) diff --git a/module/language/c99/compiler.scm b/module/language/c99/compiler.scm index a6750dfe..c7e8644e 100644 --- a/module/language/c99/compiler.scm +++ b/module/language/c99/compiler.scm @@ -41,7 +41,6 @@ c99-input->elf c99-input->info c99-input->object - clone info->object)) (cond-expand diff --git a/module/language/c99/info.mes b/module/language/c99/info.mes index faff2469..bb8e996a 100644 --- a/module/language/c99/info.mes +++ b/module/language/c99/info.mes @@ -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") + diff --git a/module/language/c99/info.scm b/module/language/c99/info.scm index 4bd49db4..9c001ee4 100644 --- a/module/language/c99/info.scm +++ b/module/language/c99/info.scm @@ -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 ( make make- @@ -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 (make- types constants functions globals locals function text break continue) diff --git a/module/mes/getopt-long.mes b/module/mes/getopt-long.mes index c5685fa5..8c5069b9 100644 --- a/module/mes/getopt-long.mes +++ b/module/mes/getopt-long.mes @@ -1,7 +1,7 @@ ;;; -*-scheme-*- ;;; Mes --- Maxwell Equations of Software -;;; Copyright © 2017 Jan Nieuwenhuizen +;;; Copyright © 2017,2018 Jan Nieuwenhuizen ;;; ;;; 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") diff --git a/module/mes/optargs.mes b/module/mes/optargs.mes index 7b67b609..b0d60dab 100644 --- a/module/mes/optargs.mes +++ b/module/mes/optargs.mes @@ -1,7 +1,7 @@ ;;; -*-scheme-*- ;;; Mes --- Maxwell Equations of Software -;;; Copyright © 2016 Jan Nieuwenhuizen +;;; Copyright © 2016,2018 Jan Nieuwenhuizen ;;; ;;; 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") diff --git a/module/mes/optargs.scm b/module/mes/optargs.scm index 3e3396ce..943e21fa 100644 --- a/module/mes/optargs.scm +++ b/module/mes/optargs.scm @@ -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 diff --git a/module/mes/repl.mes b/module/mes/repl.mes index 06bbb307..73112acf 100644 --- a/module/mes/repl.mes +++ b/module/mes/repl.mes @@ -28,7 +28,7 @@ (define welcome (string-append "Mes " %version " -Copyright (C) 2016,2017 Jan Nieuwenhuizen +Copyright (C) 2016,2017,2018 Jan Nieuwenhuizen 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 . (set! count (+ count 1)) (display id) (display " = ") - (display e) + (write e) (newline) (loop (acons id e a))))))))) (lambda (key . args) diff --git a/module/mes/scm.mes b/module/mes/scm.mes index 020c3949..78f5e137 100644 --- a/module/mes/scm.mes +++ b/module/mes/scm.mes @@ -1,7 +1,7 @@ ;;; -*-scheme-*- ;;; Mes --- Maxwell Equations of Software -;;; Copyright © 2016,2017 Jan Nieuwenhuizen +;;; Copyright © 2016,2017,2018 Jan Nieuwenhuizen ;;; ;;; 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))) diff --git a/scripts/mescc.mes b/scripts/mescc.mes index 09d9d57e..0a65ae3c 100755 --- a/scripts/mescc.mes +++ b/scripts/mescc.mes @@ -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)