Initial lambdas support #11
11
Makefile
11
Makefile
@@ -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
|
||||||
|
|||||||
12
Readme.org
12
Readme.org
@@ -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,7 +116,7 @@ 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
31
example/lambdas.sex
Normal 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))
|
||||||
68
semen.scm
68
semen.scm
@@ -4,9 +4,12 @@
|
|||||||
(uses sex-macros
|
(uses sex-macros
|
||||||
sex-modules))
|
sex-modules))
|
||||||
|
|
||||||
(import fmt
|
(import
|
||||||
|
(chicken string)
|
||||||
|
fmt
|
||||||
matchable ; pattern matching
|
matchable ; pattern matching
|
||||||
srfi-1 ; list routines
|
srfi-1 ; list routines
|
||||||
|
srfi-69 ; hash tables
|
||||||
)
|
)
|
||||||
|
|
||||||
;;; for lambda extraction, docstring processing, macro expansion,
|
;;; for lambda extraction, docstring processing, macro expansion,
|
||||||
@@ -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))
|
||||||
|
|||||||
4
sexc.scm
4
sexc.scm
@@ -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))
|
||||||
|
|||||||
Reference in New Issue
Block a user