[The third in a series of posts on the evolution of TransForth]
Now that we have Forth hobbling along, we can start to peel away the scaffolding. Some of the things we’ve defined in F# can now be redefined in Forth instead. As we go along, I think you’ll be amazed by just how little it takes to bootstrap a Forth system. Also, with just a few more primitives we can really start to build things up.
To start with a silly one, we don’t strictly need to define subtraction:
dyadic (-) |> define "-"
In the last post we defined : NEGATE -1 * ; and we can define subtraction as adding the negative : - NEGATE + ;
We had also defined a bunch of stack manipulation primitives:
let stk fn () = stack <- fn stack
define "DUP" (stk (function x :: t -> x :: x :: t | _ -> underflow ()))
define "SWAP" (stk (function x :: y :: t -> y :: x :: t | _ -> underflow ()))
define "OVER" (stk (function (x :: y :: _ as t) -> y :: t | _ -> underflow ()))
define "ROT" (stk (function x::y::z::t -> z::x::y::t | _ -> underflow ()))
… but really these (and more) can all be defined in terms of PICK and ROLL:
: DUP 0 PICK ;
: OVER 1 PICK ;
: SWAP 1 ROLL ;
: ROT 2 ROLL ;
: 2DROP DROP DROP ;
: 2DUP OVER OVER ;
: 2OVER 3 PICK 3 PICK ;
: 3DUP DUP 2OVER ROT ;
Just as NAND gates can serve as the basis for all other types of logic gates (so can NOR), we really only need one primitive to build up all the bitwise operators:
dyadic (fun a b -> ~~~(a &&& b)) |> define "NAND" // basis of NOT, OR, XOR, ...
From this we can get:
: NOT DUP NAND ;
: AND NAND NOT ;
: OR NOT SWAP NOT NAND ;
: NOR OR NOT ;
: XOR 2DUP AND -ROT NOR NOR ;
: XNOR XOR NOT ;
Interesting also, is that Forth represents truth as -1 (all bits on - as opposed to using any ol’ non-zero), so the above also serve as logical operators.
We have yet to build conditional operators (next post), but we can go ahead and define comparison:
let comp fn = dyadic (fun a b -> if fn a b then -1 else 0)
comp (>) |> define ">"
comp (=) |> define "="
From this we can build more of the standard Forth words:
: < 2DUP > -ROT = OR NOT ; : <= 2DUP < -ROT = OR ; : >= 2DUP > -ROT = OR ; : <> = NOT ;
: 0> 0 > ;
: 0= 0 = ;
: 0< 0 < ;
: 0<> 0 <> ;
It’s been bugging me that we don’t have comment, so let’s throw that in too. They can be in the form ( this is a comment ) or can \ run to the end of the line
let comment term () = source <- Seq.skipWhile ((<>) term) source |> Seq.skip 1
comment '\n' |> define "\\"; immediate ()
comment ')' |> define "("; immediate ()
Here’s the latest library all together. A few other things have been added such as /MOD and a bunch of increment/decrement and shift words: 1+ 1- 2+ 2- 2* 2/. The reason for these simple words is not just to save typing a space. It's because once we target real hardware they may be defined in terms of efficient machine-level instructions. For example 2* and 2/ really are bit shifts.
rep "
: NEGATE -1 * ;
: SQUARE ( a -- a^2) DUP * ;
: CUBE ( a -- a^3) DUP DUP * * ;
: /MOD ( a b -- rem quot) 2DUP MOD -ROT / ;
: DUP ( a -- a a) 0 PICK ;
: OVER ( a b -- a b a) 1 PICK ;
: SWAP ( a b -- b a) 1 ROLL ;
: ROT ( a b c -- b c a) 2 ROLL ;
: -ROT ( a b c -- c a b) ROT ROT ;
: NIP ( a b -- b) SWAP DROP ;
: TUCK ( a b -- b a b) SWAP OVER ;
: 2DROP ( a b -- ) DROP DROP ;
: 2DUP ( a b -- a b a b) OVER OVER ;
: 2OVER ( a b c d -- a b c d a b) 3 PICK 3 PICK ;
: 3DUP ( a b c -- a b c a b c) DUP 2OVER ROT ;
: - ( a b -- diff) NEGATE + ;
: 1+ 1 + ;
: 1- 1 - ;
: 2+ 2 + ;
: 2- 2 - ;
: 2* 2 * ;
: 2/ 2 / ;
: TRUE ( -- t) -1 ; \ normally constant
: FALSE ( -- f) 0 ; \ normally constant
: NOT ( a -- ~a) DUP NAND ;
: AND ( a b -- a&b) NAND NOT ;
: OR ( a b -- a|b) NOT SWAP NOT NAND ;
: NOR ( a b -- ~a|b) OR NOT ;
: XOR ( a b -- a^b) 2DUP AND -ROT NOR NOR ;
: XNOR ( a b -- ~a^b) XOR NOT ;
: < ( a b -- a<b) 2DUP > -ROT = OR NOT ;
: <= ( a b -- a<=b) 2DUP < -ROT = OR ;
: >= ( a b -- a>=b) 2DUP > -ROT = OR ;
: <> ( a b -- ?) = NOT ;
"
case "22 4 /MOD . ." "5 2 " // quotient and remainder
case "7 \ comment\n 8 .S" "7 8 " // comment skipped
case "7 ( comment ) 8 .S" "7 8 " // comment skipped
case "1 2 3 2DROP .S" "1 " // drop pair
case "1 2 3 2DUP .S" "1 2 3 2 3 " // dup pair
case "1 2 3 4 2OVER .S" "1 2 3 4 1 2 " // over pairs
case "1 2 3 3DUP .S" "1 2 3 1 2 3 " // dup tripple
case "42 1+ ." "43 " // increment
case "42 1- ." "41 " // decrement
case "42 2+ ." "44 " // double inc
case "42 2- ." "40 " // double dec
case "42 2* ." "84 " // left shift
case "42 2/ ." "21 " // right shift
case "TRUE ." "-1 " // true constant
case "FALSE ." "0 " // false constant
case "0 0 NAND ." "-1 " // nand
case "0 -1 NAND ." "-1 " // nand
case "-1 0 NAND ." "-1 " // nand
case "-1 -1 NAND ." "0 " // nand
case "0 NOT ." "-1 " // not
case "-1 NOT ." "0 " // not
case "0 0 AND ." "0 " // and
case "0 -1 AND ." "0 " // and
case "-1 0 AND ." "0 " // and
case "-1 -1 AND ." "-1 " // and
case "0 0 OR ." "0 " // or
case "0 -1 OR ." "-1 " // or
case "-1 0 OR ." "-1 " // or
case "-1 -1 OR ." "-1 " // or
case "0 0 NOR ." "-1 " // nor
case "0 -1 NOR ." "0 " // nor
case "-1 0 NOR ." "0 " // nor
case "-1 -1 NOR ." "0 " // nor
case "0 0 XOR ." "0 " // xor
case "0 -1 XOR ." "-1 " // xor
case "-1 0 XOR ." "-1 " // xor
case "-1 -1 XOR ." "0 " // xor
case "0 0 XNOR ." "-1 " // xnor
case "0 -1 XNOR ." "0 " // xnor
case "-1 0 XNOR ." "0 " // xnor
case "-1 -1 XNOR ." "-1 " // xnor
case "42 6 > ." "-1 " // greater
case "6 42 > ." "0 " // greater
case "6 6 > ." "0 " // greater
case "-1 0> ." "0 " // greater than zero
case "0 0> ." "0 " // greater than zero
case "1 0> ." "-1 " // greater than zero
case "6 42 = ." "0 " // equal
case "6 6 = ." "-1 " // equal
case "42 6 < ." "0 " // less
case "6 42 < ." "-1 " // less
case "6 6 < ." "0 " // less
case "42 6 <= ." "0 " // less or equal
case "6 42 <= ." "-1 " // less or equal
case "6 6 <= ." "-1 " // less or equal
case "42 6 <> ." "-1 " // not equal
case "6 42 <> ." "-1 " // not equal
case "6 6 <> ." "0 " // not equal
case "42 0= ." "0 " // equal to zero
case "0 0= ." "-1 " // equal to zero
case "-1 0< ." "-1 " // less than zero
case "0 0< ." "0 " // less than zero
case "1 0< ." "0 " // less than zero
case "0 0<> ." "0 " // not equal to zero
case "42 0<> ." "-1 " // not equal to zero
Next>