Initial lambdas support #11

Merged
alex-eg merged 4 commits from initial-lambdas-support into main 2025-09-30 08:35:16 +02:00
5 changed files with 107 additions and 27 deletions

View File

@@ -1,20 +1,21 @@
CHICKEN_C = csc CHICKEN_C = csc
CSC_FLAGS = -K prefix
MODULES = sexc fmt-c fmt-c-writer semen sex-macros sex-modules sex-reader utils MODULES = sexc fmt-c fmt-c-writer semen sex-macros sex-modules sex-reader utils
OBJ = $(MODULES:%=%.o) OBJ = $(MODULES:%=%.o)
sexc: main.o $(OBJ) sexc: main.o $(OBJ)
$(CHICKEN_C) $^ -o $@ $(CHICKEN_C) $(CSC_FLAGS) $^ -o $@
main.o: main.scm main.o: main.scm
$(CHICKEN_C) $< -c -o $@ $(CHICKEN_C) $(CSC_FLAGS) $< -c -o $@
%.o: %.scm %.o: %.scm
$(CHICKEN_C) $< -e -c -o $@ $(CHICKEN_C) $(CSC_FLAGS) $< -e -c -o $@
sex-tests: $(OBJ) tests/*.scm sex-tests: $(OBJ) tests/*.scm
cd ./tests && $(CHICKEN_C) run.scm -c -o sex-tests.o cd ./tests && $(CHICKEN_C) $(CSC_FLAGS) run.scm -c -o sex-tests.o
$(CHICKEN_C) $(OBJ) ./tests/sex-tests.o -o sex-tests $(CHICKEN_C) $(CSC_FLAGS) $(OBJ) ./tests/sex-tests.o -o sex-tests
clean: clean:
rm -f $(OBJ) sexc sex-tests main.o ./tests/sex-tests.o rm -f $(OBJ) sexc sex-tests main.o ./tests/sex-tests.o

View File

@@ -1,6 +1,7 @@
* The Sex language * The Sex language
Sex is a S-expressions language. Sex is written in Chicken, which is a Sex is a S-expressions language. Sex is written in Chicken, which is a
[[https://call-cc.org][R5RS Scheme]]. [[https://call-cc.org][R5RS Scheme]].
Sex is statically typed, compiled general purpose language.
* Compilation * Compilation
First, get yourself a Chicken, then, some Chicken deps. You also will First, get yourself a Chicken, then, some Chicken deps. You also will
@@ -25,10 +26,11 @@ Options:
--c-compiler=ARG Select C compiler. Defaults to value of SEX_CC --c-compiler=ARG Select C compiler. Defaults to value of SEX_CC
environment variable, or if it is empty, to cc environment variable, or if it is empty, to cc
-c, --compile-object Compile object file instead of executable program -c, --compile-object Compile object file instead of executable program
-E, --preprocess Emit C code -C, --preprocess Emit C code
--public-interface Get module's public interface --public-interface Get module's public interface
-h, --help Show this help -h, --help Show this help
-m, --macro-expand Emit macro-expanded Sex code -m, --macro-expand Emit macro-expanded semantically processed Sex code
(sort of IR). May be useful for debugging
-o, --output=ARG Write output to file. Default file name is a.out. -o, --output=ARG Write output to file. Default file name is a.out.
If -E or -m options are provided, defaults to stdout If -E or -m options are provided, defaults to stdout
#+end_src #+end_src
@@ -71,9 +73,9 @@ Hello, Alex!
Just ~(include "Your/Favourite/Library.h")~ and use it as you would Just ~(include "Your/Favourite/Library.h")~ and use it as you would
have is C. have is C.
** Auto unkebabification *** Auto kebabification
For hardcore fans of traditional Lisp naming convention, For hardcore fans of traditional Lisp naming convention,
Sex offers automatic unkebabification of all symbols, i.e. no more Sex offers automatic kebabification of all symbols, i.e. no more
ugly ~GL_ARRAY_BUFFER~ s in your code, they may be written in their ugly ~GL_ARRAY_BUFFER~ s in your code, they may be written in their
proper form: ~GL-ARRAY-BUFFER~. proper form: ~GL-ARRAY-BUFFER~.
@@ -114,8 +116,8 @@ return Sex code.
**** Wrapper for checking return codes **** Wrapper for checking return codes
#+begin_src scheme #+begin_src scheme
(pub defmacro (check-sdl-return call message ret-code) (pub defmacro (check-sdl-return call message ret-code)
`((if (< 0 ,call) `(if (< 0 ,call)
(begin (begin
(puts ,message) (puts ,message)
(return ,ret-code))))) (return ,ret-code)))))

31
example/lambdas.sex Normal file
View File

@@ -0,0 +1,31 @@
(include stdio.h)
(fn int sum ((int a) (int b))
(return (+ a b)))
(pub fn int main ()
(var int a 10)
(var int b 20)
(var (fn int ((int) (int))) sum-fn sum)
(var (fn int ((int) (int))) sum-lambda
(lambda int ((int a) (int b)) ()
(return (+ a b))))
(var (fn int ((int))) sum-lambda-2
(lambda int ((int a)) ()
(return (+ a 20))))
(printf "Hello from main fn!\n")
(printf "We will now perform some function calling.\n")
(printf "Calling fn ptr: %d\n" (sum-fn a b))
(printf "Calling lambda: %d\n" (sum-lambda a b))
(printf "Calling other lambda: %d\n" (sum-lambda-2 a))
(printf "Calling lambda inplace: %d\n" ((lambda int ((int a) (int b)) ()
(return (+ a b 100)))
a b))
(return 0))

View File

@@ -4,10 +4,13 @@
(uses sex-macros (uses sex-macros
sex-modules)) sex-modules))
(import fmt (import
matchable ; pattern matching (chicken string)
srfi-1 ; list routines fmt
) matchable ; pattern matching
srfi-1 ; list routines
srfi-69 ; hash tables
)
;;; for lambda extraction, docstring processing, macro expansion, ;;; for lambda extraction, docstring processing, macro expansion,
;;; injection of module headers, i.e. all things that rearrange code ;;; injection of module headers, i.e. all things that rearrange code
@@ -83,21 +86,24 @@
"Walk the form recursively and expand all macros, until none is left." "Walk the form recursively and expand all macros, until none is left."
(semen-walk-form (semen-walk-form
form form
(lambda (subform) (lambda (subform env)
(if (sex-macro? subform) (if (sex-macro? subform)
(apply-macro subform) (apply-macro subform)
subform)))) subform))
#f))
;;; TODO: for greater inspiration, see SBCL's walk.lisp ;;; TODO: for greater inspiration, see SBCL's walk.lisp and their
(define (semen-walk-form form walk-fn) ;;; template system. Maybe it is worth it to implement something
;;; similar here
(define (semen-walk-form form walk-fn env)
(if (atom? form) form (if (atom? form) form
(let ((new-form (walk-fn form))) (let ((new-form (walk-fn form env)))
(cond ((not (eq? form new-form)) (cond ((not (eq? form new-form))
(semen-walk-form new-form walk-fn)) (semen-walk-form new-form walk-fn env))
(else (recons (else (recons
new-form new-form
(semen-walk-form (car new-form) walk-fn) (semen-walk-form (car new-form) walk-fn env)
(semen-walk-form (cdr new-form) walk-fn))))))) (semen-walk-form (cdr new-form) walk-fn env)))))))
(define (recons old-cons new-car new-cdr) (define (recons old-cons new-car new-cdr)
(if (and (eq? new-car (car old-cons)) (if (and (eq? new-car (car old-cons))
@@ -105,9 +111,49 @@
old-cons old-cons
(cons new-car new-cdr))) (cons new-car new-cdr)))
;;; Fn processing
(define (process-fn sex-fn acc) (define (process-fn sex-fn acc)
(let ((expanded (semen-macro-expand sex-fn))) (let* ((expanded (semen-macro-expand sex-fn))
(cons expanded acc))) (env (make-hash-table))
(processed
(semen-walk-form
expanded
semen-fn-walker
(begin
(set! (hash-table-ref env :fn-name) (sex-fn-name expanded))
(set! (hash-table-ref env :lambda-counter) 0)
(set! (hash-table-ref env :lambda-aux-code) (list))
env))))
(cons processed
(append (hash-table-ref env :lambda-aux-code) acc))))
(define (semen-fn-walker form env)
(if (eq? 'lambda (car form))
(let ((lambda-name (semen-make-lambda-name (hash-table-ref env :fn-name)
(hash-table-ref env :lambda-counter))))
(set! (hash-table-ref env :lambda-aux-code)
(cons (semen-make-aux-lambda-struct lambda-name form)
(hash-table-ref env :lambda-aux-code)))
(set! (hash-table-ref env :lambda-counter)
(+ (hash-table-ref env :lambda-counter) 1))
lambda-name)
form))
(define (semen-make-lambda-name enclosing-fn-name counter)
(string->symbol
(fmt #f "__lambda_" counter "_" enclosing-fn-name)))
(define (semen-make-aux-lambda-struct name form)
(match form
(('lambda ret-type arglist captures . body)
;; Captures are ignored for now, but
;; we'll need them for TODO: closures support
`(fn ,ret-type ,name ,arglist ,@body))
(else (assert #f (fmt #f "Malformed lambda " form)))))
;;; Struct
(define (process-struct sex-struct acc) (define (process-struct sex-struct acc)
(cons sex-struct acc)) (cons sex-struct acc))

View File

@@ -41,7 +41,7 @@
(required #f) (required #f)
(value #f) (value #f)
(single-char #\h)) (single-char #\h))
(macro-expand "Emit macro-expanded Sex code" (macro-expand "Emit macro-expanded semantically processed Sex code"
(required #f) (required #f)
(value #f) (value #f)
(single-char #\m)) (single-char #\m))
@@ -99,7 +99,7 @@
output))) output)))
(call-with-values (call-with-values
(lambda () (lambda ()
(process compiler (append (list "-o" out-file "-std=c89" "-pedantic" "-x" "c") (process compiler (append (list "-o" out-file "-x" "c")
(if (get-arg args 'compile-object #f) (if (get-arg args 'compile-object #f)
(list "-c") (list "-c")
(list)) (list))