| 2 |
7u83 |
1 |
<!-- Crown Copyright (c) 1998 -->
|
|
|
2 |
<HTML>
|
|
|
3 |
<HEAD>
|
|
|
4 |
<TITLE>Example PL_TDF programs</TITLE>
|
|
|
5 |
</HEAD>
|
|
|
6 |
<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#0000FF" VLINK="#400080" ALINK="#FF0000">
|
|
|
7 |
<A NAME=S41>
|
|
|
8 |
<H1>PL_TDF Definition</H1>
|
|
|
9 |
<H3>January 1998</H3>
|
|
|
10 |
<A HREF="pl6.html"><IMG SRC="../images/next.gif" ALT="next section">
|
|
|
11 |
</A> <A HREF="pl4.html">
|
|
|
12 |
<IMG SRC="../images/prev.gif" ALT="previous section"></A>
|
|
|
13 |
<A HREF="pl1.html"><IMG SRC="../images/top.gif" ALT="current document"></A>
|
|
|
14 |
<A HREF="../index.html"><IMG SRC="../images/home.gif" ALT="TenDRA home page">
|
|
|
15 |
</A>
|
|
|
16 |
<IMG SRC="../images/no_index.gif" ALT="document index"><P>
|
|
|
17 |
<HR>
|
|
|
18 |
<DL>
|
|
|
19 |
<DT><A HREF="#S42"><B>4.1 </B> - Sieve of Erastothenes</A><DD>
|
|
|
20 |
<DT><A HREF="#S43"><B>4.2 </B> - Example with structures</A><DD>
|
|
|
21 |
<DT><A HREF="#S44"><B>4.3 </B> - Test for case</A><DD>
|
|
|
22 |
<DT><A HREF="#S45"><B>4.4 </B> - Example of use of high-order TOKENs</A><DD>
|
|
|
23 |
<DT><A HREF="#S46"><B>4.5 </B> - A test for long jumps</A><DD>
|
|
|
24 |
</DL>
|
|
|
25 |
<HR>
|
|
|
26 |
<H1>4 <A NAME=0>Example PL_TDF programs</H1>
|
|
|
27 |
<A NAME=S42>
|
|
|
28 |
<HR><H2>4.1. Sieve of Erastothenes</H2>
|
|
|
29 |
<P>
|
|
|
30 |
<PRE>
|
|
|
31 |
/* Print out the primes less than 10000 */
|
|
|
32 |
String s1 = "%d\t"; /* good strings for printf */
|
|
|
33 |
String s2 = "\n";
|
|
|
34 |
|
|
|
35 |
Var n: nof(10000, Char); /* will contain1 for prime; 0 for composite */
|
|
|
36 |
|
|
|
37 |
Tokdef N = [ind:EXP]EXP n *+. (Sizeof(Char) .* ind);
|
|
|
38 |
/* Token delivering pointer to element of n */
|
|
|
39 |
|
|
|
40 |
Iddec printf : proc; /* definition provided by ansi library */
|
|
|
41 |
|
|
|
42 |
Proc main = top ()
|
|
|
43 |
Var i:Int
|
|
|
44 |
Var j:Int
|
|
|
45 |
{ Rep (i = 2(Int))
|
|
|
46 |
{ /* set i-th element of n to 1 */
|
|
|
47 |
N[* i] = 1(Char);
|
|
|
48 |
i = (* i + 1(Int));
|
|
|
49 |
?(* i >= 10000(Int)) /* NB assertion fails to continue loop */
|
|
|
50 |
}
|
|
|
51 |
Rep (i = 2(Int) )
|
|
|
52 |
{
|
|
|
53 |
?{ ?( *(Char)N[* i] == 1(Char));
|
|
|
54 |
/* if its a prime ... */
|
|
|
55 |
Rep ( j = (* i + * i) )
|
|
|
56 |
{ /*... wipe out composites */
|
|
|
57 |
N[* j] = 0(Char);
|
|
|
58 |
j = (* j + * i);
|
|
|
59 |
?(* j >= 10000(Int))
|
|
|
60 |
}
|
|
|
61 |
| make_top
|
|
|
62 |
};
|
|
|
63 |
i = (* i + 1(Int));
|
|
|
64 |
?(* i >= 100(Int))
|
|
|
65 |
};
|
|
|
66 |
Rep (i = 2(Int); j = 0(Int) )
|
|
|
67 |
{ ?{ ?( *(Char)N[* i] == 1(Char));
|
|
|
68 |
/* if it's a prime, print it */
|
|
|
69 |
printf[top](s1, * i);
|
|
|
70 |
j = (* j + 1(Int));
|
|
|
71 |
?{ ?( * j == 5(Int));
|
|
|
72 |
/* print new line */
|
|
|
73 |
printf[top](s2);
|
|
|
74 |
j = 0(Int)
|
|
|
75 |
| make_top
|
|
|
76 |
}
|
|
|
77 |
| make_top
|
|
|
78 |
};
|
|
|
79 |
i = (* i + 1(Int));
|
|
|
80 |
?(* i >= 10000(Int))
|
|
|
81 |
};
|
|
|
82 |
return(make_top)
|
|
|
83 |
};
|
|
|
84 |
|
|
|
85 |
Keep (main) /* main will be an external name; so will printf since it is not defined */
|
|
|
86 |
</PRE>
|
|
|
87 |
<A NAME=S43>
|
|
|
88 |
<HR><H2>4.2. Example with structures</H2>
|
|
|
89 |
<PRE>
|
|
|
90 |
Struct C (re:Double, im:Double);
|
|
|
91 |
/* define TOKENs : C as a SHAPE for complex, with field offsets .re and .im
|
|
|
92 |
and selectors re and im */
|
|
|
93 |
|
|
|
94 |
Iddec printf:proc;
|
|
|
95 |
|
|
|
96 |
Proc addC = C (lv:C, rv:C) /* add two complex numbers */
|
|
|
97 |
Let l = * lv
|
|
|
98 |
Let r = * rv
|
|
|
99 |
{ return( Cons[shape_offset(C)] ( .re: re[l] F+ re[r], .im: im[l] F+ im[r]) ) } ;
|
|
|
100 |
|
|
|
101 |
String s1 = "Ans = (%g, %g)\n";
|
|
|
102 |
|
|
|
103 |
Proc main = top()
|
|
|
104 |
Let x = Cons[shape_offset(C)] (.re: 1.0(Double), .im:2.0(Double))
|
|
|
105 |
Let y = Cons[shape_offset(C)] (.re: 3.0(Double), .im:4.0(Double))
|
|
|
106 |
Let z = addC[C](x,y)
|
|
|
107 |
{ printf[top](s1, re[z], im[z]);
|
|
|
108 |
/* prints out "Ans = (4, 6)" */
|
|
|
109 |
return(make_top)
|
|
|
110 |
};
|
|
|
111 |
|
|
|
112 |
Keep(main)
|
|
|
113 |
</PRE>
|
|
|
114 |
<A NAME=S44>
|
|
|
115 |
<HR><H2>4.3. Test for case</H2>
|
|
|
116 |
<PRE>
|
|
|
117 |
Iddec printf:proc;
|
|
|
118 |
|
|
|
119 |
String s1 = "%d is not in [%d,%d]\n";
|
|
|
120 |
String s2 = "%d OK\n";
|
|
|
121 |
|
|
|
122 |
Proc test = top(i:Int, l:Int, u:Int) /* report whether l<=i<=u */
|
|
|
123 |
?{ ?(* i >= * l); ?(* i <= * u);
|
|
|
124 |
printf[top](s2, * i);
|
|
|
125 |
return(make_top)
|
|
|
126 |
| printf[top](s1, * i, * l, * u);
|
|
|
127 |
return(make_top)
|
|
|
128 |
};
|
|
|
129 |
|
|
|
130 |
String s3 = "ERROR with %d\n";
|
|
|
131 |
|
|
|
132 |
Proc main = top() /* check to see that case is working */
|
|
|
133 |
Var i:Int = 0(Int)
|
|
|
134 |
Rep {
|
|
|
135 |
Labelled {
|
|
|
136 |
Case * i (0 -> l0, 1 -> l1, 2:3 -> l2, 4:10000 -> l3)
|
|
|
137 |
| :l0: test[top](* i, 0(Int), 0(Int))
|
|
|
138 |
| :l1: test[top](* i, 1(Int), 1(Int))
|
|
|
139 |
| :l2: test[top](* i, 2(Int), 3(Int))
|
|
|
140 |
| :l3: printf[top](s3, * i)
|
|
|
141 |
};
|
|
|
142 |
i = (* i + 1(Int));
|
|
|
143 |
?(* i > 3(Int));
|
|
|
144 |
return(make_top)
|
|
|
145 |
};
|
|
|
146 |
|
|
|
147 |
Keep (main, test)
|
|
|
148 |
</PRE>
|
|
|
149 |
<A NAME=S45>
|
|
|
150 |
<HR><H2>4.4. Example of use of high-order TOKENs</H2>
|
|
|
151 |
<PRE>
|
|
|
152 |
Tokdef IF = [ boolexp:TOKEN[LABEL]EXP, thenpt:EXP, elsept:EXP] EXP
|
|
|
153 |
?{ boolexp[lab]; thenpt | :lab: elsept };
|
|
|
154 |
/* IF is a TOKEN which can be used to mirror a standard if ... then ... else
|
|
|
155 |
construction; the boolexp is a formal TOKEN with a LABEL parameter
|
|
|
156 |
which is jumped to if the boolean is false */
|
|
|
157 |
|
|
|
158 |
Iddec printf: proc;
|
|
|
159 |
|
|
|
160 |
String cs = "Correct\n";
|
|
|
161 |
String ws = "Wrong\n";
|
|
|
162 |
|
|
|
163 |
Proc main = top()
|
|
|
164 |
Var i:Int = 0(Int)
|
|
|
165 |
{
|
|
|
166 |
IF[ Use [l:LABEL]EXP ?(* i == 0(Int) | l), printf[top](cs), printf[top](ws) ];
|
|
|
167 |
/* in other words if (i==0) printf("Correct") else printf("Wrong") */
|
|
|
168 |
IF[ Use [l:LABEL]EXP ?(* i != 0(Int) | l), printf[top](ws), printf[top](cs) ];
|
|
|
169 |
i = IF[ Use [l:LABEL]EXP ?(* i != 0(Int) | l), 2(Int), 3(Int)];
|
|
|
170 |
IF[ Use [l:LABEL]EXP ?(* i == 3(Int) | l), printf[top](cs), printf[top](ws) ];
|
|
|
171 |
return(make_top)
|
|
|
172 |
};
|
|
|
173 |
|
|
|
174 |
Keep (main)
|
|
|
175 |
</PRE>
|
|
|
176 |
<A NAME=S46>
|
|
|
177 |
<HR><H2>4.5. A test for long jumps</H2>
|
|
|
178 |
<PRE>
|
|
|
179 |
Iddec printf:proc;
|
|
|
180 |
|
|
|
181 |
Proc f = bottom(env:pointer(frame_alignment), lab:pointer(code_alignment) )
|
|
|
182 |
{
|
|
|
183 |
long_jump(* env, * lab)
|
|
|
184 |
};
|
|
|
185 |
|
|
|
186 |
String s1 = "Should not reach here\n";
|
|
|
187 |
String s2 = "long-jump OK\n";
|
|
|
188 |
|
|
|
189 |
Proc main = top()
|
|
|
190 |
Labelled{
|
|
|
191 |
f[bottom](current_env, make_local_lv(l));
|
|
|
192 |
printf[top](s1); /* should never reach here */
|
|
|
193 |
return(make_top)
|
|
|
194 |
| :l:
|
|
|
195 |
printf[top](s2);
|
|
|
196 |
return(make_top)
|
|
|
197 |
};
|
|
|
198 |
|
|
|
199 |
Keep (main)
|
|
|
200 |
</PRE>
|
|
|
201 |
<HR>
|
|
|
202 |
<P><I>Part of the <A HREF="../index.html">TenDRA Web</A>.<BR>Crown
|
|
|
203 |
Copyright © 1998.</I></P>
|
|
|
204 |
</BODY>
|
|
|
205 |
</HTML>
|