alex-eg/sex
1
0
Fork 1
Code Issues 3 Pull Requests 1 Actions Packages Projects 1 Releases Wiki Activity

migrate to Chicken 6

Browse Source
This commit is contained in:
alex-eg
2026-09-09 01:09:48 +03:00
parent 9903cae3f7
commit 528f26b7ef
11 changed files with 114 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
.github/workflows/build.yaml vendored
View File

@@ -15,11 +15,11 @@ jobs:
- uses: actions/checkout@v3
- name: Install chicken
run: |
wget -N https://code.call-cc.org/releases/5.4.0/chicken-5.4.0.tar.gz
tar zxf chicken-5.4.0.tar.gz
wget -N https://code.call-cc.org/releases/6.0.0/chicken-6.0.0.tar.gz
tar zxf chicken-6.0.0.tar.gz
sudo apt install -y make
make -C chicken-5.4.0 PLATFORM=linux
sudo make -C chicken-5.4.0 PLATFORM=linux install
make -C chicken-6.0.0 PLATFORM=linux
sudo make -C chicken-6.0.0 PLATFORM=linux install
- name: Install dependencies
# FIXME: [project-local deps]: use venv or something
# run: make deps

2
Makefile
View File

@@ -58,7 +58,7 @@ sextest:
$(MAKE) -C ./tools/sextest sextest
cp ./tools/sextest/sextest .
SEX_TEST_PROGRAMS = hello-world lists comments
SEX_TEST_PROGRAMS = hello-world lists comments unicode
run-tests: sexc sex-tests sextest
./sex-tests && ./sextest --sexc=./sexc $(SEX_TEST_PROGRAMS:%=./tests/sex-programs/%.sex)

4
Readme.org
View File

