aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

YAPC::EU 2018 Glasgow Update!

Browse source
This commit is contained in:
Ingy döt Net 2018-08-17 15:15:24 +01:00
parent 22f33d4004
commit 4e2d22a71d
1170 changed files with 15042 additions and 3047 deletions
Download patch file Download diff file Expand all files Collapse all files

35
Task/Metaprogramming/Forth/metaprogramming-1.fth Normal file
View file

@ -0,0 +1,35 @@
\ BRANCH and LOOP COMPILERS
\ branch offset computation operators
: AHEAD ( -- addr) HERE 0 , ;
: BACK ( addr -- ) HERE - , ;
: RESOLVE ( addr -- ) HERE OVER - SWAP ! ;
\ LEAVE stack is called L0. It is initialized by QUIT.
: >L ( x -- ) ( L: -- x ) 2 LP +! LP @ ! ;
: L> ( -- x ) ( L: x -- ) LP @ @ -2 LP +! ;
\ finite loop compilers
: DO ( -- ) POSTPONE <DO> HERE 0 >L 3 ; IMMEDIATE
: ?DO ( -- ) POSTPONE <?DO> HERE 0 >L 3 ; IMMEDIATE
: LEAVE ( -- ) ( L: -- addr )
POSTPONE UNLOOP POSTPONE BRANCH AHEAD >L ; IMMEDIATE
: RAKE ( -- ) ( L: 0 a1 a2 .. aN -- )
BEGIN L> ?DUP WHILE RESOLVE REPEAT ; IMMEDIATE
: LOOP ( -- ) 3 ?PAIRS POSTPONE <LOOP> BACK RAKE ; IMMEDIATE
: +LOOP ( -- ) 3 ?PAIRS POSTPONE <+LOOP> BACK RAKE ; IMMEDIATE
\ conditional branches
: IF ( ? -- ) POSTPONE ?BRANCH AHEAD 2 ; IMMEDIATE
: THEN ( -- ) ?COMP 2 ?PAIRS RESOLVE ; IMMEDIATE
: ELSE ( -- ) 2 ?PAIRS POSTPONE BRANCH AHEAD SWAP 2
POSTPONE THEN 2 ; IMMEDIATE
\ infinite loop compilers
: BEGIN ( -- addr n) ?COMP HERE 1 ; IMMEDIATE
: AGAIN ( -- ) 1 ?PAIRS POSTPONE BRANCH BACK ; IMMEDIATE
: UNTIL ( ? -- ) 1 ?PAIRS POSTPONE ?BRANCH BACK ; IMMEDIATE
: WHILE ( ? -- ) POSTPONE IF 2+ ; IMMEDIATE
: REPEAT ( -- ) 2>R POSTPONE AGAIN 2R> 2- POSTPONE THEN ; IMMEDIATE

10
Task/Metaprogramming/Forth/metaprogramming-2.fth Normal file
View file

@ -0,0 +1,10 @@
: CHARSET [CHAR] ~ [CHAR] ! DO I EMIT LOOP ;
: >DIGIT ( n -- c) DUP 9 > IF 7 + THEN [CHAR] 0 + ;
: -TRAILING ( adr len -- adr len') \ remove trailing blanks (spaces)
BEGIN
2DUP + 1- C@ BL = \ test if last char = blank
WHILE
1- \ dec. length
REPEAT ;