andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Revert "WIP: Nyacc hacks" 

This reverts commit 8225e30a6a.
This commit is contained in:
Jan (janneke) Nieuwenhuizen 2022-03-23 14:16:17 +01:00
parent 8225e30a6a
commit 0643b01b99
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
9 changed files with 43 additions and 206 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
mes/module/ice-9/pretty-print.scm
View File

@ -21,8 +21,8 @@
;;; Taken from GNU Guile
(define-module (ice-9 pretty-print)
;;#:use-module (ice-9 optargs)
#:export (pretty-print))
:use-module (ice-9 optargs)
:export (pretty-print))
;; From SLIB.

113
mes/module/mes/guile.mes
View File

@ -62,116 +62,3 @@
(define (port-filename p) "<stdin>")
(define (port-line p) 0)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Hacks for Nyacc with modules
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Strings/srfi-13
(define reverse-list->string (compose list->string reverse))
(define string-null? (compose null? string->list))
;;; Char-sets/srfi-14
;; FIXME: have structs
(define (char-set . x)
(cons '*char-set* x))
(define char-set:whitespace (char-set #\tab #\page #\return #\vtab #\newline #\space))
(define (string->char-set x . base)
(apply char-set (append (string->list x) (if (null? base) '() (cdar base)))))
(define (string->char-set! x base)
(set-cdr! (last-pair base) (string->list x))
base)
(define (char-set-copy cs)
(map identity cs))
(define (list->char-set lst)
(apply char-set lst))
;;; ice-9 optargs/macros
(define (rest-arg->keyword-binding-list rest-arg keywords allow-other-keys?)
(if (null? rest-arg)
'()
(let loop ((first (car rest-arg))
(rest (cdr rest-arg))
(accum '()))
(let ((next (lambda (a)
(if (null? (cdr rest))
a
(loop (cadr rest) (cddr rest) a)))))
(if (keyword? first)
(cond
((memq first keywords)
(if (null? rest)
(error "Keyword argument has no value:" first)
(next (cons (cons (keyword->symbol first)
(car rest)) accum))))
((not allow-other-keys?)
(error "Unknown keyword in arguments:" first))
(else (if (null? rest)
accum
(next accum))))
(if (null? rest)
accum
(loop (car rest) (cdr rest) accum)))))))
;; (define (make-ident-like-p . rest)
;; (warn "fubar: make-ident-like-p" rest))
;; (define (make-comm-reader . rest)
;; (warn "fubar: make-comm-reader" rest))
;; (define (make-lexer-generator . rest)
;; (warn "fubar: make-lexer-generator" rest))
;; (define (move-attributes . rest)
;; (warn "fubar: move-attributes" rest))
;; (define (read-c-ident . rest)
;; (warn "fubar: read-c-ident" rest))
;; (define (filter-mt . rest)
;; (warn "fubar: filter-mt" rest))
;; (define (map-mt . rest)
;; (warn "fubar: map-mt" rest))
;; (define (remove-mt . rest)
;; (warn "fubar: remove-mt" rest))
;; (define (make-chseq-reader . rest)
;; (warn "fubar: make-chseq-reader" rest))
;; (define (count-opt . rest)
;; (warn "fubar: count-opt" rest))
;; (define (read-c-chlit . rest)
;; (warn "fubar: read-c-chlit" rest))
;; (define (read-c-num . rest)
;; (warn "fubar: read-c-num" rest))
;; (define (make-lalr-parser . rest)
;; (warn "fubar: make-lalr-parser" "..."))
;; (define (c99-len-v . rest)
;; (warn "fubar: c99-len-v" rest))
;; (define (filter pred lst)
;; (let loop ((lst lst))
;; (if (null? lst) '()
;; (if (pred (car lst))
;; (cons (car lst) (loop (cdr lst)))
;; (loop (cdr lst))))))
;; (define (multi-opt option-name) (lambda (o) (and (eq? (car o) option-name) (cdr o))))
;; (define (count-opt options option-name)
;; (let ((lst (filter identity (map (multi-opt option-name) options))))
;; (and (pair? lst) (length lst))))

3
mes/module/mes/guile.scm
View File

@ -46,11 +46,10 @@
(define (with-input-from-file file thunk)
(let ((port (open-input-file file)))
(warn "opened" file "=>" port)
(if (= port -1)
(error 'no-such-file file)
(let* ((save (current-input-port))
(foo (warn 'poort (set-current-input-port port)))
(foo (set-current-input-port port))
(r (thunk)))
(set-current-input-port save)
r))))

14
mes/module/nyacc/lang/c99/parser.mes
View File

@ -22,13 +22,13 @@
;;; Code:
;; (mes-use-module (mes guile))
;; (mes-use-module (mes catch))
;; (mes-use-module (mes fluids))
;; (mes-use-module (mes pretty-print))
;; (mes-use-module (mes optargs))
;; (mes-use-module (srfi srfi-9))
;; (mes-use-module (sxml xpath))
(mes-use-module (mes guile))
(mes-use-module (mes catch))
(mes-use-module (mes fluids))
(mes-use-module (mes pretty-print))
(mes-use-module (mes optargs))
(mes-use-module (srfi srfi-9))
(mes-use-module (sxml xpath))
(mes-use-module (nyacc lex))
(mes-use-module (nyacc parse))

33
mes/module/srfi/srfi-9-struct.scm
View File

@ -20,26 +20,23 @@
;;; Commentary:
;;; srfi-9.scm - records, based on struct.
;;; srfi-9.mes - records, based on struct.
;;; Code:
;; FIXME: a second use-modules of srfi-9 gives STACK_FULL
;; (define-module (srfi srfi-9)
;; #:export (define-record-type
;; make-record-type
;; record-type?
;; struct-vtable
;; record-type-name
;; record-type-descriptor
;; record-type-fields
;; record-predicate
;; record?
;; record-constructor
;; record-accessor
;; record-modifier))
(define-module (srfi srfi-9))
(define-module (srfi srfi-9)
#:export (define-record-type
make-record-type
record-type?
struct-vtable
record-type-name
record-type-descriptor
record-type-fields
record-predicate
record?
record-constructor
record-accessor
record-modifier))
(define-macro (define-record-type name constructor+field-names predicate . fields)
(let ((type (make-record-type name (map car fields))))
@ -116,7 +113,7 @@
(define (record-accessor type field)
(let ((i (record-field-index type field)))
(lambda (o . field?)
(if (and #f (not (eq? (record-type-descriptor o) type))) (error "record accessor: record expected" type field o)
(if (not (eq? (record-type-descriptor o) type)) (error "record accessor: record expected" type field o)
(if (pair? field?) field
(struct-ref o i))))))

6
module/mescc/compile.scm
View File

@ -27,6 +27,7 @@
#:use-module (system base pmatch)
#:use-module (ice-9 optargs)
#:use-module (ice-9 pretty-print)
#:use-module (nyacc lang c99 pprint)
#:use-module (mes guile)
#:use-module (mes misc)
@ -40,11 +41,6 @@
c99-input->info
c99-input->object))
(cond-expand
(guile
(use-modules (nyacc lang c99 pprint)))
(mes))
(define mes? (pair? (current-module)))
(define mes-or-reproducible? #t)
(define (cc-amd? info) #f) ; use AMD calling convention?

4
module/mescc/i386/info.scm
View File

@ -25,9 +25,7 @@
(define-module (mescc i386 info)
#:use-module (mescc info)
#:use-module (mescc i386 as)
#:export (x86-info
i386:type-alist
i386:registers))
#:export (x86-info))
(define (x86-info)
(make <info> #:types i386:type-alist #:registers i386:registers #:instructions i386:instructions))

40
module/mescc/mescc.scm
View File

@ -22,37 +22,24 @@
#:use-module (mes misc)
#:use-module (mes guile)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
#:use-module (srfi srfi-26)
#:use-module (ice-9 pretty-print)
#:use-module (ice-9 getopt-long)
#:use-module (mescc info)
;; #:use-module (mescc armv4 info)
#:use-module (mescc armv4 info)
#:use-module (mescc i386 info)
;; #:use-module (mescc x86_64 info)
#:use-module (mescc x86_64 info)
#:use-module (mescc preprocess)
;;#:use-module (mescc foo-process)
;;#:use-module (mescc compile)
;;#:use-module (mescc M1)
#:use-module (mescc compile)
#:use-module (mescc M1)
#:export (count-opt
mescc:preprocess
mescc:get-host
mescc:compile
mescc:assemble
mescc:link
multi-opt
M1->hex2
replace-suffix
arch-get
arch-get-defines
c->info
c->ast
.E?
.c?
.s?))
multi-opt))
(define GUILE-with-output-to-file with-output-to-file)
(define (with-output-to-file file-name thunk)
@ -60,13 +47,11 @@
(GUILE-with-output-to-file file-name thunk)))
(define (mescc:preprocess options)
(warn "mescc:preprocess")
(let* ((pretty-print/write (string->symbol (option-ref options 'write (if guile? "pretty-print" "write"))))
(pretty-print/write (if (eq? pretty-print/write 'pretty-print) pretty-print write))
(files (option-ref options '() '("a.c")))
(input-file-name (car files))
(input-base (basename input-file-name))
(foo (warn "********************************"))
(ast-file-name (cond ((and (option-ref options 'preprocess #f)
(option-ref options 'output #f)))
(else (replace-suffix input-base ".E"))))
@ -75,30 +60,15 @@
(includes (reverse (filter-map (multi-opt 'include) options)))
(includes (cons (option-ref options 'includedir #f) includes))
(includes (cons dir includes))
(foo (warn "1111111111111111111111111111111111"))
(prefix (option-ref options 'prefix ""))
(machine (option-ref options 'machine "32"))
(arch (arch-get options))
(foo (warn "2222222222222222222222222222222222"))
(defines (append (arch-get-defines options) defines))
(foo (warn "3333333333333333333333333333333333"))
(verbose? (count-opt options 'verbose)))
(with-output-to-file ast-file-name
(lambda _ (for-each (cut c->ast prefix defines includes arch pretty-print/write verbose? <>) files)))))
(define (with-input-from-file file thunk)
(let ((port (open-input-file file)))
(warn "opened" file "=>" port)
(if (= port -1)
(error 'no-such-file file)
(let* ((save (current-input-port))
(foo (warn 'poort (set-current-input-port port)))
(r (thunk)))
(set-current-input-port save)
r))))
(define (c->ast prefix defines includes arch write verbose? file-name)
(warn "c->ast")
(with-input-from-file file-name
(cut write (c99-input->ast #:prefix prefix #:defines defines #:includes includes #:arch arch #:verbose? verbose?))))

32
module/mescc/preprocess.scm
View File

@ -21,22 +21,16 @@
;;; Code:
(define-module (mescc preprocess)
#:use-module (mes guile)
#:use-module (ice-9 optargs)
#:use-module (system base pmatch)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (nyacc lang c99 paars)
;;#:use-module (nyacc lang c99 parser)
;;#:use-module (nyacc version)
#:export (c99-input->ast
c99-input->full-ast
#:use-module (nyacc lang c99 parser)
#:use-module (nyacc lang c99 parser)
#:use-module (nyacc version)
#:use-module (mes guile)
#:export (c99-input->ast))
ast-strip-attributes
ast-strip-const
ast-strip-comment))
(define *nyacc-version* "1.0.1")
(define mes-or-reproducible? #t)
(when (getenv "MESC_DEBUG")
@ -68,12 +62,12 @@
(apply (vector-ref act-v ix) args))))
(loop (1+ ix))))))
;; (cond-expand
;; (guile
;; (insert-progress-monitors (@@ (nyacc lang c99 parser) c99-act-v)
;; (@@ (nyacc lang c99 parser) c99-len-v)))
;; (mes
;; (insert-progress-monitors c99-act-v c99-len-v)))
(cond-expand
(guile
(insert-progress-monitors (@@ (nyacc lang c99 parser) c99-act-v)
(@@ (nyacc lang c99 parser) c99-len-v)))
(mes
(insert-progress-monitors c99-act-v c99-len-v)))
(define* (c99-input->full-ast #:key (prefix "") (defines '()) (includes '()) (arch "") verbose?)
(let* ((sys-include (if (equal? prefix "") "include"
@ -100,18 +94,14 @@
(when (and verbose? (> verbose? 1))
(format (current-error-port) "includes: ~s\n" includes)
(format (current-error-port) "defines: ~s\n" defines))
(warn "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@" "gonna parse")
(parse-c99
#:inc-dirs includes
#:cpp-defs defines
#:mode 'code)))
(define* (c99-input->ast #:key (prefix "") (defines '()) (includes '()) (arch "") verbose?)
(warn "hiero" "c99-input->ast")
(when verbose?
(warn "1111")
(format (current-error-port) "parsing: input\n"))
(warn "2222")
((compose ast-strip-attributes
ast-strip-const
ast-strip-comment)