@@ -4,8 +4,8 @@
#+ATTR_HTML: :width 300px
[[sex.png][file:./sex.png]]
Sex is a S-expressions language. Sex is written in Chicken, which is a
[[https://call-cc.org][R5RS Scheme]].
Sex is a S-expressions language. Sex is written in Chicken, which is an
[[https://call-cc.org][R7RS Scheme]].
Sex is statically typed, compiled general purpose language.
* Compilation

2
dependencies.txt
View File

@@ -1 +1 @@
fmt getopt-long brev-separate test tree srfi-1 srfi-13 srfi-69 matchable
fmt getopt-long brev-separate test srfi-1 srfi-13 srfi-69 matchable

19
fmt-c-writer.scm
View File

@@ -2,20 +2,28 @@
(import
scheme
(scheme base) ; make-parameter
(chicken base)
(chicken string)
(chicken syntax)
brev-separate
brev-separate ; fn, flatten
fmt
sex-fmt-c
matchable
regex
(chicken irregex) ; unkebabify
srfi-1 ; lists
srfi-13 ; strings
srfi-39 ; parameters
tree
utils)
;;; Map a procedure over every leaf of a tree, preserving its shape.
;;; Was the `tree' egg, which has not been ported to CHICKEN 6. (Its
;;; `flatten', also used here, comes from brev-separate.)
(define (tree-map f tree)
(cond ((null? tree) (list))
((pair? tree) (cons (tree-map f (car tree))
(tree-map f (cdr tree))))
(else (f tree))))
(define (unkebabify sym)
(case sym
((-) sym)
@@ -24,8 +32,7 @@
((-=) sym)
(else
(string->symbol
(string-substitute "-(?!>)" "_"
(symbol->string sym) #t)))))
(irregex-replace/all "-(?!>)" (symbol->string sym) "_")))))
(define (atom-to-fmt-c atom)
(case atom

1
reader.scm
View File

@@ -12,6 +12,7 @@
(import
scheme
(scheme base) ; make-parameter
(chicken base)
(chicken pathname)
utils)

27
sex-fmt-c.scm
View File

@@ -33,6 +33,7 @@
(import
scheme
(scheme base) ; string->utf8, bytevector accessors
(chicken base)
fmt
srfi-1
@@ -138,7 +139,31 @@
(case n
((7) "\\a") ((8) "\\b") ((9) "\\t") ((10) "\\n")
((11) "\\v") ((12) "\\f") ((13) "\\r")
(else (string-append "\\x" (number->string (char->integer c) 16)))))))
(else (c-octal-escapes c))))))
;; A character outside printable ASCII, as one three-digit octal escape
;; per UTF-8 byte.
;;
;; MODIFIED FROM UPSTREAM fmt-c, which emits "\x" plus the hex of the
;; character. C's \x escape consumes *every* following hex digit, so
;; "\xc3\xa91" is a single out-of-range value rather than two bytes
;; followed by a '1'. Under CHICKEN 6 a character is a codepoint rather
;; than a byte, so the hex form additionally emits "\xe9" for a lone
;; "e-acute" -- not valid UTF-8 -- and "\x65e5" for anything above the
;; Latin-1 range, which does not compile at all. Octal escapes are
;; capped at three digits, so they always self-terminate.
(define (c-octal-escapes c)
(let* ((bytes (string->utf8 (string c)))
(len (bytevector-length bytes)))
(let loop ((i 0) (acc '()))
(if (= i len)
(apply string-append (reverse acc))
(loop (+ i 1)
(cons (let ((oct (number->string (bytevector-u8-ref bytes i) 8)))
(string-append "\\"
(make-string (- 3 (string-length oct)) #\0)
oct))
acc))))))
(define (c-format-number x)
(if (and (integer? x) (exact? x))

17
sexc.scm
View File

@@ -1,4 +1,5 @@
(import scheme
(scheme base) ; call/cc
brev-separate
(chicken base)
(chicken file)
@@ -16,7 +17,6 @@
semen
srfi-1 ; list routines
srfi-13
tree
utils)
;;; Main function facilities
@@ -98,19 +98,20 @@
(out-file (if (eq? output 'default)
"a.out"
output)))
(call-with-values
(lambda ()
(process compiler (append (list "-o" out-file "-x" "c")
;; `process' hands back one record. Its port accessors are named
;; from the *child's* point of view, so `process-input-port' is the
;; port we write to: the C compiler's stdin.
(let* ((proc (process compiler (append (list "-o" out-file "-x" "c")
(if (get-arg args 'compile-object #f)
(list "-c")
(list))
(list "-") ; read stdin
(get-c-compiler-args args))))
(lambda (out-port in-port pid)
(with-output-to-port in-port
(cc-stdin (process-input-port proc)))
(with-output-to-port cc-stdin
(lambda () (emit-c sex-forms)))
(close-output-port in-port)
(process-wait pid)))))
(close-output-port cc-stdin)
(process-wait proc))))
(define (semantic-process-forms raw-forms input-source)
(if (eq? input-source 'stdin)

8
tests/basic.scm
View File

@@ -13,6 +13,14 @@
(test '_this_->_member_ (unkebabify '-this-->-member-))
(test '__->>> (unkebabify '--->>>))
;; Non-ASCII identifiers must survive intact. The `regex' egg's
;; string-substitute drops one trailing character per multi-byte
;; character, which renames things silently -- the C still compiles,
;; just under a different name than was written.
(test 'naïve_count (unkebabify 'naïve-count))
(test 'aï_b (unkebabify 'aï-b))
(test 'ïï (unkebabify 'ïï))
;; atom-to-fmt-c
(test '%fun (atom-to-fmt-c 'fn))
(test '%prototype (atom-to-fmt-c 'prototype))

24
tests/sex-programs/unicode.sex Normal file
View File

@@ -0,0 +1,24 @@
(input)
(output "café 日本語 🍺" "café1" "naïve: 3")
(return 0)
;;; Non-ASCII string literals and identifiers.
;;;
;;; Two things are pinned here. First, a character outside printable
;;; ASCII must reach the C compiler as the UTF-8 bytes it was written
;;; as. Octal escapes are used because C's \x escape swallows every
;;; following hex digit: "café1" is the case that catches it, since a
;;; hex escape would run "\xc3\xa9" into the "1" and produce a value out
;;; of range for a char. Second, a kebab-case identifier containing
;;; non-ASCII characters must survive unkebabify intact -- getting this
;;; wrong truncates the name silently, and the program still compiles
;;; and runs, just under a different name than the one written.
(include stdio.h)
(pub fn main () int
(puts "café 日本語 🍺")
(puts "café1")
(var naïve-count int 3)
(printf "naïve: %d\n" naïve-count)
(return 0))

30
tools/sextest/sextest.scm
View File

@@ -38,27 +38,25 @@
(get-environment-variable "SEXC")
"sexc"))
(compiled-file (create-temporary-file)))
(call-with-values
(fn
(process compiler
(append (list "-o" compiled-file)
flags)))
(lambda (out-port in-port pid)
(with-output-to-port in-port
;; `process' returns one record; `process-input-port' is named from
;; the child's side, so it is the port we write to.
(let* ((proc (process compiler (append (list "-o" compiled-file) flags)))
(sexc-stdin (process-input-port proc)))
(with-output-to-port sexc-stdin
(fn (map (fn (fmt #t x)) src)))
(close-output-port in-port)
(close-output-port sexc-stdin)
(call-with-values
(fn (process-wait pid))
(fn (process-wait proc))
(lambda (pid exited retcode)
(if (= 0 retcode)
compiled-file
#f)))))))
#f))))))
(define (run-and-check file in out ret)
(call-with-values
(fn (process file))
(lambda (out-port in-port pid)
(let* ((proc (process file))
(out-port (process-output-port proc)) ; the program's stdout
(in-port (process-input-port proc))) ; the program's stdin
(let ()
(when in
(with-output-to-port in-port
(fn (map (fn (fmt #t x))
@@ -78,7 +76,7 @@
;; TODO: what if the program hangs
;; we need some kind of timeout mechanism
(fn
(process-wait pid))
(process-wait proc))
(lambda (pid exited retcode)
retcode))))
(and
@@ -137,7 +135,7 @@
(print-help)
(exit 1))
(unless
(foldl and
(foldl (lambda (a b) (and a b))
#t
(map (fn (process-test-file (assoc 'sexc args) x))
(cdr (assoc '@ args))))