root/lang/scheme/3imp/opsym2code.scm @ 31152

Revision 31152, 1.5 kB (checked in by mokehehe, 5 years ago)

オペコードのシンボルから数値への変換ツール

Line 
1
2(define optbl
3  '((HALT ())
4    (REFER-LOCAL (n . $x))
5    (REFER-FREE (n . $x))
6    (REFER-GLOBAL (sym . $x))
7    (INDIRECT $x)
8    (CONSTANT (obj . $x))
9    (CLOSE (argnum n $body . $x))
10    (BOX (n . $x))
11    (TEST ($then . $else))
12    (ASSIGN-LOCAL (n . $x))
13    (ASSIGN-FREE (n . $x))
14    (ASSIGN-GLOBAL (sym . $x))
15    (CONTI (tail$ . $x))
16    (NUATE (stack . $x))
17    (FRAME ($x . $ret))
18    (ARGUMENT $x)
19    (SHIFT (n . $x))
20    (APPLY (argnum))
21    (RETURN ())
22    (DIRECT-INVOKE (argnum . $x))
23    (RETURN-DIRECT (n . $x))
24    ))
25
26
27(define *h* (make-hash-table))
28
29(let loop ((ls optbl)
30           (i 0))
31  (if (null? ls)
32      '()
33    (let* ((e (car ls))
34           (sym (car e))
35           (args (cadr e)))
36      (hash-table-put! *h* sym (list i args))
37      (loop (cdr ls) (+ i 1)))))
38
39
40(define (op-sym->code ls)
41  (define (each* f xs ys)
42    (set-car! ys (f (car xs) (car ys)))
43    (cond ((pair? (cdr xs))
44           (each* f (cdr xs) (cdr ys)))
45          ((null? (cdr xs))
46           '())
47          (else
48           (set-cdr! ys (f (cdr xs) (cdr ys))))))
49  (define (f sym val)
50    (if (eq? (string-ref (symbol->string sym) 0)
51             #\$)
52        (op-sym->code val)
53      val))
54 
55  (when (pair? ls)
56    (let1 sym (car ls)
57      (when (hash-table-exists? *h* sym)
58        (let* ((e (hash-table-get *h* sym))
59               (opid (car e))
60               (elems (cadr e)))
61          (set-car! ls opid)
62          (each* f (cons 'op elems) ls)))))
63  ls)
64
65
66(define (main args)
67  (until (read) eof-object? => sexp
68    (write/ss (op-sym->code sexp))
69    (newline)))
Note: See TracBrowser for help on using the browser.