niyarin

"if exists('g:loaded_coding_time_metaprogramming')
"    finish
"endif

"let g:loaded_coding_time_metaprogramming = 1


function! CheckSexp(exp) abort
    return  system("bb '(try (do (read-string \"" . a:exp .  "\") 1) (catch Exception ex 0))'")
endfunction

niyarin

;;'ck' procedure is copied from http://okmij.org/ftp/Scheme/macros.html#ck-macros
(define-syntax ck
 (syntax-rules (quote)
   ((ck () 'v) v)                      ; yield the value on empty stack

   ((ck (((op ...) ea ...) . s) 'v)    ; re-focus on the other argument, ea
    (ck s "arg" (op ... 'v) ea ...))

   ((ck s "arg" (op va ...))           ; all arguments are evaluated,
    (op s va ...))                    ; do the redex

niyarin

(import (nanopass) (rnrs))

(define (primitive-procedure? x)
  (or (eq? x 'eq?)
      (eq? x 'symbol?)
      (eq? x 'boolean?)))

(define-language piyo-lang
  (terminals
    (primitive-procedure (proc))

niyarin

(define-library (ephemeron-hash-table)
   (cond-expand
     (gauche
      (import (scheme base)
              (scheme ephemeron)
              ;Comparator(withdrawn)
              (only (srfi 114) eq-comparator comparator-hash))
      (begin (define %comparator eq-comparator)))
     (else
       (import (scheme base)

niyarin

(DEFINE ephemeron-queue '())

(DEFINE (trace-pointer-queueing-ephemerons obj)
   (UNLESS (MARKED? obj)
      (MARK-OBJECT! obj)
      (IF (EPHEMERON? obj)
         (PUSH! ephemeron-queue obj)
         (FOR-EACH trace-pointer-queueing-ephemerons
                   (REF-POINTERS obj)))))

niyarin

(define-syntax %ore-reverse
   (syntax-rules (syntax-lambda)
      ((_ "INTERNAL" (syntax-lambda (c-arg) c-body) (robj ...) ())
         (let-syntax ((cont-syntax
                        (syntax-rules ()
                           ((_ c-arg) c-body))))
            (cont-syntax
              (robj ...))))
      ((_ "INTERNAL" continuation (robj ...) (obj1 obj2 ...))
       (%ore-reverse "INTERNAL" continuation (obj1 robj ...) (obj2 ...)))

niyarin

JVM SCHEME 継続周り
https://www.politesi.polimi.it/bitstream/10589/108685/3/2015_07_Bernardini.pdf

SISC

niyarin

(define-library (niyarin condp)
   (import (scheme base))
   (export condp condp-right)

   (begin

    (define-syntax condp-aux
         (syntax-rules (else left right)
            ((_ _ test (used ... ) (else expression ...) clauses ...)
               (cond  used ... (else expression ...)))

niyarin

#include<stdio.h>
#include<stdlib.h>

#include<sys/mman.h>
#include<unistd.h>


void run(){
    unsigned char *code;
    int code_length = 64;

niyarin

(import (scheme base)(scheme write)(scheme cxr)(srfi 1))

(define sample-input
  '((x = a * b)
    (y = x + c)
    (d = a * b)
    (e = d - c)
    (e = d + c)))