ArcJSを使って、Webページ上にミニゲームを作る

これは、2014年Lispアドベントカレンダーの最後12/25に投稿されるはずだった記事です。 年末が特に忙しく、5日も遅れてしましいました。すみません。「遅れちゃったしもういいかなー」とも思ったのですが、 このような記事も見つけてしまいまして、ほかでや…

JavaScriptでNode.JS/ブラウザ上で動くArc処理系を作った。

去年の夏ぐらいに、NodeJS/ブラウザ上で動くArc言語*1処理系「ArcJS」を作りました。 全体として2500行ぐらいでStackVMまで実装してあるので、処理系を作りたい人は参考になるかもしれません。http://smihica.github.io/arc-js/既に実際に仕事で部分的に使っ…

BoehmGCによる早すぎる解放

展示の為に、まとまった量のArcのコードを書いてglazeで実行したらsegvが頻発した。 調べてみるとまだ使用中のオブジェクトを解放してしまっていたようである。glazeは環境フレームをstd::vectorにオブジェクトを格納する形で実装していたが、もしかして、 s…

問題4.14

はてなDiaryの一日の文字数制限なのか、途中できられていたので書き直す。 メタScheme ;;; ;;; util ;;; (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) #f)) ;;; ;;; environment ;;; ;basic-proc (define the-empty-environment '()…

4章のメタschemeを参考に、C++でscheme処理系を作る。

大体3000行程度のC++になった。 もっとも単純な機能のschemeとなっている。macroやcall/ccはない。GCはboehmGCを使用した。 C++で作るにあたって、一番違ったのはreaderとobjectだった。 そこらへんを見ると参考になるかも。 githubにおいた micro-scheme gi…

問題4.13

