added a better infix: operator meta-word...

Signed-off-by: Alex A. Naanou <alex.nanou@gmail.com>
This commit is contained in:
Alex A. Naanou 2013-12-30 08:52:12 +04:00
parent b14dae9bdf
commit 4b01c1a383

View File

@ -84,6 +84,7 @@ var PRE_NAMESPACE = {
}
return block
},
// XXX macros are not recursive...
'macro:': function(context){
var ident = context.code.splice(0, 1)
var cur = context.code.splice(0, 1)
@ -567,15 +568,33 @@ var BOOTSTRAP = [
'-- NOTE: these are at this point stupid and do not support priorities or grouping...',
'-- NOTE: these have both stack and code effect, in genera the operations are of ',
'-- the form: A op B',
':: + ( a | b -- c | ) [ \\ add _swap ]',
':: - ( a | b -- c | ) [ \\ sub _swap ]',
':: * ( a | b -- c | ) [ \\ mul _swap ]',
':: / ( a | b -- c | ) [ \\ div _swap ]',
'-- Here is an infix operator example...',
'-- :: + ( a | b -- c | ) [ \\ exec \\ add 2 1 _swapN ]',
'-- now let\'s make a meta function to make things shorter...',
':: _infix ( op word -- ) [',
' -- format the word definition...',
' s2b \\ :: -3 before b2s',
' -- our template...',
// XXX the template is wrong: need to exec both sides...
' [ \\ exec \\ WORD 2 1 _swapN ] clone',
' -- replace WORD with the actual target word...',
' swap 3 to',
' -- push to code / run',
' 3 0 _swapN ]',
'-- formatter for the _infix word...',
':: infix: ( | op word -- | ) [ \\ _infix 1 2 _swapN ]',
'',
':: == ( a | b -- c | ) [ \\ eq _swap ]',
':: != ( a | b -- c | ) [ \\ ne _swap ]',
':: > ( a | b -- c | ) [ \\ gt _swap ]',
'-- Now making a word/2 an infix operator is trivial...',
'infix: + add',
'infix: - sub',
'infix: * mul',
'infix: / div',
'',
'infix: == eq',
'infix: != ne',
'infix: > gt',
'',
//':: = ( a | b -- | ) [ 1 1 _swapN :: ]',
'',
'-- this is here for devel use only',
':: _clear ( ... -- ) [ s2b drop ] ',
@ -584,8 +603,6 @@ var BOOTSTRAP = [
'',
'-- tests and examples...',
':: hi ( -- ) [ "Hello World!" print drop ]',
//'-- NOTE: nop at the end is a stub to fix a bug in ? else ...',
//':: ! ( a -- b ) [ [ dup 1 ne ] ? [ dup 1 sub ! mul ] nop ]',
':: ! ( a -- b ) [ [ dup 1 ne ] ? [ dup 1 sub ! mul ] ]',
':: range ( n -- b ) [',
' -- initial state...',