mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-21 22:59:16 +02:00
77 lines
2.2 KiB
Scheme
77 lines
2.2 KiB
Scheme
;;
|
|
;; Cyclone Scheme
|
|
;; Copyright (c) 2015, Justin Ethier
|
|
;; All rights reserved.
|
|
;;
|
|
;; This module contains various utility functions.
|
|
;;
|
|
|
|
(define (tagged-list? tag exp)
|
|
(if (pair? exp)
|
|
(equal? (car exp) tag)
|
|
#f))
|
|
|
|
; if? : exp -> boolean
|
|
(define (if? exp)
|
|
(tagged-list? 'if exp))
|
|
|
|
; char->natural : char -> natural
|
|
(define (char->natural c)
|
|
(let ((i (char->integer c)))
|
|
(if (< i 0)
|
|
(* -2 i)
|
|
(+ (* 2 i) 1))))
|
|
|
|
; integer->char-list : integer -> string
|
|
(define (integer->char-list n)
|
|
(string->list (number->string n)))
|
|
|
|
;; Simplified version of filter from SRFI 1
|
|
(define (filter pred lis)
|
|
(letrec ((recur (lambda (lis)
|
|
(if (null? lis)
|
|
lis
|
|
(let ((head (car lis))
|
|
(tail (cdr lis)))
|
|
(if (pred head)
|
|
(let ((new-tail (recur tail)))
|
|
(if (eq? tail new-tail) lis
|
|
(cons head new-tail)))
|
|
(recur tail)))))))
|
|
(recur lis)))
|
|
|
|
|
|
;; 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
|
|
|