(define (make-unbound-variable! var env) (define (env-loop env) (define (scan prev-vars vars prev-vals vals) (cond ((null? vars) (env-loop (enclosing-envrionment env))) ((eq? var (car vars)) (set-cdr! prev-vars (cdr vars)) (set-cdr! prev-v…

問題4.12

(define (env-loop null-proc find-proc name var env) (define (scan vars vals) (cond ((null? vars) (null-proc env)) ((eq? var (car vars)) (find-proc vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unb…

問題4.11

(define (make-frame variables values) (if (= (length variables) (length values)) (reverse (let make-frame-iter ((vars variables) (vals values)) (cons (cons (car vars) (cdr vals)) (make-frame-iter (cdr vars) (cdr vals))))) (error "variables…

問題4.10

;; しょうもない変更だが、let式を変更する。 (let ((a b) (c d) (e f))) ;; -> (let (a b c d e f)) ;; とかけるようにしよう。 (define (let->combination exp) (let ((second (cadr exp))) (let ((named? (symbol? second))) (let ((bindings (if named? …

問題4.9

;; doを作ってみる (do binds (predicate value) body) ;; である。 ;; binds部は ((var-name initialize-value update-expression) ... ) ;; である。 (do ((var-name1 initialize-value1 update-expression1) (var-name2 initialize-value2 update-express…

問題4.8

(define (fib n) (let fib-iter ((a 1) (b 0) (count n)) (if (= count 0) b (fib-iter (+ a b) a (- count 1))))) ;; -> (define (fib n) (let ((a 1) (b 0) (count n)) (define (fib-iter a b count) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))…

問題4.7

(let* ((x 3) (y (+ x 2)) (z (+ x y 5))) (* x z)) ;=> (let ((x 3)) (let ((y (+ x 2))) (let ((z (+ x y 5))) (* x z)))) (define (let*->nested-lets exp) (let ((bindings (cadr exp))) (let binds->lets ((binds bindings)) (if (null? (cdr binds)) (…

問題4.6

(define (let->combination exp) (let ((bindings (cadr exp))) (let ((vars (map car bindings)) (exps (map cadr bindings))) (append (list (append (list 'lambda vars) (cddr exp))) exps)))) (define (eval-let exp env) (eval (let->combitation exp)…

問題4.5

(define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (make-if predicate consequent alternative) (list 'if predicate consequent alternative)) (define (cond-clauses exp) (cdr exp)) (define (cond-predicate clause) (car clause))…

問題4.4

(define (eval-and-sequence exps env) (if (null? exps) 'true (if (true? (eval (first-exp exps) env)) (eval-and-sequence (rest-exps exps) env) 'false))) (define (eval-and exp env) (eval-and-sequence (cdr exp) env)) (put 'eval 'and eval-and) …

問題4.3

(define (eval exp env) (cond ((self-evaluationg? exp) exp) ((variable? exp) (lookup-variable-value exp env)) (else (let ((proc (get 'eval (car exp)))) (if proc (proc exp env) (if (application? exp) (apply (eval (operator exp) env) (list-of…

問題4.2

(define (eval exp env) (cond ((self-evaluationg? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((call? exp) (apply (eval (operator exp) env…

問題4.1

;; 4.1 ;L->R (define (list-of-values exps env) (if (no-operands? exps) '() (let ((val (eval (first-operand exps) env))) (cons val (list-of-values (rest-operands exps) env))))) ;R->L (define (list-of-values exps env) (if (no-operands? exps)…

問題3.38

並列性の問題は一時とばす。 後で必ず戻る。 4章までワープ

問題3.37

(define (subtracter a b c) (adder c b a)) (define (divider a b c) (multiplier c b a)) (define (c+ x y) (let ((z (make-connector))) (adder x y z) z)) (define (c- x y) (let ((z (make-connector))) (subtracter x y z) z)) (define (c* x y) (let …

問題3.36

図は面倒 心の中に思い描いた。

問題3.35

(define (squarer a b) (define (process-new-value) (if (has-value? b) (if (< (get-value b) 0) (error "square less than 0 -- SQUARER" (get-value b)) (set-value! a (sqrt (get-value b)) me)) (if (has-value? a) (set-value! b (* (get-value a) (g…

問題3.34

(define (squarer a b) (multiplier a a b)) (define a (make-connector)) (define b (make-connector)) (squarer a b) (probe "A" a) (probe "B" b) (set-value! a -3 'user) ;Probe: B = 9 (forget-value! a 'user) (set-value! b 9 'user) ;Probe: B = 9 …

問題3.33

(define (averager a b c) (let ((d (make-connector)) (e (make-connector))) (adder a b d) (multiplier d e c) (constant 0.5 e) 'ok)) (define a (make-connector)) (define b (make-connector)) (define c (make-connector)) (averager a b c) (probe "…

問題3.32

(define the-agenda (make-agenda)) (define a1 (make-wire)) (define a2 (make-wire)) (define output (make-wire)) (probe 'a1 a1) (probe 'a2 a2) (probe 'output output) (and-gate a1 a2 output) (set-signal! a1 0) (set-signal! a2 1) (propagate) (s…

問題3.31

;wireの実装上、信号が切り替わったときにしか登録したactionは実行されないため、 ;もし、ある回路シミュレーターの入力値が変化しなかった場合、出力側が正しくない値だったとしても、actionが実行されず修正されないことが起こりうる。 ;よって初めに、回…

問題3.30

(define (ripple-carry-adder ak bk sk c) (let ((ck (map (lambda (x) (make-wire)) sk))) (let iter (ak bk sk ck) (if (null? (cdr ck)) (full-adder (car ak) (car bk) (car ck) (car sk) c) (begin (full-adder (car ak) (car bk) (car ck) (car sk) (c…

問題3.29

;;意外と思いつかなかった。20分も悩んだ。 (define (or-gate a1 a2 output) (let ((a3 (make-wire)) (a4 (make-wire)) (o1 (make-wire))) (inverter a1 a3) (inverter a2 a4) (and-gate a3 a4 o1) (inverter o1 output) 'ok)) ;;遅延時間は (+ (* inverter-…

問題3.28

(define a (make-wire)) (define b (make-wire)) (define c (make-wire)) (define d (make-wire)) (define e (make-wire)) (define s (make-wire)) (or-gate a b d) (and-gate a b c) (inverter c e) (and-gate d e s) (define (half-adder a b s c) (let ((…

問題3.27

(define (fib n) (cond ((= n 0) 0) ((= n 1) 1) (else (+ (fib (- n 1)) (fib (- n 2)))))) ;(time (fib 35)) ; real 3.050 ; user 3.010 ; sys 0.040 9227465 (define (memorize f) (let ((table (make-table))) (let ((get (table 'lookup-proc)) (put (t…

問題3.26

(define (make-table) (let ((local-table (cons '*table* '()))) (define (make-tree entry left right) (list entry left right)) (define (entry tree) (car tree)) (define (left-branch tree) (cadr tree)) (define (right-branch tree) (caddr tree)) …

問題3.25

(define (make-table same-key?) (let ((local-table (list '*table*))) (define (assoc2 key records test) (cond ((null? records) #f) ((test key (caar records)) (car records)) (else (assoc2 key (cdr records) test)))) (define (lookup-iter keys t…

問題3.24

(define (make-table same-key?) (let ((local-table (list '*table*))) (define (assoc2 key records test) (cond ((null? records) #f) ((test key (caar records)) (car records)) (else (assoc2 key (cdr records) test)))) (define (lookup key-1 key-2…

問題3.23

(cons back-pointer (cons item next-pointer)) ;この形を一つのqueueオブジェクトとする。 ;項目が3個なのでclosureでやる手もあるが、メモリコピーが多発し消費が激しいためlistのポインタを使う。 ;schemeはconsを扱うことでメモリ操作が出来るらしい。 (…

問題3.22

(define (make-queue) (let ((front-ptr '()) (rear-ptr '())) (define (empty?) (null? front-ptr)) (define (set-front-ptr! item) (set! front-ptr item)) (define (set-rear-ptr! item) (set! rear-ptr item)) (define (insert! item) (let ((new-pair (…

問題3.21

(define (front-ptr q) (car q)) (define (rear-ptr q) (cdr q)) (define (set-front-ptr! q i) (set-car! q i)) (define (set-rear-ptr! q i) (set-cdr! q i)) (define (empty-queue? q) (null? (front-ptr q))) (define (make-queue) (cons '() '())) (def…

問題3.20

図は面倒

問題3.19

; listがループしていなければ、絶対に交わることの無い二つのイテレータによって解決する。 ; イテーレータxが2進む間にイテレータyは1進む。 (define (include-loop-2? x) (define (iter x y toggle) (if (not (pair? x)) #f (if (eq? x y) #t (iter (cdr …

問題3.18

(define (include-loop? x) (define first-point x) (define (iter x) (if (null? x) #f (or (eq? first-point x) (iter (cdr x))))) (iter (cdr x))) ;;出来たと思ったが、これだと途中から途中へ循環している場合に対応できない。 (define a '(1 2 3)) (se…

問題3.17

(define (count-pairs-2 x) (define counted-pairs '()) (define (add-pair! p) (set! counted-pairs (cons p counted-pairs))) (define (already-counted? p) (memq p counted-pairs)) (define (iter x) (if (or (not (pair? x)) (already-counted? x)) 0 (…

問題3.16

(define (count-pairs x) (if (not (pair? x)) 0 (+ (count-pairs (car x)) (count-pairs (cdr x)) 1))) ;;3 (define a (cons 1 (cons 2 (cons 3 '())))) (count-pairs a) ;-> 3 ;;4 (define a (cons '() '())) (define b (cons '() '())) (define c (cons '…

問題3.15

図はめんどう。 z1はリスト構造が一つしかなく、それにcar部とcdr部が両方接続しているため、set-car!によってポインタを変更すると両方とも変わる。 z2はリスト構造が二つあるため、car部が接続しているリストのcarポインタが変更されるだけである。

問題3.14

(define (mystery x) (define (loop x y) (if (null? x) y (let ((temp (cdr x))) (set-cdr! x y) (loop temp x)))) (loop x '())) ;;リストを破壊的に逆転させる? (mystery '(1 2 3 4 5)) (5 4 3 2 1) ;; ok (define v '(a b c d)) (define w (mystery v))…

問題3.13

最後のcdrに格納されるポインタが、トップをさすような構造。 (last-pair z)は無限ループを引き起こす。

問題3.12

;; 1: (a b) ;; 2: (a b c d)

問題3.11

局所手続きの部分もbalanceと同じように、別々に保持される。 基本的に共有されない。

問題3.10

図はめんどいので飛ばす。 内部環境の箱が縦に並ぶような形になる。

問題3.9

図はめんどいので飛ばす。 再帰版はすべて横並び 反復版はfact-iterが横並び。

問題3.8

(define f (let ((m 0) (n 0)) (lambda (x) (set! m n) (set! n x) m)))

問題3.7

(define (make-account balance password) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define …