Scheme debug方法

By guenchi at 2018-04-14 • 0人收藏 • 321人看过

以下援引 Andy Keep对我的回复:


https://github.com/cisco/ChezScheme/issues/287


% scheme
Chez Scheme Version 9.5.1
Copyright 1984-2017 Cisco Systems, Inc.

> (library-extensions (cons (cons ".sc" ".so") (library-extensions)))
> (import (json))
Exception: library (json) not found
Type (debug) to enter the debugger.
> (import (json json))
> (load "json/exemple.sc")
> (define-syntax json-reduce
    (lambda (x)
      (syntax-case x ()
        ((_ j v1 p) #'(reduce j v1 p))
        ((_ j v1 v2 p) #'(json-reduce j v1 (lambda (x y) (json-reduce y v2 (lambda (n m)(p (cons n x) m))))))
        ((_ j v1 v2 v3 p ...) #'(json-reduce j v1 v2 (lambda (x y) (json-reduce y v3 (lambda (n m)(p (cons n x) m)))) ...)))))
> (json-reduce y #t #t #t #t  (lambda (x y) x))
Exception: incorrect number of arguments to #<procedure>
Type (debug) to enter the debugger.

Now we can look at this in the debugger:

> (debug)
debug> i 
#<continuation in l>                                              : s
  continuation:          #<continuation in l>
  procedure code:        (lambda (x v p) (if (null? x) (quote ()) ...))
  call code:             (v (caar x))
  frame and free variables:
  0. x:                  (("1" . #(...)) ("2" . #(...)) ...)
  1. v:                  #<procedure>
  2. p:                  #<procedure>
#<continuation in l>                                              : file
line 303, character 41 of json/json.sc
#<continuation in l>                                              :

So, looks like line 303, character 41 of my modified (one line longer at the start with the reduce export) at the start:

299                         ((procedure? v)
300                             (let l ((x x)(v v)(p p))
301                                 (if (null? x)
302                                     '()
303                                     (if (v (caar x))   ; <== right here the procedure v is called with one arg
304                                         (cons (cons (caar x) (p (caar x) (cdar x)))(l (cdr x) v p))
305                                         (cons (cons (caar x) (cdar x)) (l (cdr x) v p ))))))

So, what happened? We can look at the expansion of the macro with expand:

> (print-gensym 'pretty)
> (expand '(json-reduce y #t #t #t #t  (lambda (x y) x)))
(begin
  (#3%$invoke-library '(json json) '() '#:json)
  (reduce
    y    #t
    (lambda (#:x #:y)
      (reduce
        #:y        #t
        (lambda (#:n #:m)
          (let ([#:x (#2%cons #:n #:x)] [#:y #:m])
            (reduce                    ;; <== This is the call to reduce that fails.
              #:y
              (lambda (#:x #:y)  ;; <== This is the lambda expression that is called, it expects 2 arguments, but only gets one.
                (reduce
                  #:y                  #t
                  (lambda (#:n #:m) (#t (#2%cons #:n #:x) #:m))))
              (lambda (#:n #:m)
                (let ([#:x (#2%cons #:n #:x)] [#:y #:m])
                  (reduce
                    #:y                    #t
                    (lambda (#:n #:m)
                      (let ([#:x (#2%cons #:n #:x)] [#:y #:m])
                        #:x))))))))))))

So, it looks like the macro is not produce the code you intended. A good tool for looking at this is trace-define-syntax:

> (trace-define-syntax json-reduce
    (lambda (x)
      (syntax-case x ()
        ((_ j v1 p) #'(reduce j v1 p))
        ((_ j v1 v2 p) #'(json-reduce j v1 (lambda (x y) (json-reduce y v2 (lambda (n m)(p (cons n x) m))))))
        ((_ j v1 v2 v3 p ...) #'(json-reduce j v1 v2 (lambda (x y) (json-reduce y v3 (lambda (n m)(p (cons n x) m)))) ...)))))
> (expand '(json-reduce y #t #t #t #t  (lambda (x y) x)))
|(json-reduce (json-reduce y #t #t #t #t (lambda (x y) x)))
|(json-reduce y #t #t (lambda (x y) (json-reduce y #t (lambda (n m) (#t (cons n x) m))))
   (lambda (x y)
     (json-reduce y #t (lambda (n m) ((lambda (x y) x) (cons n x) m)))))

Just to interject, it looks like things are already starting to go wrong here, because json-reducematched:
y => j
v1 => #t
v2 => #t
v3 => #t
(p ...) => (#t (lambda (x y) x))

Let's keep going:

|(json-reduce
   (json-reduce y #t #t (lambda (x y) (json-reduce y #t (lambda (n m) (#t (cons n x) m))))
     (lambda (x y)
       (json-reduce y #t (lambda (n m) ((lambda (x y) x) (cons n x) m))))))
|(json-reduce
   y   #t
   #t
   (lambda (x y)
     (json-reduce
       y
       (lambda (x y) (json-reduce y #t (lambda (n m) (#t (cons n x) m))))
       (lambda (n m)
         ((lambda (x y)
            (json-reduce y #t (lambda (n m) ((lambda (x y) x) (cons n x) m))))
           (cons n x)
           m)))))
|(json-reduce
   (json-reduce
     y     #t
     #t
     (lambda (x y)
       (json-reduce
         y
         (lambda (x y) (json-reduce y #t (lambda (n m) (#t (cons n x) m))))
         (lambda (n m)
           ((lambda (x y)
              (json-reduce y #t (lambda (n m) ((lambda (x y) x) (cons n x) m))))
             (cons n x)
             m))))))

Now we have our json-reduce with the y, (lambda (x y) ---), (lambda (n m) ---) arguments produced, and well it just goes on from there:

|(json-reduce
   y   #t
   (lambda (x y)
     (json-reduce
       y       #t
       (lambda (n m)
         ((lambda (x y)
            (json-reduce
              y
              (lambda (x y) (json-reduce y #t (lambda (n m) (#t (cons n x) m))))
              (lambda (n m)
                ((lambda (x y)
                   (json-reduce
                     y                     #t
                     (lambda (n m) ((lambda (x y) x) (cons n x) m))))
                  (cons n x)
                  m))))
           (cons n x)
           m)))))
|(json-reduce
   (json-reduce
     y     #t
     (lambda (x y)
       (json-reduce
         y         #t
         (lambda (n m)
           ((lambda (x y)
              (json-reduce
                y
                (lambda (x y)
                  (json-reduce y #t (lambda (n m) (#t (cons n x) m))))
                (lambda (n m)
                  ((lambda (x y)
                     (json-reduce
                       y                       #t
                       (lambda (n m) ((lambda (x y) x) (cons n x) m))))
                    (cons n x)
                    m))))
             (cons n x)
             m))))))
|(reduce
   y   #t
   (lambda (x y)
     (json-reduce
       y       #t
       (lambda (n m)
         ((lambda (x y)
            (json-reduce
              y
              (lambda (x y) (json-reduce y #t (lambda (n m) (#t (cons n x) m))))
              (lambda (n m)
                ((lambda (x y)
                   (json-reduce
                     y                     #t
                     (lambda (n m) ((lambda (x y) x) (cons n x) m))))
                  (cons n x)
                  m))))
           (cons n x)
           m)))))
|(json-reduce
   (json-reduce
     y     #t
     (lambda (n m)
       ((lambda (x y)
          (json-reduce
            y
            (lambda (x y) (json-reduce y #t (lambda (n m) (#t (cons n x) m))))
            (lambda (n m)
              ((lambda (x y)
                 (json-reduce
                   y                   #t
                   (lambda (n m) ((lambda (x y) x) (cons n x) m))))
                (cons n x)
                m))))
         (cons n x)
         m))))
|(reduce
   y   #t
   (lambda (n m)
     ((lambda (x y)
        (json-reduce
          y
          (lambda (x y) (json-reduce y #t (lambda (n m) (#t (cons n x) m))))
          (lambda (n m)
            ((lambda (x y)
               (json-reduce
                 y                 #t
                 (lambda (n m) ((lambda (x y) x) (cons n x) m))))
              (cons n x)
              m))))
       (cons n x)
       m)))
|(json-reduce
   (json-reduce
     y
     (lambda (x y) (json-reduce y #t (lambda (n m) (#t (cons n x) m))))
     (lambda (n m)
       ((lambda (x y)
          (json-reduce y #t (lambda (n m) ((lambda (x y) x) (cons n x) m))))
         (cons n x)
         m))))
|(reduce
   y
   (lambda (x y) (json-reduce y #t (lambda (n m) (#t (cons n x) m))))
   (lambda (n m)
     ((lambda (x y)
        (json-reduce y #t (lambda (n m) ((lambda (x y) x) (cons n x) m))))
       (cons n x)
       m)))
|(json-reduce (json-reduce y #t (lambda (n m) ((lambda (x y) x) (cons n x) m))))
|(reduce y #t (lambda (n m) ((lambda (x y) x) (cons n x) m)))
|(json-reduce (json-reduce y #t (lambda (n m) (#t (cons n x) m))))
|(reduce y #t (lambda (n m) (#t (cons n x) m)))
(begin
  (#3%$invoke-library '(json json) '() '#:json)
  (reduce
    y    #t
    (lambda (#:x #:y)
      (reduce
        #:y        #t
        (lambda (#:n #:m)
          (let ([#:x (#2%cons #:n #:x)] [#:y #:m])
            (reduce
              #:y
              (lambda (#:x #:y)
                (reduce
                  #:y                  #t
                  (lambda (#:n #:m) (#t (#2%cons #:n #:x) #:m))))
              (lambda (#:n #:m)
                (let ([#:x (#2%cons #:n #:x)] [#:y #:m])
                  (reduce
                    #:y                    #t
                    (lambda (#:n #:m)
                      (let ([#:x (#2%cons #:n #:x)] [#:y #:m])
                        #:x))))))))))))
>

All of that said, the last clause in the define-syntax is where things go wrong. I think maybe instead of matching (_ j v1 v2 v3 p ...), you might want to match (_ j v1 v2 v3 ... p), that way you get pbound to your lambda expression and v3 ... bound to any additional items. You'll also need to change the body of that clause to use v3 ... instead of p ...:

> (define-syntax json-reduce
    (lambda (x)
      (syntax-case x ()
        ((_ j v1 p) #'(reduce j v1 p))
        ((_ j v1 v2 p) #'(json-reduce j v1 (lambda (x y) (json-reduce y v2 (lambda (n m)(p (cons n x) m))))))
        ((_ j v1 v2 v3 ... p) #'(json-reduce j v1 v2 (lambda (x y) (json-reduce y v3 ... (lambda (n m)(p (cons n x) m)))))))))



其他的参考:

https://github.com/cisco/ChezScheme/issues/128

3 个回复 | 最后更新于 2018-04-18
2018-04-15   #1

你就是netmany?

2018-04-15   #2

回复#1 @evilbinary :

你傻不傻?

2018-04-18   #3

这个时候就体现出racket的macro stepper的好用了。。。

登录后方可回帖

登 录
信息栏

Scheme中文社区

推荐实现 ChezScheme / r6rs / r7rs large
theschemer.org
Q群: 724577239

精华导览

社区项目

包管理器:Raven
HTTP服务器:Igropyr (希腊火)
官方插件:vscode-chez

社区目标:

完善足以使Scheme工程化和商业化的库,特别是开发极致速度的Web服务器和ANN模块。

一直以来Scheme缺少一个活跃的中文社区,同时中文资料的稀少,导致大多数因为黑客与画家和SICP而接触Scheme的朋友,在学完SICP后无事可做,不能将Scheme转换为实际的生产力。最后渐渐的放弃。
同时Chicken等实现,却因效率问题无法与其他语言竞争。本社区只有一个目的,传播Scheme的文明之火,在最快的编译器实现上,集众人之力发展出足够与其他语言竞争的社区和库。


友情链接:

Clojure 中文论坛
函数式·China


Loading...