Example PL_TDF programs

# PL_TDF Definition

### January 1998

4.1 - Sieve of Erastothenes
4.2 - Example with structures
4.3 - Test for case
4.4 - Example of use of high-order TOKENs
4.5 - A test for long jumps

# 4 Example PL_TDF programs

## 4.1. Sieve of Erastothenes

    	/* Print out the primes less than 10000 */
    	String s1 = "%d\t";					/* good strings for printf */
    	String s2 = "\n";

    	Var n: nof(10000, Char);					/* will contain1 for prime; 0 for composite */

    	Tokdef N = [ind:EXP]EXP n *+. (Sizeof(Char) .* ind);
    					/* Token delivering pointer to element of n */

    	Iddec printf : proc;				/* definition provided by ansi library */

    	Proc main = top ()
    		Var i:Int
    		Var j:Int
    		{ Rep (i = 2(Int))
    			{ 	/* set i-th element of n to 1 */
    			 N[* i] = 1(Char);
    			 i = (* i + 1(Int));
    			 ?(* i >= 10000(Int))			/* NB assertion fails to continue loop */
    			}
    		Rep (i = 2(Int) )
    		 	{
    		 	 ?{ 	?( *(Char)N[* i] == 1(Char));
    				/* if its a prime ... */
    		 	 	Rep ( j = (* i + * i) )
    		 	 	{ /*... wipe out composites */
    		 	 	N[* j] = 0(Char);
    		 	 	j = (* j + * i);
    		 	 	?(* j >= 10000(Int))
    		 	 }
    		 	 | make_top
    		 	 };
    		 	 i = (* i + 1(Int));
    		 	 ?(* i >= 100(Int))
    		 	 };
    		 Rep (i = 2(Int); j = 0(Int) )
    		 	{ 	?{ 	?( *(Char)N[* i] == 1(Char));
    					/* if it's a prime, print it */
    		 	 		printf[top](s1, * i);
    		 			 j = (* j + 1(Int));
    		 	 		?{ 	?( * j == 5(Int));
    						/* print new line */
    		 	 			printf[top](s2);
    		 	 			j = 0(Int)
    		 	 		 | make_top
    		 	 		}
    		 	 	| make_top
    		 	 	};
    		 	 	i = (* i + 1(Int));
    		 	 	?(* i >= 10000(Int))
    		 	 };
    		 return(make_top)
    		 };

    	Keep (main)			/* main will be an external name; so will printf since it is not defined */

## 4.2. Example with structures

    	Struct C (re:Double, im:Double);
    			/* define TOKENs : C as a SHAPE for complex, with field offsets .re and .im
    				and selectors re and im */

    	Iddec printf:proc;

    	Proc addC = C (lv:C, rv:C) 					/* add two complex numbers */
    		Let l = * lv
    		Let r = * rv
    		{ return( Cons[shape_offset(C)] ( .re: re[l] F+ re[r], .im: im[l] F+ im[r]) ) } ;

    	String s1 = "Ans = (%g, %g)\n";

    	Proc main = top()
    		Let x = Cons[shape_offset(C)] (.re: 1.0(Double), .im:2.0(Double))
    		Let y = Cons[shape_offset(C)] (.re: 3.0(Double), .im:4.0(Double))
    		Let z = addC[C](x,y)
    		{	printf[top](s1, re[z], im[z]);
    				/* prints out "Ans = (4, 6)" */
    			return(make_top)
    		};

    	Keep(main)

## 4.3. Test for case

    	Iddec printf:proc;

    	String s1 = "%d is not in [%d,%d]\n";
    	String s2 = "%d OK\n";

    	Proc test = top(i:Int, l:Int, u:Int)					/* report whether l<=i<=u */
    	 	?{ 	?(* i >= * l); ?(* i <= * u);
    	 		printf[top](s2, * i);
    	 		return(make_top)
    	 	| 	printf[top](s1, * i, * l, * u);
    	 		return(make_top)
    	 	};

    	String s3 = "ERROR with %d\n";

    	Proc main = top()				/* check to see that case is working */
    	Var i:Int = 0(Int)
    		 Rep {
    	 		Labelled {
    	 			Case * i (0 -> l0, 1 -> l1, 2:3 -> l2, 4:10000 -> l3)
    	 			| :l0: test[top](* i, 0(Int), 0(Int))
    	 			| :l1: test[top](* i, 1(Int), 1(Int))
    	 			| :l2: test[top](* i, 2(Int), 3(Int))
    	 			| :l3: printf[top](s3, * i)
    	 		};
    		 i = (* i + 1(Int));
    	 	?(* i > 3(Int));
    	 	return(make_top)
    	 };

    	Keep (main, test)

## 4.4. Example of use of high-order TOKENs

    	Tokdef IF = [ boolexp:TOKEN[LABEL]EXP, thenpt:EXP, elsept:EXP] EXP
    				?{ boolexp[lab]; thenpt | :lab: elsept };
    			/* IF is a TOKEN which can be used to mirror a standard if ... then ... else
    				 construction; the boolexp is a formal TOKEN with a LABEL parameter
    	 			 which is jumped to if the boolean is false */

    	Iddec printf: proc;

    	String cs = "Correct\n";
    	String ws = "Wrong\n";

    	Proc main = top()
    		Var i:Int = 0(Int)
    		{
    		 	IF[ Use [l:LABEL]EXP ?(* i == 0(Int) | l), printf[top](cs), printf[top](ws) ];
    				/* in other words if (i==0) printf("Correct") else printf("Wrong") */
    		 	IF[ Use [l:LABEL]EXP ?(* i != 0(Int) | l), printf[top](ws), printf[top](cs) ];
    		 	i = IF[ Use [l:LABEL]EXP ?(* i != 0(Int) | l), 2(Int), 3(Int)];
    		 	IF[ Use [l:LABEL]EXP ?(* i == 3(Int) | l), printf[top](cs), printf[top](ws) ];
    	 		return(make_top)
    		 };

    	Keep (main)

## 4.5. A test for long jumps

    	Iddec printf:proc;

    	Proc f = bottom(env:pointer(frame_alignment), lab:pointer(code_alignment) )
    	{
    		long_jump(* env, * lab)
    	};

    	String s1 = "Should not reach here\n";
    	String s2 = "long-jump OK\n";

    	Proc main = top()
    	Labelled{
    		 	f[bottom](current_env, make_local_lv(l));
    		 	printf[top](s1);			/* should never reach here */
    		 	return(make_top)
    		       | :l:
    		 	printf[top](s2);
    		 	return(make_top)
    		      };

    	Keep (main)

Part of the TenDRA Web.
Crown Copyright © 1998.