flynx/Course-JavaScript
1
0
Fork 0
mirror of https://github.com/flynx/Course-JavaScript.git synced 2025-10-31 03:50:10 +00:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
1 changed files with 26 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
Slang/slang.js
View File

@ -84,6 +84,7 @@ var PRE_NAMESPACE = {
} }
return block return block
}, },
// XXX macros are not recursive...
'macro:': function(context){ 'macro:': function(context){
var ident = context.code.splice(0, 1) var ident = context.code.splice(0, 1)
var cur = 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 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 ', '-- NOTE: these have both stack and code effect, in genera the operations are of ',
'-- the form: A op B', '-- the form: A op B',
':: + ( a | b -- c | ) [ \\ add _swap ]', '-- Here is an infix operator example...',
':: - ( a | b -- c | ) [ \\ sub _swap ]', '-- :: + ( a | b -- c | ) [ \\ exec \\ add 2 1 _swapN ]',
':: * ( a | b -- c | ) [ \\ mul _swap ]', '-- now let\'s make a meta function to make things shorter...',
':: / ( a | b -- c | ) [ \\ div _swap ]', ':: _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 ]', '-- Now making a word/2 an infix operator is trivial...',
':: != ( a | b -- c | ) [ \\ ne _swap ]', 'infix: + add',
':: > ( a | b -- c | ) [ \\ gt _swap ]', 'infix: - sub',
'infix: * mul',
'infix: / div',
'', '',
'infix: == eq',
'infix: != ne',
'infix: > gt',
'',
//':: = ( a | b -- | ) [ 1 1 _swapN :: ]',
'', '',
'-- this is here for devel use only', '-- this is here for devel use only',
':: _clear ( ... -- ) [ s2b drop ] ', ':: _clear ( ... -- ) [ s2b drop ] ',
@ -584,8 +603,6 @@ var BOOTSTRAP = [
'', '',
'-- tests and examples...', '-- tests and examples...',
':: hi ( -- ) [ "Hello World!" print drop ]', ':: 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 ] ]', ':: ! ( a -- b ) [ [ dup 1 ne ] ? [ dup 1 sub ! mul ] ]',
':: range ( n -- b ) [', ':: range ( n -- b ) [',
' -- initial state...', ' -- initial state...',