%
% This is a simple (nay,trivial!)  "dialect" 
% with only two commands.
 
% Obviously only scratches the surface - 
% Written as a learning exercise!
% First define a grammar using prolog's Definite 
% Clause Grammar (DCG) notation
% DCG is a bit like a macro system - 
% the grammar rules are expanded into
% ordinary prolog clauses  before execution:
% Thanks to prolog unification, the Cmd variable
% will end up being instantiated to a functor like
% sell(abc,10,5) or buy(xyz,55):

cmd(Cmd) --> sell,!,amount(Amount),of,stock(Stock),at,price(Price), 
             { Cmd = sell(Stock,Amount,Price) }.
cmd(Cmd) --> buy,!,amount(Amount),of,stock(Stock), 
             {Cmd = buy(Stock,Amount)}.
sell --> [sell].
of --> [of].
at --> [at].
buy --> [buy].
amount(Amount) --> [Amount].
stock(Stock)   --> [Stock].
price(Price)   --> [Price].

% mini-evaluator:

eval(sell(Stock,Amount,Price)) :- 
 format('Sold ~d ~a shares at $~d.~n',[Amount,Stock,Price]).
eval(buy(Stock,Amount)) :- 
 format('Bought ~d ~a shares.~n',[Amount,Stock]).

% parse a statement, if it's a command, 
% evaluate it, otherwise write an error
% (NB.  ";" is prolog's % "or".)

interp(Statement) :- cmd(Cmd,Statement,[]),
             eval(Cmd);write('Unrecognised command!').

% Examples: 
% ( First two match , the last fails.)

test :-
    interp([sell,100,of,xyx,at,50]),
    interp([buy,45,of,abc]),
    interp([not,accepted]).

-------------  Beginning of class  pga.ijs   -------------------
coclass'pga'
create=:3 : 0
genes=: ? 4 $ 100  NB. 4 random integers 0-99
)
getgenes =: 3 : 'genes'
setgenes =: 3 : 'genes=:y.'
matewith=: 3 : 0
other=. y.
mine=. ((#genes) % 2) ? (#genes) NB. crossover
childgene=. getgenes__other '' NB. copy others intially
child=. conew 'pga'
setgenes__child ((mine { genes) (mine }) childgene)
child
)
perform =: 3 : 0 NB. dummy problem
+/ genes
)
destroy=:codestroy
-------------  End of of class  pga.ijs   ----------------------
-------------  beginning of script ga.ijs ----------------------
NB. genetic algorithm 
NB. needs pga class
NB. define a dummy target to measure fitness against
targetvalue =:  500  
fitness=: 3 : 0
object=. y.
1000 * %(targetvalue - perform__object '')
)

load jpath '~user\classes\pga.ijs'


top =: 4 : '(i.y.) { \: (fitness each x.)'  NB. pop top 10 returns the 10 fittest

pair=: 3 : 0  NB. pick two random ga objects, mate them, and return the child
pop=. y.
mom=. > (?#pop) { pop NB. must unbox!
dad=. > (?#pop) { pop NB.  # is length of boxed list
matewith__mom dad
)

NB.  pop evolve generations returns the fittest ga after 
NB. sifting the top 25 ga's
evolve=: 4 : 0
pop=. x.
n=. y.
for_k. i.n do.
kpop=.  3 : 'pop' NB. not sure if necessary to do here
newgen=.  (pair@kpop) each i.100  NB. create 100 children
best=.  (newgen top 25) { newgen NB. find the indices of the best, then select the corresponding objects
pop=. best,best,best,best  NB. not really necessary?
end.
>0{best  NB. return best
)
NB. usage  
load jpath '~user\ga.ijs'
average =: +/%#
pop=: conew&'pga' each i.100   NB. create 100 boxed ga objects
fitness each pop  NB. should show a boxed list of fitness values
average ; fitness each pop  NB. shows average fitness

fred=: pop evolve 100
fitness fred
uberfred=: pop evolve 1000

NB. the fitness values increase pretty slowly which is disappointing
NB. probably needs some mutation :)
-------------    end of script ga.ijs     ----------------------

here's a version of a ruby/smalltalk-like each in rebol:

in smalltalk you can write:

collectionObject each: [:thing | thing printName ]
ruby used the same idea etc
- a  code block is passed to an object

here's a rebol version

collection: make object! [
 data: copy []

 each: func [blk [block!] 
             /local iterator statement ][
             iterator:  to word! first blk
             statement:  copy skip blk 1
             foreach item data [
                set iterator item
                do bind statement iterator
             ]
        ]
]

This works by taking an input block of the form :
  [ :x   print x ]
or
[ :num  add total num ] etc

iterator: to word! first blk
just sets up iterator to be a work like a or x ( not a get-word like :a or :x )

I use a get-word just as a smalltalkish reminder that this is a
dummy variable ( [ a print a] would work too)

statement: copy skip blk 1 
just makes a copy of the rest of input block
ie statement would be [print x] say , i suppose chopping off the first would work too..

within the loop we set the value of this word ( say x) to 
successive items  in the internal datablock, so the word we indirectly talking about has a different value each time round.

do bind statement iterator

interprets the statement using the current value of the word and do executes it.

people: make collection [
 data: ["fred" "george" "mary" "jane"]
]

people/each [:person print rejoin ["Hello " person]]
Hello fred
Hello george
Hello mary
Hello jane
>>

I guess there might be probs if the "dummy" variable was
also a word used internally by the object containing the each method .

rebol []

robot: make object! [
move: func [amount] [...] ; whatever
turn: func [angle][..] 
fire: func [] [...]
run: func [code][
                   do bind code 'self
]
]

script: [
           move 100
           turn 45
           fire
           turn 23
           move 34
]
; etc

robbie: make robot []

robbie/run script