mirror of
https://github.com/flynx/Slang.git
synced 2025-10-29 02:30:08 +00:00
added a better infix: operator meta-word...
Signed-off-by: Alex A. Naanou <alex.nanou@gmail.com>
This commit is contained in:
parent
b14dae9bdf
commit
4b01c1a383
@ -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...',
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user