spook

A "game" for the 2023 Autumn Lisp Game Jam. Won first place! (from the bottom...)
git clone https://kaka.farm/~git/spook
Log | Files | Refs | LICENSE

spock-module.scm (2093B)

      1 ;;;; spock-module.scm - read-syntax and programming interface
      2 
      3 
      4 (module spock (<spock-header>
      5 	       spock-script
      6 	       <spock>)
      7 
      8 (import scheme (chicken base))
      9 (import matchable (chicken port) (chicken module))
     10 (import (chicken read-syntax))
     11 (import (chicken syntax))
     12 (import spock-compiler)
     13 (reexport spock-compiler)
     14 
     15 
     16 ;;
     17 (define (<spock-header> #!key (minified #t) debug path)
     18   (string-append
     19    "<script type='text/javascript' src='"
     20    (if path (string-append path "/") "")
     21    "spock-runtime"
     22    (if debug "-debug" "")
     23    (if minified "-min" "")
     24    ".js'></script>\n"))   
     25 
     26 ;;
     27 (define (spock-script x . options)
     28   (let ((state (current-spock-state)))
     29     (unless state
     30       (set! state (make-spock-state))
     31       (current-spock-state state))
     32     (with-output-to-string
     33       (lambda ()
     34 	(display "<script type='text/javascript'>\n")
     35 	(apply spock
     36 	       'code (strip-syntax x)
     37 	       'environment (spock-state-mstore state)
     38 	       (append (spock-state-options state) options))
     39 	(display "\n</script>\n")))))
     40 
     41 ;;
     42 (define-syntax <spock>
     43   (er-macro-transformer
     44     (lambda (x r c)
     45      (let ((%cons (r 'cons))
     46    	   (%append (r 'append))
     47            (%list->vector (r 'list->vector))
     48            (%spock-script (r 'spock-script)))
     49     (define (unq x)
     50       (cond ((pair? x)
     51 	     (cond ((and (symbol? (car x)) 
     52 			 (list? x)
     53 			 (= (length x) 2)
     54 			 (eq? '<unquote> (strip-syntax (car x))))
     55 		    (cadr x))
     56 		   ((and (pair? (car x))
     57 			 (symbol? (caar x))
     58 			 (list? (car x))
     59 			 (= (length (car x)) 2)
     60 			 (eq? '<unquote-splicing> (strip-syntax (caar x))))
     61 		    `(,%append (cadar x) ,(unq (cdr x))))
     62 		   (else `(,%cons ,(unq (car x)) ,(unq (cdr x)))))) ;XXX could be improved
     63 	    ((vector? x)
     64 	     `(,%list->vector ,(unq (vector->list x))))
     65 	    (else `',x)))
     66     `(,%spock-script ,(unq (cadr x)))))))
     67 
     68 
     69 ;; read-syntax
     70 
     71 (set-sharp-read-syntax!
     72  #\`
     73  (lambda (port)
     74    `(<spock> ,(read port))))
     75 
     76 (set-sharp-read-syntax!
     77  #\^
     78  (lambda (port)
     79    (cond ((eqv? (peek-char port) #\@)
     80 	  (read-char port)
     81 	  `(<unquote-splicing> ,(read port)))
     82 	 (else `(<unquote> ,(read port))))))
     83 
     84 )