mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-25 21:58:54 +01:00
74 lines
3.2 KiB
Text
74 lines
3.2 KiB
Text
;---------------------------------------------------------------------------------------------
|
|
; Skint k.sf precursor compiler (k.sf => k.c)
|
|
;---------------------------------------------------------------------------------------------
|
|
|
|
(import (only (skint hidden)
|
|
list2? list3? path-relative? path-directory path-strip-directory
|
|
path-strip-extension file-resolve-relative-to-base-path %system))
|
|
|
|
(define (list4? x) (and (pair? x) (list3? (cdr x))))
|
|
|
|
(define *prelude* "
|
|
#include \"n.h\"
|
|
#include \"i.h\"
|
|
|
|
#define MODULE module_k
|
|
#define LOAD()
|
|
|
|
")
|
|
|
|
(define (convert iport oport ifbase ifname)
|
|
(let loop ([l (read-line iport)] [in-header? #t])
|
|
(cond [(eof-object? l)]
|
|
[(and in-header? (string=? l "/* cx globals */"))
|
|
(display "/* " oport) (display ifbase oport)
|
|
(display ".c -- generated via skint ksf2c.ssc " oport)
|
|
(display ifname oport)
|
|
(display " */" oport) (newline oport)
|
|
(display *prelude* oport)
|
|
(display l oport) (newline oport)
|
|
(loop (read-line iport) #f)]
|
|
[in-header?
|
|
(loop (read-line iport) #t)]
|
|
[(string=? l "static size_t cxg_hsize = 0; ") ; sfc puts 1 trailing space!
|
|
(display "size_t cxg_hsize = 0;" oport) (newline oport)
|
|
(loop (read-line iport) #f)]
|
|
[(string=? l "static int cxg_gccount = 0, cxg_bumpcount = 0;")
|
|
(display "int cxg_gccount = 0, cxg_bumpcount = 0;" oport) (newline oport)
|
|
(loop (read-line iport) #f)]
|
|
[(string=? l " /* fprintf(stderr, \"%d collections, %d reallocs\\n\", cxg_gccount, cxg_bumpcount); */")
|
|
(loop (read-line iport) #f)]
|
|
[else
|
|
(display l oport) (newline oport)
|
|
(loop (read-line iport) #f)])))
|
|
|
|
(define (process-file sfcpath ifpath . ?ofpath)
|
|
(define cwd (current-directory))
|
|
(define sfcp (file-resolve-relative-to-base-path sfcpath cwd))
|
|
(define ifdir (path-directory ifpath))
|
|
(define ifname (path-strip-directory ifpath))
|
|
(define ifbase (path-strip-extension ifname))
|
|
(define tfpath (string-append ifdir ifbase ".c"))
|
|
(define sfccmd (format #f "~a -v ~a" sfcp ifname))
|
|
(when (file-exists? tfpath) (error "itermediate file already exists" tfpath))
|
|
(format #t "; running ~a~%" sfccmd)
|
|
(parameterize ([current-directory ifdir])
|
|
(define res (begin (format #t "; cd is '~a'~%" (current-directory)) (%system sfccmd)))
|
|
(unless (eqv? res 0) (error "sfc failed!")))
|
|
(unless (file-exists? tfpath) (error "itermediate file is not found" tfpath))
|
|
(format #t "; converting intermediate file ~a~%" tfpath)
|
|
(let ([iport (open-input-file tfpath)]
|
|
[oport (if (null? ?ofpath) (current-output-port) (open-output-file (car ?ofpath)))])
|
|
(convert iport oport ifbase ifname)
|
|
(close-input-port iport)
|
|
(unless (null? ?ofpath) (close-output-port oport)))
|
|
(format #t "; deleting intermediate file ~a~%" tfpath)
|
|
(delete-file tfpath))
|
|
|
|
(define (main args)
|
|
(cond [(list3? args) (process-file (cadr args) (caddr args))]
|
|
[(list4? args) (process-file (cadr args) (caddr args) (cadddr args))]
|
|
[else (error "usage: scint ksf2c.ssc SFCPATH INFILE [OUTFILE]" args)]))
|
|
|
|
; this is not a real #! script, so call main manually
|
|
(main (command-line))
|