parent
e7d2349ea0
commit
af8a8be4cb
|
@ -38,7 +38,7 @@ struct scm *acons (struct scm *key, struct scm *value, struct scm *alist);
|
||||||
struct scm *length (struct scm *x);
|
struct scm *length (struct scm *x);
|
||||||
struct scm *error (struct scm *key, struct scm *x);
|
struct scm *error (struct scm *key, struct scm *x);
|
||||||
struct scm *append2 (struct scm *x, struct scm *y);
|
struct scm *append2 (struct scm *x, struct scm *y);
|
||||||
struct scm *append_reverse_ (struct scm *x, struct scm *y);
|
struct scm *append_reverse (struct scm *x, struct scm *y);
|
||||||
struct scm *reverse_x_ (struct scm *x, struct scm *t);
|
struct scm *reverse_x_ (struct scm *x, struct scm *t);
|
||||||
struct scm *assq (struct scm *x, struct scm *a);
|
struct scm *assq (struct scm *x, struct scm *a);
|
||||||
struct scm *assoc (struct scm *x, struct scm *a);
|
struct scm *assoc (struct scm *x, struct scm *a);
|
||||||
|
|
|
@ -21,8 +21,8 @@
|
||||||
;;; Taken from GNU Guile
|
;;; Taken from GNU Guile
|
||||||
|
|
||||||
(define-module (ice-9 pretty-print)
|
(define-module (ice-9 pretty-print)
|
||||||
;;#:use-module (ice-9 optargs)
|
:use-module (ice-9 optargs)
|
||||||
#:export (pretty-print))
|
:export (pretty-print))
|
||||||
|
|
||||||
;; From SLIB.
|
;; From SLIB.
|
||||||
|
|
||||||
|
|
|
@ -181,7 +181,6 @@
|
||||||
(mes-use-module (srfi srfi-9))
|
(mes-use-module (srfi srfi-9))
|
||||||
(mes-use-module (mes syntax))
|
(mes-use-module (mes syntax))
|
||||||
(mes-use-module (mes boot-6))
|
(mes-use-module (mes boot-6))
|
||||||
(include-from-path "mes/guile.scm")
|
|
||||||
(use-modules (mes main))
|
(use-modules (mes main))
|
||||||
(top-main)
|
(top-main)
|
||||||
(primitive-load 0)
|
(primitive-load 0)
|
||||||
|
|
|
@ -62,116 +62,3 @@
|
||||||
|
|
||||||
(define (port-filename p) "<stdin>")
|
(define (port-filename p) "<stdin>")
|
||||||
(define (port-line p) 0)
|
(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))))
|
|
||||||
|
|
|
@ -46,11 +46,10 @@
|
||||||
|
|
||||||
(define (with-input-from-file file thunk)
|
(define (with-input-from-file file thunk)
|
||||||
(let ((port (open-input-file file)))
|
(let ((port (open-input-file file)))
|
||||||
(warn "opened" file "=>" port)
|
|
||||||
(if (= port -1)
|
(if (= port -1)
|
||||||
(error 'no-such-file file)
|
(error 'no-such-file file)
|
||||||
(let* ((save (current-input-port))
|
(let* ((save (current-input-port))
|
||||||
(foo (warn 'poort (set-current-input-port port)))
|
(foo (set-current-input-port port))
|
||||||
(r (thunk)))
|
(r (thunk)))
|
||||||
(set-current-input-port save)
|
(set-current-input-port save)
|
||||||
r))))
|
r))))
|
||||||
|
|
|
@ -26,7 +26,7 @@
|
||||||
(define S_IRWXU #o700)
|
(define S_IRWXU #o700)
|
||||||
|
|
||||||
(define (basename file-name . ext)
|
(define (basename file-name . ext)
|
||||||
(let ((base (car (last-pair (string-split file-name #\/))))
|
(let ((base (last (string-split file-name #\/)))
|
||||||
(ext (and (pair? ext) (car ext))))
|
(ext (and (pair? ext) (car ext))))
|
||||||
(if (and ext
|
(if (and ext
|
||||||
(string-suffix? ext base)) (string-drop-right base (string-length ext))
|
(string-suffix? ext base)) (string-drop-right base (string-length ext))
|
||||||
|
|
|
@ -22,13 +22,13 @@
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
;; (mes-use-module (mes guile))
|
(mes-use-module (mes guile))
|
||||||
;; (mes-use-module (mes catch))
|
(mes-use-module (mes catch))
|
||||||
;; (mes-use-module (mes fluids))
|
(mes-use-module (mes fluids))
|
||||||
;; (mes-use-module (mes pretty-print))
|
(mes-use-module (mes pretty-print))
|
||||||
;; (mes-use-module (mes optargs))
|
(mes-use-module (mes optargs))
|
||||||
;; (mes-use-module (srfi srfi-9))
|
(mes-use-module (srfi srfi-9))
|
||||||
;; (mes-use-module (sxml xpath))
|
(mes-use-module (sxml xpath))
|
||||||
|
|
||||||
(mes-use-module (nyacc lex))
|
(mes-use-module (nyacc lex))
|
||||||
(mes-use-module (nyacc parse))
|
(mes-use-module (nyacc parse))
|
||||||
|
|
|
@ -28,7 +28,6 @@
|
||||||
find
|
find
|
||||||
filter
|
filter
|
||||||
append-map
|
append-map
|
||||||
append-reverse
|
|
||||||
filter-map
|
filter-map
|
||||||
fold
|
fold
|
||||||
fold-right
|
fold-right
|
||||||
|
@ -41,7 +40,6 @@
|
||||||
iota
|
iota
|
||||||
srfi-1:iota
|
srfi-1:iota
|
||||||
delete-duplicates
|
delete-duplicates
|
||||||
last
|
|
||||||
any
|
any
|
||||||
any1
|
any1
|
||||||
every
|
every
|
||||||
|
@ -53,8 +51,6 @@
|
||||||
reverse!
|
reverse!
|
||||||
take-while))
|
take-while))
|
||||||
|
|
||||||
(define append-reverse core:append-reverse)
|
|
||||||
|
|
||||||
(define (drop-right lst n)
|
(define (drop-right lst n)
|
||||||
(list-head lst (- (length lst) n)))
|
(list-head lst (- (length lst) n)))
|
||||||
|
|
||||||
|
|
|
@ -20,26 +20,23 @@
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
|
|
||||||
;;; srfi-9.scm - records, based on struct.
|
;;; srfi-9.mes - records, based on struct.
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
;; FIXME: a second use-modules of srfi-9 gives STACK_FULL
|
(define-module (srfi srfi-9)
|
||||||
;; (define-module (srfi srfi-9)
|
#:export (define-record-type
|
||||||
;; #:export (define-record-type
|
make-record-type
|
||||||
;; make-record-type
|
record-type?
|
||||||
;; record-type?
|
struct-vtable
|
||||||
;; struct-vtable
|
record-type-name
|
||||||
;; record-type-name
|
record-type-descriptor
|
||||||
;; record-type-descriptor
|
record-type-fields
|
||||||
;; record-type-fields
|
record-predicate
|
||||||
;; record-predicate
|
record?
|
||||||
;; record?
|
record-constructor
|
||||||
;; record-constructor
|
record-accessor
|
||||||
;; record-accessor
|
record-modifier))
|
||||||
;; record-modifier))
|
|
||||||
|
|
||||||
(define-module (srfi srfi-9))
|
|
||||||
|
|
||||||
(define-macro (define-record-type name constructor+field-names predicate . fields)
|
(define-macro (define-record-type name constructor+field-names predicate . fields)
|
||||||
(let ((type (make-record-type name (map car fields))))
|
(let ((type (make-record-type name (map car fields))))
|
||||||
|
@ -116,7 +113,7 @@
|
||||||
(define (record-accessor type field)
|
(define (record-accessor type field)
|
||||||
(let ((i (record-field-index type field)))
|
(let ((i (record-field-index type field)))
|
||||||
(lambda (o . 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
|
(if (pair? field?) field
|
||||||
(struct-ref o i))))))
|
(struct-ref o i))))))
|
||||||
|
|
||||||
|
|
|
@ -27,6 +27,7 @@
|
||||||
#:use-module (system base pmatch)
|
#:use-module (system base pmatch)
|
||||||
#:use-module (ice-9 optargs)
|
#:use-module (ice-9 optargs)
|
||||||
#:use-module (ice-9 pretty-print)
|
#:use-module (ice-9 pretty-print)
|
||||||
|
#:use-module (nyacc lang c99 pprint)
|
||||||
|
|
||||||
#:use-module (mes guile)
|
#:use-module (mes guile)
|
||||||
#:use-module (mes misc)
|
#:use-module (mes misc)
|
||||||
|
@ -40,11 +41,6 @@
|
||||||
c99-input->info
|
c99-input->info
|
||||||
c99-input->object))
|
c99-input->object))
|
||||||
|
|
||||||
(cond-expand
|
|
||||||
(guile
|
|
||||||
(use-modules (nyacc lang c99 pprint)))
|
|
||||||
(mes))
|
|
||||||
|
|
||||||
(define mes? (pair? (current-module)))
|
(define mes? (pair? (current-module)))
|
||||||
(define mes-or-reproducible? #t)
|
(define mes-or-reproducible? #t)
|
||||||
(define (cc-amd? info) #f) ; use AMD calling convention?
|
(define (cc-amd? info) #f) ; use AMD calling convention?
|
||||||
|
|
|
@ -25,9 +25,7 @@
|
||||||
(define-module (mescc i386 info)
|
(define-module (mescc i386 info)
|
||||||
#:use-module (mescc info)
|
#:use-module (mescc info)
|
||||||
#:use-module (mescc i386 as)
|
#:use-module (mescc i386 as)
|
||||||
#:export (x86-info
|
#:export (x86-info))
|
||||||
i386:type-alist
|
|
||||||
i386:registers))
|
|
||||||
|
|
||||||
(define (x86-info)
|
(define (x86-info)
|
||||||
(make <info> #:types i386:type-alist #:registers i386:registers #:instructions i386:instructions))
|
(make <info> #:types i386:type-alist #:registers i386:registers #:instructions i386:instructions))
|
||||||
|
|
|
@ -22,37 +22,24 @@
|
||||||
#:use-module (mes misc)
|
#:use-module (mes misc)
|
||||||
#:use-module (mes guile)
|
#:use-module (mes guile)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-13)
|
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (ice-9 pretty-print)
|
#:use-module (ice-9 pretty-print)
|
||||||
#:use-module (ice-9 getopt-long)
|
#:use-module (ice-9 getopt-long)
|
||||||
|
|
||||||
#:use-module (mescc info)
|
#:use-module (mescc info)
|
||||||
;; #:use-module (mescc armv4 info)
|
#:use-module (mescc armv4 info)
|
||||||
#:use-module (mescc i386 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 preprocess)
|
||||||
;;#:use-module (mescc foo-process)
|
#:use-module (mescc compile)
|
||||||
;;#:use-module (mescc compile)
|
#:use-module (mescc M1)
|
||||||
;;#:use-module (mescc M1)
|
|
||||||
#:export (count-opt
|
#:export (count-opt
|
||||||
mescc:preprocess
|
mescc:preprocess
|
||||||
mescc:get-host
|
mescc:get-host
|
||||||
mescc:compile
|
mescc:compile
|
||||||
mescc:assemble
|
mescc:assemble
|
||||||
mescc:link
|
mescc:link
|
||||||
multi-opt
|
multi-opt))
|
||||||
|
|
||||||
M1->hex2
|
|
||||||
replace-suffix
|
|
||||||
|
|
||||||
arch-get
|
|
||||||
arch-get-defines
|
|
||||||
c->info
|
|
||||||
c->ast
|
|
||||||
.E?
|
|
||||||
.c?
|
|
||||||
.s?))
|
|
||||||
|
|
||||||
(define GUILE-with-output-to-file with-output-to-file)
|
(define GUILE-with-output-to-file with-output-to-file)
|
||||||
(define (with-output-to-file file-name thunk)
|
(define (with-output-to-file file-name thunk)
|
||||||
|
@ -60,13 +47,11 @@
|
||||||
(GUILE-with-output-to-file file-name thunk)))
|
(GUILE-with-output-to-file file-name thunk)))
|
||||||
|
|
||||||
(define (mescc:preprocess options)
|
(define (mescc:preprocess options)
|
||||||
(warn "mescc:preprocess")
|
|
||||||
(let* ((pretty-print/write (string->symbol (option-ref options 'write (if guile? "pretty-print" "write"))))
|
(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))
|
(pretty-print/write (if (eq? pretty-print/write 'pretty-print) pretty-print write))
|
||||||
(files (option-ref options '() '("a.c")))
|
(files (option-ref options '() '("a.c")))
|
||||||
(input-file-name (car files))
|
(input-file-name (car files))
|
||||||
(input-base (basename input-file-name))
|
(input-base (basename input-file-name))
|
||||||
(foo (warn "********************************"))
|
|
||||||
(ast-file-name (cond ((and (option-ref options 'preprocess #f)
|
(ast-file-name (cond ((and (option-ref options 'preprocess #f)
|
||||||
(option-ref options 'output #f)))
|
(option-ref options 'output #f)))
|
||||||
(else (replace-suffix input-base ".E"))))
|
(else (replace-suffix input-base ".E"))))
|
||||||
|
@ -75,30 +60,15 @@
|
||||||
(includes (reverse (filter-map (multi-opt 'include) options)))
|
(includes (reverse (filter-map (multi-opt 'include) options)))
|
||||||
(includes (cons (option-ref options 'includedir #f) includes))
|
(includes (cons (option-ref options 'includedir #f) includes))
|
||||||
(includes (cons dir includes))
|
(includes (cons dir includes))
|
||||||
(foo (warn "1111111111111111111111111111111111"))
|
|
||||||
(prefix (option-ref options 'prefix ""))
|
(prefix (option-ref options 'prefix ""))
|
||||||
(machine (option-ref options 'machine "32"))
|
(machine (option-ref options 'machine "32"))
|
||||||
(arch (arch-get options))
|
(arch (arch-get options))
|
||||||
(foo (warn "2222222222222222222222222222222222"))
|
|
||||||
(defines (append (arch-get-defines options) defines))
|
(defines (append (arch-get-defines options) defines))
|
||||||
(foo (warn "3333333333333333333333333333333333"))
|
|
||||||
(verbose? (count-opt options 'verbose)))
|
(verbose? (count-opt options 'verbose)))
|
||||||
(with-output-to-file ast-file-name
|
(with-output-to-file ast-file-name
|
||||||
(lambda _ (for-each (cut c->ast prefix defines includes arch pretty-print/write verbose? <>) files)))))
|
(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)
|
(define (c->ast prefix defines includes arch write verbose? file-name)
|
||||||
(warn "c->ast")
|
|
||||||
(with-input-from-file file-name
|
(with-input-from-file file-name
|
||||||
(cut write (c99-input->ast #:prefix prefix #:defines defines #:includes includes #:arch arch #:verbose? verbose?))))
|
(cut write (c99-input->ast #:prefix prefix #:defines defines #:includes includes #:arch arch #:verbose? verbose?))))
|
||||||
|
|
||||||
|
|
|
@ -21,22 +21,16 @@
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(define-module (mescc preprocess)
|
(define-module (mescc preprocess)
|
||||||
#:use-module (mes guile)
|
|
||||||
#:use-module (ice-9 optargs)
|
#:use-module (ice-9 optargs)
|
||||||
#:use-module (system base pmatch)
|
#:use-module (system base pmatch)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (nyacc lang c99 paars)
|
#:use-module (nyacc lang c99 parser)
|
||||||
;;#:use-module (nyacc lang c99 parser)
|
#:use-module (nyacc lang c99 parser)
|
||||||
;;#:use-module (nyacc version)
|
#:use-module (nyacc version)
|
||||||
#:export (c99-input->ast
|
#:use-module (mes guile)
|
||||||
c99-input->full-ast
|
#:export (c99-input->ast))
|
||||||
|
|
||||||
ast-strip-attributes
|
|
||||||
ast-strip-const
|
|
||||||
ast-strip-comment))
|
|
||||||
|
|
||||||
(define *nyacc-version* "1.0.1")
|
|
||||||
(define mes-or-reproducible? #t)
|
(define mes-or-reproducible? #t)
|
||||||
|
|
||||||
(when (getenv "MESC_DEBUG")
|
(when (getenv "MESC_DEBUG")
|
||||||
|
@ -68,12 +62,12 @@
|
||||||
(apply (vector-ref act-v ix) args))))
|
(apply (vector-ref act-v ix) args))))
|
||||||
(loop (1+ ix))))))
|
(loop (1+ ix))))))
|
||||||
|
|
||||||
;; (cond-expand
|
(cond-expand
|
||||||
;; (guile
|
(guile
|
||||||
;; (insert-progress-monitors (@@ (nyacc lang c99 parser) c99-act-v)
|
(insert-progress-monitors (@@ (nyacc lang c99 parser) c99-act-v)
|
||||||
;; (@@ (nyacc lang c99 parser) c99-len-v)))
|
(@@ (nyacc lang c99 parser) c99-len-v)))
|
||||||
;; (mes
|
(mes
|
||||||
;; (insert-progress-monitors c99-act-v c99-len-v)))
|
(insert-progress-monitors c99-act-v c99-len-v)))
|
||||||
|
|
||||||
(define* (c99-input->full-ast #:key (prefix "") (defines '()) (includes '()) (arch "") verbose?)
|
(define* (c99-input->full-ast #:key (prefix "") (defines '()) (includes '()) (arch "") verbose?)
|
||||||
(let* ((sys-include (if (equal? prefix "") "include"
|
(let* ((sys-include (if (equal? prefix "") "include"
|
||||||
|
@ -100,18 +94,14 @@
|
||||||
(when (and verbose? (> verbose? 1))
|
(when (and verbose? (> verbose? 1))
|
||||||
(format (current-error-port) "includes: ~s\n" includes)
|
(format (current-error-port) "includes: ~s\n" includes)
|
||||||
(format (current-error-port) "defines: ~s\n" defines))
|
(format (current-error-port) "defines: ~s\n" defines))
|
||||||
(warn "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@" "gonna parse")
|
|
||||||
(parse-c99
|
(parse-c99
|
||||||
#:inc-dirs includes
|
#:inc-dirs includes
|
||||||
#:cpp-defs defines
|
#:cpp-defs defines
|
||||||
#:mode 'code)))
|
#:mode 'code)))
|
||||||
|
|
||||||
(define* (c99-input->ast #:key (prefix "") (defines '()) (includes '()) (arch "") verbose?)
|
(define* (c99-input->ast #:key (prefix "") (defines '()) (includes '()) (arch "") verbose?)
|
||||||
(warn "hiero" "c99-input->ast")
|
|
||||||
(when verbose?
|
(when verbose?
|
||||||
(warn "1111")
|
|
||||||
(format (current-error-port) "parsing: input\n"))
|
(format (current-error-port) "parsing: input\n"))
|
||||||
(warn "2222")
|
|
||||||
((compose ast-strip-attributes
|
((compose ast-strip-attributes
|
||||||
ast-strip-const
|
ast-strip-const
|
||||||
ast-strip-comment)
|
ast-strip-comment)
|
||||||
|
|
|
@ -148,7 +148,7 @@ mes_builtins (struct scm *a) /*:((internal)) */
|
||||||
a = init_builtin (builtin_type, "length", 1, &length, a);
|
a = init_builtin (builtin_type, "length", 1, &length, a);
|
||||||
a = init_builtin (builtin_type, "error", 2, &error, a);
|
a = init_builtin (builtin_type, "error", 2, &error, a);
|
||||||
a = init_builtin (builtin_type, "append2", 2, &append2, a);
|
a = init_builtin (builtin_type, "append2", 2, &append2, a);
|
||||||
a = init_builtin (builtin_type, "core:append-reverse", 2, &append_reverse_, a);
|
a = init_builtin (builtin_type, "append-reverse", 2, &append_reverse, a);
|
||||||
a = init_builtin (builtin_type, "core:reverse!", 2, &reverse_x_, a);
|
a = init_builtin (builtin_type, "core:reverse!", 2, &reverse_x_, a);
|
||||||
a = init_builtin (builtin_type, "assq", 2, &assq, a);
|
a = init_builtin (builtin_type, "assq", 2, &assq, a);
|
||||||
a = init_builtin (builtin_type, "assoc", 2, &assoc, a);
|
a = init_builtin (builtin_type, "assoc", 2, &assoc, a);
|
||||||
|
|
|
@ -178,12 +178,12 @@ append2 (struct scm *x, struct scm *y)
|
||||||
}
|
}
|
||||||
|
|
||||||
struct scm *
|
struct scm *
|
||||||
append_reverse_ (struct scm *x, struct scm *y)
|
append_reverse (struct scm *x, struct scm *y)
|
||||||
{
|
{
|
||||||
if (x == cell_nil)
|
if (x == cell_nil)
|
||||||
return y;
|
return y;
|
||||||
if (x->type != TPAIR)
|
if (x->type != TPAIR)
|
||||||
error (cell_symbol_not_a_pair, cons (x, cstring_to_symbol ("core:append-reverse")));
|
error (cell_symbol_not_a_pair, cons (x, cstring_to_symbol ("append-reverse")));
|
||||||
while (x != cell_nil)
|
while (x != cell_nil)
|
||||||
{
|
{
|
||||||
y = cons (x->car, y);
|
y = cons (x->car, y);
|
||||||
|
|
Loading…
Reference in New Issue