Функция трассировки, написанная на языке Rebol

#rebol #red #rebol3

Вопрос:

В Rebol (Красный, R3 Ren-c) можно написать функцию, аналогичную TRACE, которая дает следующий результат:

 foo: func [val1 val2 /local temp] [
       temp: val1   5
       val2   temp
]
bar: func [x /ris 'var "blablalba"][
       if ris [set var "fatto"]
       (foo x 2)   8
]
trace [foo bar]
bar/ris 7 yyy

Enter BAR
   x = 7
   var = yyy
     Enter FOO
       val1 = 7
       val2 = 2
     FOO returned 14
BAR returned 22
 

Комментарии:

1. Это определенно возможно. У Бориса есть пара функций трассировки в этом репозитории , которые демонстрируют инкрементную оценку с обратным вызовом.

Ответ №1:

На уровне пользователя наиболее простым подходом является написание оболочки, подобной закрытию, которая вызывала бы крючки трассировки, которые вы предоставляете до и после вызова основного кода, и которые затем возвращали бы результат оценки.

Набросок этой идеи красным цветом выглядит следующим образом:

 frame-of: function [
    func [function!]
    /local
        match
][
    parse spec-of :func [
        collect any [
            set match [not quote return: all-word!] keep (to word! match)
            | skip
        ]
    ]
]

report: function [frame [block!]][
    environment: construct collect [forall frame [keep to set-word! frame/1]]
    also environment set environment reduce frame
]

trace: function [
    'target [word!]
    enter   [block!]
    leave   [block!]
][
    chain: reduce [
        'do enter
        'set/any quote 'result 'do body-of get target
        'do leave
        quote :result
    ]
    
    new:  func spec-of get target chain
    info: context [
        frame:  bind frame-of get target :new
        name:   target
        result: none
    ]
    
    bind body-of :new info
    set target :new
    exit
]
 

С учетом этого вы можете затем:

 enter: [print ['entering name 'with mold/flat body-of report frame]]
leave: [print [name 'returned result]]

trace foo enter leave
trace bar enter leave
 

Что, например, дает:

 >> bar/ris 7 yyy
entering bar with [x: 7 ris: true var: 'yyy]
entering foo with [val1: 7 val2: 2 local: false temp: none]
foo returned 14
bar returned 22
== 22
 

Имейте в виду, что это всего лишь PoC. Основная идея заключается в том, что ваша исходная функция заменяется инструментальной версией, созданной с помощью закрытия некоторого внутреннего пространства имен с информацией об отладке. Вы также можете добавить немного Red/System в смесь, чтобы получить детальный доступ к информации о времени выполнения, например, к стеку оценки.

Я оставляю довольно-печать с отступом и отключением трассировки в качестве упражнения для читателя 😉

Ответ №2:

Это решение, не очень элегантное, работает как на Red, так и на Rebol и должно соответствовать требованиям спроса (надеюсь, я рассмотрел все случаи).:

 extract-args: func [args-block /local emit result rules w ref] [
    result: copy []
    emit: func [x] [append result x]
    rules: [
        any [
                /local some [word!]
            |   set w [word! | get-word!] (emit w)
            |   set w lit-word! (emit to-get-word w)
            |   [string! | block!]
            |   set ref refinement! set w [word! | lit-word! | get-word!] 
                    (if ref [emit w])
            |   refinement!
        ]
    ]
    parse args-block rules
    result
]

pretty-print-args: func [spc /wrd] [
    foreach wrd extract-args spc [
            print [**indentation** "  " to-string wrd " = " get wrd]
    ]
]

insert-**result**: func [spc] [
    either find spc quote /local 
        [append spc [**result**]]
        [append spc [/local **result**]]
]

**indentation**: copy ""
add-1-ind: func [][append **indentation** copy "   "]
remove-1-ind: func [] [remove/part skip tail **indentation** -3 3]

my-trace: func [wrds /local w spc bdy bdy' uw] [
    foreach w wrds [
        uw: uppercase to-string w
        spc: copy spec-of get w
        insert-**result** spc
        bdy: body-of get w
        bdy': compose/deep copy [
            add-1-ind
            print [**indentation** "Enter" (uw)]
            pretty-print-args [(spc)]
            set/any '**result** do [(bdy)]
            print [**indentation** (uw) "returned" mold :**result**]
            remove-1-ind
            :**result**
        ]
        set w func spc bdy'
    ]
]
 

Затем:

 >> my-trace [foo bar]
== func [x /ris 'var "blablalba" /local **result**][
    add-1-ind 
...

>> bar/ris 7 yyy
    Enter  BAR
       x  =  7
       var  =  yyy
       Enter  FOO
          val1  =  7
          val2  =  2
       FOO  returned  14
    BAR  returned  22
== 22
>> source bar
bar: func [x /ris 'var "blablalba" /local **result**][
    add-1-ind 
    print [**indentation** "Enter" "BAR"] 
    pretty-print-args [x /ris 'var "blablalba" /local **result**] 
    set/any '**result** do [
        if ris [set var "fatto"] 
        (foo x 2)   8
    ] 
    print [**indentation** "BAR" "returned" mold :**result**] 
    remove-1-ind 
    :**result**
]