It is possible in Rebol (Red, R3 Ren-c) to write a function similar to TRACE that produces the following result:
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
At the user-level, the most straightforward approach is to write a closure-like wrapper that would call tracing hooks you provide before and after calling the main code, and which then would return the result of evaluation.
A rough sketch of that idea in Red is as follows:
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
]
With that in place, you can then:
enter: [print ['entering name 'with mold/flat body-of report frame]]
leave: [print [name 'returned result]]
trace foo enter leave
trace bar enter leave
Which, for your example, gives:
>> 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
Mind that this is just a PoC. The basic idea is that your original function gets replaced by an instrumented version, created via a closure over some internal namespace with debugging info. You can also throw some Red/System into the mix to gain fine-grained access to runtime information, like e.g. evaluation stack.
I am leaving pretty-printing with indentation and disabling of tracing as an exercise for the reader ;)
This solution, not very elegant, works on both Red and Rebol and should meet the demand requirements (I hope I have considered all cases):
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'
]
]
Then:
>> 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**
]
Related
I know blocks can be passed and used in that way.
But is there any way to call a block, just by having a block? Something like this?
aBlock := [ ... ].
aBlock run.
I tried searching for the BlockClosure class in the System browser, but couldn't find it.
Yes! And in fact, you can do pretty interesting things with them, like activating them within themselves. For example, this block computes factorial recursively calling itself:
factorialBlock := [:n |
n <= 1
ifTrue: [n]
ifFalse: [n * (factorialBlock value: n - 1)]
]
and to try it:
factorialBlock value: 5
That would not be an example of a very good coding practice, but it is of the power of block closures!
Let's add that besides value, if your block has arguments, you can also use
[:f | <do something with f>] value: a
where f is a formal argument (an unbound variable name) and a is an actual object that will bind to f when #value: is sent.
For two arguments use value:value: and for many valueWithArguments:, which receives an Array.
Examples
[:x | x squared - 1] value: 3
-> 3 squared - 1 (i.e., 8)
[:x :y | x + 2 / (y - 4)] value: 2 value: 0
-> 2 + 2 / (0 - 4) (i.e., -1)
Exercise
What's the result of evaluating the following?:
block := [:x | x value: 2].
block value: [:y | y + 1]
Yes it can. Also, you send the message 'value' to it to evaluate the block, not 'run'. In fact, you do not have to assign it to a variable. You can just do this:
[ ... ] value.
Check this one:
Lambda Calculus in Pharo
Yes, the Y Combinator is useful in normal programs
https://medium.com/concerning-pharo/lambda-calculus-in-pharo-a4a571869594#.2a78xp31s
From the article:
ycombinator := [ :f |
[ :g | g value: g ] value: [ :g |
f value: [ :x |
(g value: g) value: x ] ] ]
The force is strong in this one.
In R2 and R3, I can use unique to remove duplicate items from a series:
>> a: [1 2 2 3]
>> length? a
== 4
>> length? unique a
== 3
How can I perform the same operation on a series of objects? e.g.,
b: reduce [
make object! [a: 1]
make object! [b: 2]
make object! [b: 2]
make object! [c: 3]
]
>> length? b
== 4
>> length? unique b
== 4 ; (I'd like it to be 3)
The implementation of the equality check in UNIQUE and the other set operations appears to be Cmp_Value, and the way the comparison is done is to subtract the frame pointers of the objects. If that subtraction is zero (e.g. these are the SAME? object) then the comparison is considered a match:
f-series.c Line 283, R3-Alpha open source release
If you look at the surrounding code you'll see a call to Cmp_Block in that same routine. In the case of Cmp_Block it does a recursive comparison, and honors the case sensitivity...hence the difference between how blocks and objects act:
Cmp_Block() in f-series.c
Given that it is written that way, if you would like a UNIQUE operation to be based on field-by-field comparison of objects vs. their identity, there's no way to do it besides writing your own routine and calling EQUAL?...or modifying the C code.
Here is a short hack not requiring changing the C source, which does a MAP-EACH over the output of UNIQUE. The body filters out any EQUAL? objects that have already been seen (because when the body of a MAP-EACH returns unset, it adds nothing to the result):
my-unique: function [array [block!]] [
objs: copy []
map-each item unique array [
if object? :item [
foreach obj objs [
if equal? item obj [unset 'item break]
]
unless unset? :item [append objs item]
]
:item ;-- if unset, map-each adds nothing to result
]
]
Unfortunately you have to use a BLOCK! and not a MAP! to keep track of the objects as you go, because MAP! does not currently allow objects as keys. If they had allowed it, they would have probably had the same issue of not hashing field-equal objects the same.
(Note: Fixing this and other issues are on the radar of the Ren-C branch, which in addition to now being the fastest Rebol interpreter with fundamental fixes, also has a bit of enhancements to the set operations. Discussions in chat)
EQUAL? and SAME? returns true for objects only if they are same object references.
I wrote a function to check similarity between objects, it returns true if two objects have same words with same values and same types:
similar?: func [
{Returns true if both object has same words in same types.}
o [object!] p [object!] /local test
][
test: [if not equal? type? get in o word type? get in p word [return false]]
foreach word sort first o test
foreach word sort first p test
true
]
You can test as follow:
>> o: make object! [b: 2]
>> p: make object! [b: 2]
>> equal? o p
== false
>> same? o p
== false
>> similar? o p
== true
You may use it in your case.
unique+: func [array [block!]] [
objs: copy []
map-each item unique array [
if object? :item [
foreach obj objs [
if equal-object? :item :obj [unset 'item break]
]
if value? 'item [append objs item]
]
;-- If unset, map-each adds nothing to result under R3.
; R2 behaves differently. This works for both.
either value? 'item [:item] [()]
]
]
equal-object?: func [
"Returns true if both objects have same words and values."
o [object!] p [object!]
][
if not equal? sort words-of o sort words-of p [return false]
foreach word words-of o [
if not equal? o/:word p/:word [return false]
]
true
]
I attempted to write a C-style for-loop in REBOL:
for [i: 0] [i < 10] [i: i + 1] [
print i
]
This syntax doesn't appear to be correct, though:
*** ERROR
** Script error: for does not allow block! for its 'word argument
** Where: try do either either either -apply-
** Near: try load/all join %/users/try-REBOL/data/ system/script/args...
Does REBOL have any built-in function that is similar to a C-style for loop, or will I need to implement this function myself?
The equivalent construct in a C-like language would look like this, but I'm not sure if it's possible to implement the same pattern in REBOL:
for(i = 0; i < 10; i++){
print(i);
}
Because of the rebol3 tag, I'll assume this question pertains to Rebol 3.
Proposed "CFOR" for Rebol 3
For Rebol 3, there is a proposal (which got quite a bit of support) for a "general loop" very much along the lines of a C-style for and therefore currently going under the name of cfor as well: see CureCode issue #884 for all the gory details.
This includes a much refined version of Ladislav's original implementation, the current (as of 2014-05-17) version I'll reproduce here (without the extensive inline comments discussing implementation aspects) for the sake of easy reference:
cfor: func [ ; Not this name
"General loop based on an initial state, test, and per-loop change."
init [block! object!] "Words & initial values as object spec (local)"
test [block!] "Continue if condition is true"
bump [block!] "Move to the next step in the loop"
body [block!] "Block to evaluate each time"
/local ret
] [
if block? init [init: make object! init]
test: bind/copy test init
body: bind/copy body init
bump: bind/copy bump init
while test [set/any 'ret do body do bump get/any 'ret]
]
General problems with user-level control structure implementations in Rebol 3
One important general remark for all user-level implementation of control constructs in Rebol 3: there is no analogue to Rebol 2's [throw] attribute in R3 yet (see CureCode issue #539), so such user-written ("mezzanine", in Rebol lingo) control or loop functions have problems, in general.
In particular, this CFOR would incorrectly capture return and exit. To illustrate, consider the following function:
foo: function [] [
print "before"
cfor [i: 1] [i < 10] [++ i] [
print i
if i > 2 [return true]
]
print "after"
return false
]
You'd (rightly) expect the return to actually return from foo. However, if you try the above, you'll find this expectation disappointed:
>> foo
before
1
2
3
after
== false
This remark of course applies to all the user-level implementation given as answers in this thread, until bug #539 is fixed.
There is an optimized Cfor by Ladislav Mecir
cfor: func [
{General loop}
[throw]
init [block!]
test [block!]
inc [block!]
body [block!]
] [
use set-words init reduce [
:do init
:while test head insert tail copy body inc
]
]
The other control structure that most people would use in this particular case is repeat
repeat i 10 [print i]
which results in:
>> repeat i 10 [print i]
1
2
3
4
5
6
7
8
9
10
I generally do no use loop very often, but it can be used to a similar extent:
>> i: 1
>> loop 10 [print ++ i]
1
2
3
4
5
6
7
8
9
10
Those are some useful control structures. Not sure if you were looking for cfor but you got that answer from others.
I have implemented a function that works in the same way as a C for loop.
cfor: func [init condition update action] [
do init
while condition [
do action
do update
]
]
Here's an example usage of this function:
cfor [i: 0] [i < 10] [i: i + 1] [
print i
]
For simple initial value, upper limit and step, following works:
for i 0 10 2
[print i]
This is very close to C for loop.
I usually program by functions in an "instinctive" manner, but my current problem can be easily solved by objects, so I go ahead with this method.
Doing so, I am trying to find a way to give an object a constructor method, the equivalent of init() in python, for example.
I looked in the http://www.rebol.com/docs/core-fr/fr-index.html documentation, but I couldn't find anything relevant.
There is no special constructor function in Rebol, but there is a possibility to write ad hoc init code if you need it on object's creation in the spec block. For example:
a: context [x: 123]
b: make a [
y: x + 1
x: 0
]
So, if you define your own "constructor" function by convention in the base object, you can call it the spec block on creation. If you want to make it automatic, you can wrap that in a function, like this:
a: context [
x: 123
init: func [n [integer!]][x: n]
]
new-a: func [n [integer!]][make a [init n]]
b: new-a 456
A more robust (but bit longer) version of new-a that would avoid the possible collision of passed arguments to init with object's own words would be:
new-a: func [n [integer!] /local obj][
also
obj: make a []
obj/init n
]
You could also write a more generic new function that would take a base object as first argument and automatically invoke a constructor-by-convention function after cloning the object, but supporting optional constructor arguments in a generic way is then more tricky.
Remember that the object model of Rebol is prototype-based (vs class-based in Python and most other OOP languages), so the "constructor" function gets duplicated for each new object created. You might want to avoid such cost if you are creating a huge number of objects.
To my knowledge, there is no formal method/convention for using object constructors such as init(). There is of course the built-in method of constructing derivative objects:
make prototype [name: "Foo" description: "Bar"]
; where type? prototype = object!
My best suggestion would be to define a function that inspects an object for a constructor method, then applies that method, here's one such function that I've proposed previously:
new: func [prototype [object!] args [block! none!]][
prototype: make prototype [
if in self 'new [
case [
function? :new [apply :new args]
block? :new [apply func [args] :new [args]]
]
]
]
]
The usage is quite straightforward: if a prototype object has a new value, then it will be applied in the construction of the derivative object:
thing: context [
name: description: none
new: [name: args/1 description: args/2]
]
derivative: new thing ["Foo" "Bar"]
note that this approach works in both Rebol 2 and 3.
Actually, by reading again the Rebol Core documentation (I just followed the good old advice: "Read The French Manual"), there is another way to implement a constructor, quite simple:
http://www.rebol.com/docs/core-fr/fr-rebolcore-10.html#section-8
Of course it is also in The English Manual:
http://www.rebol.com/docs/core23/rebolcore-10.html#section-7
=>
Another example of using the self variable is a function that clones
itself:
person: make object! [
name: days-old: none
new: func [name' birthday] [
make self [
name: name'
days-old: now/date - birthday
]
]
]
lulu: person/new "Lulu Ulu" 17-May-1980
print lulu/days-old
7366
I find this quite convenient, and this way, the constructor lies within the object. This fact makes the object more self-sufficient.
I just implemented that successfully for some geological stuff, and it works well:
>> source orientation
orientation: make object! [
matrix: []
north_reference: "Nm"
plane_quadrant_dip: ""
new: func [{Constructor, builds an orientation object! based on a measurement, as given by GeolPDA device, a rotation matrix represented by a suite of 9 values} m][
make self [
foreach [a b c] m [append/only matrix to-block reduce [a b c]]
a: self/matrix/1/1
b: self/matrix/1/2
c: self/matrix/1/3
d: self/matrix/2/1
e: self/matrix/2/2
f: self/matrix/2/3
g: self/matrix/3/1
h: self/matrix/3/2
i: self/matrix/3/3
plane_normal_vector: reduce [matrix/1/3
matrix/2/3
matrix/3/3
]
axis_vector: reduce [self/matrix/1/2
self/matrix/2/2
self/matrix/3/2
]
plane_downdip_azimuth: azimuth_vector plane_normal_vector
plane_direction: plane_downdip_azimuth - 90
if (plane_direction < 0) [plane_direction: plane_direction - 180]
plane_dip: arccosine (plane_normal_vector/3)
case [
((plane_downdip_azimuth > 315) or (plane_downdip_azimuth <= 45)) [plane_quadrant_dip: "N"]
((plane_downdip_azimuth > 45) and (plane_downdip_azimuth <= 135)) [plane_quadrant_dip: "E"]
((plane_downdip_azimuth > 135) and (plane_downdip_azimuth <= 225)) [plane_quadrant_dip: "S"]
((plane_downdip_azimuth > 225) and (plane_downdip_azimuth <= 315)) [plane_quadrant_dip: "W"]
]
line_azimuth: azimuth_vector axis_vector
line_plunge: 90 - (arccosine (axis_vector/3))
]
]
repr: func [][
print rejoin ["Matrix: " tab self/matrix
newline
"Plane: " tab
north_reference to-string to-integer self/plane_direction "/" to-string to-integer self/plane_dip "/" self/plane_quadrant_dip
newline
"Line: " tab
rejoin [north_reference to-string to-integer self/line_azimuth "/" to-string to-integer self/line_plunge]
]
]
trace_te: func [diagram [object!]][
len_queue_t: 0.3
tmp: reduce [
plane_normal_vector/1 / (square-root (((plane_normal_vector/1 ** 2) + (plane_normal_vector/2 ** 2))))
plane_normal_vector/2 / (square-root (((plane_normal_vector/1 ** 2) + (plane_normal_vector/2 ** 2))))
]
O: [0 0]
A: reduce [- tmp/2
tmp/1
]
B: reduce [tmp/2 0 - tmp/1]
C: reduce [tmp/1 * len_queue_t
tmp/2 * len_queue_t
]
L: reduce [- axis_vector/1 0 - axis_vector/2]
append diagram/plot [pen black]
diagram/trace_line A B
diagram/trace_line O C
diagram/trace_line O L
]
]
>> o: orientation/new [0.375471 -0.866153 -0.32985 0.669867 0.499563 -0.549286 0.640547 -0.0147148 0.767778]
>> o/repr
Matrix: 0.375471 -0.866153 -0.32985 0.669867 0.499563 -0.549286 0.640547 -0.0147148 0.767778
Plane: Nm120/39/S
Line: Nm299/0
Another advantage of this way is that variables defined by the "new" method directly belongs to the object "instance" (I ran into some trouble, with the other methods, having to mention self/ sometimes, having to initialize variables or not).
I'm trying to find out how OO works in REBOL. Prototypical indeed. Yesterday I came across this page, which inspired me to the classical OO model below, without duplication of functions:
;---- Generic function for class or instance method invocation ----;
invoke: func [
obj [object!]
fun [word!]
args [block!]
][
fun: bind fun obj/.class
;---- Class method names start with a dot and instance method names don't:
unless "." = first to-string fun [args: join args obj]
apply get fun args
]
;---- A class definition ----;
THIS-CLASS: context [
.class: self ; the class refers to itself
;---- Class method: create new instance ----;
.new: func [x' [integer!] /local obj] [
obj: context [x: x' .class: none] ; this is the object definition
obj/.class: self/.class ; the object will refer to the class
; it belongs to
return obj
]
;---- An instance method (last argument must be the instance itself) ----;
add: func [y obj] [
return obj/x + y
]
]
Then you can do this:
;---- First instance, created from its class ----;
this-object: THIS-CLASS/.new 1
print invoke this-object 'add [2]
;---- Second instance, created from from a prototype ----;
that-object: this-object/.class/.new 2
print invoke that-object 'add [4]
;---- Third instance, created from from a prototype in another way ----;
yonder-object: invoke that-object '.new [3]
print invoke yonder-object 'add [6]
;---- Fourth instance, created from from a prototype in a silly way ----;
silly-object: yonder-object/.class/.class/.class/.class/.new 4
print silly-object/.class/add 8 silly-object
print this-object/.class/add 8 silly-object
print THIS-CLASS/add 8 silly-object
(It works in REBOL 2, and prints 3, 6, 9, 12, 12, 12 successively.) Hardly any overhead. Probably it won't be difficult to find a dozen of other solutions. Exactly that is the real problem: there are too many ways to do it. (Maybe we'd better use LoyalScript.)
This shows how to have a static variable inside an object or context:
http://www.mail-archive.com/list#rebol.com/msg04764.html
But the scope is too large for some needs, is it possible to have a static variable inside an object function ?
Or you can use FUNCTION/WITH. This makes the function generator take a third parameter, which defines a persistent object that is used as the "self":
accumulate: function/with [value /reset] [
accumulator: either reset [
value
] [
accumulator + value
]
] [
accumulator: 0
]
To use it:
>> accumulate 10
== 10
>> accumulate 20
== 30
>> accumulate/reset 0
== 0
>> accumulate 3
== 3
>> accumulate 4
== 7
You may also want to look at my FUNCS function.
In Rebol 3, use a closure (or CLOS) rather than a function (or FUNC).
In Rebol 2, fake it by having a block that contains your static values, eg :
f: func [
/local sb
][
;; define and initialise the static block
sb: [] if 0 = length? sb [append sb 0]
;; demonstate its value persists across calls
sb/1: sb/1 + 1
print sb
]
;; sample code to demonstrate function
loop 5 [f]
== 1
== 2
== 3
== 4
== 5