Arcの中を見る

arc.arcにdefの定義と、=マクロの定義がある。どちらも最終的にはsetを呼んでいる。defはすでにある名前だと警告を表示する(何で出なかったんだろう)。safesetからsetが呼ばれ、=は単にsetになっている。

(set safeset (annotate 'mac
               (fn (var val)
                 `(do (if (bound ',var)
                          (do (disp "*** redefining ")
                              (disp ',var)
                              (writec #\newline)))
                      (set ,var ,val)))))

(set def (annotate 'mac
            (fn (name parms . body)
              `(do (sref sig ',parms ',name)
                   (safeset ,name (fn ,parms ,@body))))))

(def expand= (place val)
  (if (isa place 'sym)
      `(set ,place ,val)
      (let (vars prev setter) (setforms place)
        (w/uniq g
          `(atwith ,(+ vars (list g val))
             (,setter ,g))))))

(def expand=list (terms)
  `(do ,@(map (fn ((p v)) (expand= p v))  ; [apply expand= _]
                  (pair terms))))

(mac = args
  (expand=list args))

arcの本体はac.scm。arc中のbuiltinは、この中でxdefで定義されている。

(define (xdef a b)
  (namespace-set-variable-value! (ac-global-name a) b)
  b)

(xdef 'cons cons)

(xdef 'car (lambda (x)
             (cond ((pair? x)     (car x))
                   ((eqv? x 'nil) 'nil)
                   ((eqv? x '())  'nil)
                   (#t            (err "Can't take car of" x)))))

(xdef 'cdr (lambda (x)
             (cond ((pair? x)     (cdr x))
                   ((eqv? x 'nil) 'nil)
                   ((eqv? x '())  'nil)
                   (#t            (err "Can't take cdr of" x)))))

インタプリタの本体はac。トップレベルas.scmからのコールでは、(tl => tl2もしくはaload => aload1) => arc-eval => acという感じでたどり着く。

(define (ac s env)
  (cond ((string? s) (string-copy s))  ; to avoid immutable strings
        ((literal? s) s)
        ((eqv? s 'nil) (list 'quote 'nil))
        ((ssyntax? s) (ac (expand-ssyntax s) env))
        ((symbol? s) (ac-var-ref s env))
        ((ssyntax? (xcar s)) (ac (cons (expand-ssyntax (car s)) (cdr s)) env))
        ((eq? (xcar s) 'quote) (list 'quote (ac-niltree (cadr s))))
        ((eq? (xcar s) 'quasiquote) (ac-qq (cadr s) env))
        ((eq? (xcar s) 'if) (ac-if (cdr s) env))
        ((eq? (xcar s) 'fn) (ac-fn (cadr s) (cddr s) env))
        ((eq? (xcar s) 'set) (ac-set (cdr s) env))
        ; this line could be removed without changing semantics
        ((eq? (xcar (xcar s)) 'compose) (ac (decompose (cdar s) (cdr s)) env))
        ((pair? s) (ac-call (car s) (cdr s) env))
        (#t (err "Bad object in expression" s))))

ac-callが関数よびだし

(define (ac-call fn args env)
  (let ((macfn (ac-macro? fn)))
    (cond (macfn
           (ac-mac-call macfn args env))
          ((and (pair? fn) (eqv? (car fn) 'fn))
           `(,(ac fn env) ,@(map (lambda (x) (ac x env)) args)))
          ((= (length args) 0)
           `(ar-funcall0 ,(ac fn env) ,@(map (lambda (x) (ac x env)) args)))
          ((= (length args) 1)
           `(ar-funcall1 ,(ac fn env) ,@(map (lambda (x) (ac x env)) args)))
          ((= (length args) 2)
           `(ar-funcall2 ,(ac fn env) ,@(map (lambda (x) (ac x env)) args)))
          ((= (length args) 3)
           `(ar-funcall3 ,(ac fn env) ,@(map (lambda (x) (ac x env)) args)))
          ((= (length args) 4)
           `(ar-funcall4 ,(ac fn env) ,@(map (lambda (x) (ac x env)) args)))
          (#t
           `(ar-apply ,(ac fn env)
                      (list ,@(map (lambda (x) (ac x env)) args)))))))

先にひっかかったリストに整数を渡すと返す処理はar-applyに入っていた。

(define (ar-apply fn args)
  (cond ((procedure? fn) (apply fn args))
        ((pair? fn) (list-ref fn (car args)))
        ((string? fn) (string-ref fn (car args)))
        ((hash-table? fn) (ar-nill (hash-table-get fn (car args) #f)))
; experiment: means e.g. [1] is a constant fn
;       ((or (number? fn) (symbol? fn)) fn)
; another possibility: constant in functional pos means it gets 
; passed to the first arg, i.e. ('kids item) means (item 'kids).
        (#t (err "Function call on inappropriate object" fn args))))