tests/rtest_mset.mac

   1 (kill (all), 0);
   2 0;
   3
   4 (x : 123, y : abc, 0);
   5 0;
   6
   7 defstruct (f (x, y, z));
   8 '[f (x, y, z)];
   9
  10 myrecord : new (f);
  11 '(f (x, y, z));
  12
  13 myrecord@y : 45;
  14 45;
  15
  16 myrecord;
  17 '(f (x, 45, z));
  18
  19 [x, y, z, myrecord@x, myrecord@y, myrecord@z];
  20 '[123, abc, z, myrecord@x, 45, myrecord@z];
  21
  22 ('(myrecord@y), [op (%%), args (%%)]);
  23 '["@", [myrecord, y]];
  24
  25 (kill (y), myrecord@y);
  26 45;
  27
  28 [kill (f), errcatch (new (f)), errcatch (myrecord@x)];
  29 [done, [], [f(x, 45, z)@x]];
  30
  31 defstruct (f (x, y=3.14159, z));
  32 '[f(x, 3.14159, z)];
  33
  34 ff : new (f);
  35 '(f (x, 3.14159, z));
  36
  37 (ff@y : 2.71828, ff);
  38 '(f (x, 2.71828, z));
  39
  40 k : h (g (aa, bb), cc);
  41 '(h (g (aa, bb), cc));
  42
  43 errcatch (k@1@2 : dd);
  44 [];
  45
  46 defstruct (h (xx, yy), g (uu, vv));
  47 '[h (xx, yy), g (uu, vv)];
  48
  49 (k@1@2 : dd, k);
  50 '(h (g (aa, dd), cc));
  51
  52 x : new (h);
  53 '(h (xx, yy));
  54
  55 x@yy : new (g);
  56 g (uu, vv);
  57
  58 x;
  59 h (xx, g (uu, vv));
  60
  61 x@yy@vv : 123;
  62 123;
  63
  64 x;
  65 h (xx, g (uu, 123));
  66
  67 (yy : %i, vv : 1/2, 0);
  68 0;
  69
  70 [x@yy, x@yy@vv];
  71 '[g (uu, 123), 123];
  72
  73 string ('(x@yy + x@yy@vv));
  74 "x@yy@vv+x@yy";
  75
  76 (kill (x@yy@vv), [x, x@yy, x@yy@vv]);
  77 '[h (xx, g (uu, vv)), g (uu, vv), x@yy@vv];
  78
  79 (kill (x@yy), [x, x@yy]);
  80 '[h (xx, yy), x@yy];
  81
  82 (kill (x), x);
  83 'x;
  84
  85 block ([uu0 : 123, vv0 : 456], x : new (h (new (g), new (g (uu0, vv0)))));
  86 '(h (g (uu, vv), g (123, 456)));
  87
  88 ([a00, a01, b00, b01] : [123, 456, 789, 987],
  89  block ([a0 : '(a00 + a01), b0 : '(b00 + b01)], defstruct (foo (a = a0, b = b0))));
  90 '[foo (a00 + a01, b00 + b01)];
  91
  92 y : new (foo);
  93 '(foo (a00 + a01, b00 + b01));
  94
  95 ev (y);
  96 foo (123 + 456, 789 + 987);
  97
  98 /* IN FOLLOWING EXAMPLES QUOTE SHOULD BE UNNECESSARY !!
  99  * CHANGE $EV CODE TO MAKE IT WORK OK WITHOUT QUOTE !!
 100  */
 101
 102 ev (sin (x@xx + 1), '(x@xx)=%e);
 103 sin (%e + 1);
 104
 105 ev (sin (x@yy@uu + 1), '(x@yy@uu)=%i);
 106 sin (%i + 1);
 107
 108 x;
 109 '(h (g (uu, vv), g (123, 456)));
 110
 111 (kill (all), 0);
 112 0;
 113
 114 [a, b, c]: [x, y, z];
 115 [x, y, z];
 116
 117 [x, y, z]: [11, 22, 33];
 118 [11, 22, 33];
 119
 120 [''a, ''b, ''c];
 121 [11, 22, 33];
 122
 123 [x, y, z]: x*y*z;
 124 [7986, 7986, 7986];
 125
 126 [x, y, z];
 127 [7986, 7986, 7986];
 128
 129 (kill (a, b), [a, b]: [b, 2*a]);
 130 '[b, 2*a];
 131
 132 [a, b]: [b, 2*a];
 133 '[2*a, 2*b];
 134
 135 [a, b]: [b, 2*a];
 136 '[2*b, 4*a];
 137
 138 [a, b]: [b, 2*a];
 139 '[4*a, 4*b];
 140
 141 [a, b]: [b, 2*a];
 142 '[4*b, 8*a];
 143
 144 (kgcd(a, b) := (while b#0 do [a, b]: [b, remainder(a, b)], abs(a)), kgcd(11*7*5*3, 17*13*11*7));
 145 ''(gcd (11*7*5*3, 17*13*11*7));
 146
 147 (i:10, j:20, [i, j] : [j, i]);
 148 [20, 10];
 149
 150 [i, j];
 151 [20, 10];
 152
 153 /* QUESTIONABLE. MAYBE THIS ONE SHOULD CAUSE AN ERROR */
 154 [i, i] : [1, 2];
 155 [1, 2];
 156
 157 /* QUESTIONABLE. MAYBE PRECEDING ASSIGNMENT SHOULD HAVE FAILED */
 158 i;
 159 2;
 160
 161 a : [1, 2, 3, 4];
 162 [1, 2, 3, 4];
 163
 164 (i : 2, [i, a[i]] : [4, 11]);
 165 [4, 11];
 166
 167 a;
 168 [1, 11, 3, 4];
 169
 170 [ a[1], a[2] ] : [ a[3], a[4] ];
 171 [3, 4];
 172
 173 a;
 174 [3, 4, 3, 4];
 175
 176 (a : [1, 2, 3, 4], i:0, [ a[i : i + 1], a[i : i + 1] ] : [ a[i : i + 1], a[i : i + 1] ]);
 177 [1, 2];
 178
 179 a;
 180 [1, 2, 1, 2];
 181
 182 [a, [b, c], [[d, e], f]] : [1, [2, 3], [[4, 5], 6]];
 183 [1, [2, 3], [[4, 5], 6]];
 184
 185 [a, b, c, d, e, f];
 186 [1, 2, 3, 4, 5, 6];
 187
 188 /* NEED TESTS FOR :: HERE */
 189
 190 (L : '[a, b, c], L :: [11, 22, 33], [a, b, c]);
 191 [11, 22, 33];
 192
 193 /* example from mailing list 2014-02-27 "assigning to a list of structure fields does not work" */
 194
 195 (kill (P, N, D, Quot), defstruct(Quot(N,D=1)), P:new(Quot));
 196 Quot(N, 1);
 197
 198 [P@N,P@D]:[3,7];
 199 [3, 7];
 200
 201 P;
 202 Quot(3, 7);
 203
 204 /* some more tests */
 205
 206 kill (x, y, z, a, b, c, d);
 207 done;
 208
 209 (x : [a, b], y : [c, d], 0);
 210 0;
 211
 212 [x, y] :: [[1, 2], [3, 4]];
 213 [[1, 2], [3, 4]];
 214
 215 [a, b, c, d];
 216 [1, 2, 3, 4];
 217
 218 [x[1], y[1]] :: [11, 22];
 219 [11, 22];
 220
 221 [x, y, a, b, c, d];
 222 [[a, b], [c, d], 11, 2, 22, 4];
 223
 224 [x[1], y[1]] : [33, 44];
 225 [33, 44];
 226
 227 [x, y, a, b, c, d];
 228 [[33, b], [44, d], 11, 2, 22, 4];
 229
 230 (kill (foo), defstruct (foo (a, b)));
 231 [foo (a, b)];
 232
 233 z : new (foo (-1, -2));
 234 foo (-1, -2);
 235
 236 [z@b, z@a] : [-3, -4];
 237 [-3, -4];
 238
 239 z;
 240 foo (-4, -3);
 241
 242 kill (a, b);
 243 done;
 244
 245 [a[123], b[456]] : [17, 29];
 246 [17, 29];
 247
 248 a;
 249 a;
 250
 251 a[123];
 252 17;
 253
 254 [arrayinfo (a), listarray (a)];
 255 [[hashed, 1, [123]], [17]];
 256
 257 [arrayinfo (b), listarray (b)];
 258 [[hashed, 1, [456]], [29]];
 259
 260 [c[321], d[654]] : [19, 31];
 261 [19, 31];
 262
 263 [c, d];
 264 [22, 4];
 265
 266 [arrayinfo (c), arrayinfo (d)];
 267 [[hashed, 1, [321]], [hashed, 1, [654]]];
 268
 269 [listarray ('c), listarray ('d)];
 270 [[19], [31]];
 271
 272 [a, [b, [c, [d, [x, [y, [z]]]]]]] : [-1, [-2, [-3, [-4, [-5, [-6, [-7]]]]]]];
 273 [-1, [-2, [-3, [-4, [-5, [-6, [-7]]]]]]];
 274
 275 [a, b, c, d, x, y, z];
 276 [-1, -2, -3, -4, -5, -6, -7];
 277
 278 (hash_assign (e, x) := ?marrayset (x, ?meval (first (e)), ?meval (second (e))),
 279  translate (hash_assign), /* mset extension op must be a Lisp function */
 280  infix ("hash_get"),
 281  ?putprop (verbify ("hash_get"), 'hash_assign, '?mset_extension_operator),
 282  0);
 283 0;
 284
 285 (foo [bar] : 123,
 286  foo hash_get bar : 456,
 287  foo [bar]);
 288 456;
 289
 290 [foo hash_get baz] : 789;
 291 [789];
 292
 293 foo [baz];
 294 789;
 295
 296 /* bug reported to mailing list 2017-02-02: "Structs broken?" */
 297
 298 (kill (all),
 299  reset (),
 300  defstruct (foo (a, b)),
 301  bar : new (foo),
 302  aa : make_array (fixnum, 6),
 303  bar@a : aa,
 304  0);
 305 0;
 306
 307 (bar@a[4] : 123,
 308  listarray (aa));
 309 [0, 0, 0, 0, 123, 0];
 310
 311 ?arrayp (bar@a);
 312 true;
 313
 314 listarray (bar@a);
 315 [0, 0, 0, 0, 123, 0];
 316
 317 (bb : make_array (fixnum, 6),
 318  f(i) := if i = 1 then aa elseif i = 2 then bb,
 319  0);
 320 0;
 321
 322 (f(2)[5] : 456,
 323  listarray (bb));
 324 [0, 0, 0, 0, 0, 456];
 325
 326 ?arrayp (f(2));
 327 true;
 328
 329 listarray (f(2));
 330 [0, 0, 0, 0, 0, 456];
 331
 332 (l : [aa, bb],
 333  0);
 334 0;
 335
 336 (l[2][1] : 789,
 337  listarray (bb));
 338 [0, 789, 0, 0, 0, 456];
 339
 340 ?arrayp (l[2]);
 341 true;
 342
 343 listarray (l[2]);
 344 [0, 789, 0, 0, 0, 456];
 345
 346 (h1[mumble] : aa,
 347  h1[blurf] : bb,
 348  0);
 349 0;
 350
 351 (h1[mumble][3] : 333,
 352  listarray (aa));
 353 [0, 0, 0, 333, 123, 0];
 354
 355 ?arrayp (h1[mumble]);
 356 true;
 357
 358 listarray (h1[mumble]);
 359 [0, 0, 0, 333, 123, 0];
 360
 361 (use_fast_arrays : true,
 362  h2[mumble] : aa,
 363  h2[blurf] : bb,
 364  0);
 365 0;
 366
 367 (h2[blurf][2] : 555,
 368  listarray (bb));
 369 [0, 789, 555, 0, 0, 456];
 370
 371 ?arrayp (h2[blurf]);
 372 true;
 373
 374 listarray (h2[blurf]);
 375 [0, 789, 555, 0, 0, 456];
 376
 377 (reset(use_fast_arrays),1);
 378 1;