# : REFACTOR TRIM BUILD ;

[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.

## Trimming Fat

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 ;

## One NAND To Rule Them All

Just as ), 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.

## Comparison Primitives

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 <> ;

## Comments

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 ()

## Library

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 ;

: 0>   0 > ;

: 0=   0 = ;

: 0<   0 < ;

: 0<>   0 <> ;

"

## New Tests

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 "-1 0> ." "0 " // greater than zero

case "0 0> ." "0 " // greater than zero

case "1 0> ." "-1 " // greater than zero

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>

Comments (2)
1. kib2 says:

Hi Ashley,

I've translated the F# code to Python because I don't F# well, and all seems to work quiet fine here (modulo the end of line comments, it's because of the way I'm lexing the input) .

I also wanted to give F# a try, because I found it very readable and powerful, but failed to compile the first given script. Here's what I've got from F# Interactive:

define "WORDS" (fun () -> List.iter (fun w -> print w.Name) dict)

—————————————————-^^^^^^

stdin(148,53): error FS0072: Lookup on object of indeterminate type based on inf

ormation prior to this program point. A type annotation may be needed prior to t

his program point to constrain the type of the object. This may allow the lookup

to be resolved.

Seems like F# needs more infos on type. Any idea on how to fix it ?

Thanks a lot; I just hope you'll end up the series as you told it: by writting a Lisp with it :).

2. @kib2, Not everything on the blog will necessarily work without the surrounding context (for type inference to make sense of everything). All of the code, in a complete working form, is available at my github: github.com/…/TransForth Also, when I originally made these posts I checked into CodePlex which might be useful to see the intermediate check-ins corresponding to each post (though I'm working out of Github these days): http://transforth.codeplex.com

Hope that helps. Have fun!

Skip to main content