mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-24 20:45:06 +02:00
Added util module
This commit is contained in:
parent
e15fd3619d
commit
0740f2da7a
4 changed files with 44 additions and 34 deletions
33
cgen.scm
33
cgen.scm
|
@ -51,39 +51,6 @@
|
||||||
(next (cdr head) (cons (car head) tail)))))))
|
(next (cdr head) (cons (car head) tail)))))))
|
||||||
(next (string->list str) '())))
|
(next (string->list str) '())))
|
||||||
|
|
||||||
;; Name-mangling.
|
|
||||||
|
|
||||||
;; We have to "mangle" Scheme identifiers into
|
|
||||||
;; C-compatible identifiers, because names like
|
|
||||||
;; foo-bar/baz are not identifiers in C.
|
|
||||||
|
|
||||||
; mangle : symbol -> string
|
|
||||||
(define (mangle symbol)
|
|
||||||
(letrec
|
|
||||||
((m (lambda (chars)
|
|
||||||
(if (null? chars)
|
|
||||||
'()
|
|
||||||
(if (or (and (char-alphabetic? (car chars)) (not (char=? (car chars) #\_)))
|
|
||||||
(char-numeric? (car chars)))
|
|
||||||
(cons (car chars) (m (cdr chars)))
|
|
||||||
(cons #\_ (append (integer->char-list (char->natural (car chars)))
|
|
||||||
(m (cdr chars))))))))
|
|
||||||
(ident (list->string (m (string->list (symbol->string symbol))))))
|
|
||||||
(if (member (string->symbol ident) *c-keywords*)
|
|
||||||
(string-append "_" ident)
|
|
||||||
ident)))
|
|
||||||
|
|
||||||
(define (mangle-global symbol)
|
|
||||||
(string-append "__glo_" (mangle symbol)))
|
|
||||||
|
|
||||||
(define *c-keywords*
|
|
||||||
'(auto _Bool break case char _Complex const continue default do double else
|
|
||||||
enum extern float for goto if _Imaginary inline int long register restrict
|
|
||||||
return short signed sizeof static struct switch typedef union unsigned
|
|
||||||
void volatile while
|
|
||||||
list ;; Not a keyword but reserved type
|
|
||||||
))
|
|
||||||
|
|
||||||
(define *c-main-function*
|
(define *c-main-function*
|
||||||
"main(int argc,char **argv)
|
"main(int argc,char **argv)
|
||||||
{long stack_size = long_arg(argc,argv,\"-s\",STACK_SIZE);
|
{long stack_size = long_arg(argc,argv,\"-s\",STACK_SIZE);
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
(define-library (scheme cyclone libraries)
|
(define-library (scheme cyclone libraries)
|
||||||
(import (scheme base)
|
(import (scheme base)
|
||||||
(scheme read)
|
(scheme read)
|
||||||
; TODO: what else? definitely need trans.scm
|
(scheme cyclone util)
|
||||||
)
|
)
|
||||||
(export
|
(export
|
||||||
library?
|
library?
|
||||||
|
|
8
scheme/cyclone/util.sld
Normal file
8
scheme/cyclone/util.sld
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
(define-library (scheme cyclone util)
|
||||||
|
(import (scheme base)
|
||||||
|
(scheme char))
|
||||||
|
(export
|
||||||
|
tagged-list?
|
||||||
|
mangle
|
||||||
|
mangle-global)
|
||||||
|
(include "../../util.scm"))
|
35
util.scm
35
util.scm
|
@ -3,3 +3,38 @@
|
||||||
(if (pair? exp)
|
(if (pair? exp)
|
||||||
(equal? (car exp) tag)
|
(equal? (car exp) tag)
|
||||||
#f))
|
#f))
|
||||||
|
|
||||||
|
;; Name-mangling.
|
||||||
|
|
||||||
|
;; We have to "mangle" Scheme identifiers into
|
||||||
|
;; C-compatible identifiers, because names like
|
||||||
|
;; foo-bar/baz are not identifiers in C.
|
||||||
|
|
||||||
|
; mangle : symbol -> string
|
||||||
|
(define (mangle symbol)
|
||||||
|
(letrec
|
||||||
|
((m (lambda (chars)
|
||||||
|
(if (null? chars)
|
||||||
|
'()
|
||||||
|
(if (or (and (char-alphabetic? (car chars)) (not (char=? (car chars) #\_)))
|
||||||
|
(char-numeric? (car chars)))
|
||||||
|
(cons (car chars) (m (cdr chars)))
|
||||||
|
(cons #\_ (append (integer->char-list (char->natural (car chars)))
|
||||||
|
(m (cdr chars))))))))
|
||||||
|
(ident (list->string (m (string->list (symbol->string symbol))))))
|
||||||
|
(if (member (string->symbol ident) *c-keywords*)
|
||||||
|
(string-append "_" ident)
|
||||||
|
ident)))
|
||||||
|
|
||||||
|
(define (mangle-global symbol)
|
||||||
|
(string-append "__glo_" (mangle symbol)))
|
||||||
|
|
||||||
|
(define *c-keywords*
|
||||||
|
'(auto _Bool break case char _Complex const continue default do double else
|
||||||
|
enum extern float for goto if _Imaginary inline int long register restrict
|
||||||
|
return short signed sizeof static struct switch typedef union unsigned
|
||||||
|
void volatile while
|
||||||
|
list ;; Not a keyword but reserved type
|
||||||
|
))
|
||||||
|
;; END name mangling section
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue