235 | _ => (SEQ(r1d, STAR(r1)), f_seq f1d f_id) |
235 | _ => (SEQ(r1d, STAR(r1)), f_seq f1d f_id) |
236 end |
236 end |
237 | RECD(x, r1) => der_simp c r1 |
237 | RECD(x, r1) => der_simp c r1 |
238 |
238 |
239 |
239 |
240 |
|
241 (* matcher function *) |
240 (* matcher function *) |
242 fun matcher r s = nullable(ders (explode s) r) |
241 fun matcher r s = nullable(ders (explode s) r) |
243 |
242 |
244 (* lexing function (produces a value) *) |
243 (* lexing function (produces a value) *) |
245 exception LexError |
244 exception LexError |
249 | c::cs => inj r c (lex (der c r) cs) |
248 | c::cs => inj r c (lex (der c r) cs) |
250 |
249 |
251 fun lexing r s = lex r (explode s) |
250 fun lexing r s = lex r (explode s) |
252 |
251 |
253 (* lexing with simplification *) |
252 (* lexing with simplification *) |
|
253 |
|
254 fun fst (a, b) = a |
|
255 |
|
256 fun ders_simp r s = case s of |
|
257 [] => r |
|
258 | c::s => ders_simp (fst (simp (der c r))) s |
|
259 |
|
260 |
254 fun lex_simp r s = case s of |
261 fun lex_simp r s = case s of |
255 [] => if (nullable r) then mkeps r else raise LexError |
262 [] => if (nullable r) then mkeps r else raise LexError |
256 | c::cs => |
263 | c::cs => |
257 let val (r_simp, f_simp) = simp (der c r) in |
264 let val (r_simp, f_simp) = simp (der c r) in |
258 inj r c (f_simp (lex_simp r_simp cs)) |
265 inj r c (f_simp (lex_simp r_simp cs)) |
259 end |
266 end |
260 |
267 |
261 fun lexing_simp r s = lex_simp r (explode s) |
268 fun lexing_simp r s = lex_simp r (explode s) |
262 |
269 |
|
270 (* does derivatives and simplificatiomn in one step *) |
263 fun lex_simp2 r s = case s of |
271 fun lex_simp2 r s = case s of |
264 [] => if (nullable r) then mkeps r else raise LexError |
272 [] => if (nullable r) then mkeps r else raise LexError |
265 | c::cs => |
273 | c::cs => |
266 let val (r_simp, f_simp) = der_simp c r in |
274 let val (r_simp, f_simp) = der_simp c r in |
267 inj r c (f_simp (lex_simp2 r_simp cs)) |
275 inj r c (f_simp (lex_simp2 r_simp cs)) |
268 end |
276 end |
269 |
277 |
270 fun lexing_simp2 r s = lex_simp2 r (explode s) |
278 fun lexing_simp2 r s = lex_simp2 r (explode s) |
271 |
279 |
|
280 (* uses an accumulator for the rectification functions *) |
272 fun lex_acc r s f = case s of |
281 fun lex_acc r s f = case s of |
273 [] => if (nullable r) then f (mkeps r) else raise LexError |
282 [] => if (nullable r) then f (mkeps r) else raise LexError |
274 | c::cs => |
283 | c::cs => |
275 let val (r_simp, f_simp) = simp (der c r) in |
284 let val (r_simp, f_simp) = simp (der c r) in |
276 lex_acc r_simp cs (fn v => f (inj r c (f_simp v))) |
285 lex_acc r_simp cs (fn v => f (inj r c (f_simp v))) |
283 | c::cs => |
292 | c::cs => |
284 let val (r_simp, f_simp) = der_simp c r in |
293 let val (r_simp, f_simp) = der_simp c r in |
285 lex_acc2 r_simp cs (fn v => f (inj r c (f_simp v))) |
294 lex_acc2 r_simp cs (fn v => f (inj r c (f_simp v))) |
286 end |
295 end |
287 |
296 |
288 fun lexing_acc2 r s = lex_acc2 r (explode s) (f_id) |
297 fun lexing_acc2 r s = lex_acc2 r (explode s) f_id |
289 |
298 |
290 |
299 |
291 (* Lexing rules for a small WHILE language *) |
300 (* Lexing rules for a small WHILE language *) |
292 val sym = alts (List.map chr (explode "abcdefghijklmnopqrstuvwxyz")) |
301 val sym = alts (List.map chr (explode "abcdefghijklmnopqrstuvwxyz")) |
293 val digit = alts (List.map chr (explode "0123456789")) |
302 val digit = alts (List.map chr (explode "0123456789")) |
372 " if isprime == 1 then write i else skip;", |
382 " if isprime == 1 then write i else skip;", |
373 " i := i + 1", |
383 " i := i + 1", |
374 "}"]; |
384 "}"]; |
375 |
385 |
376 |
386 |
|
387 print("The prog2 string is of length: >>" ^ (PolyML.makestring (String.size prog2)) ^ "<<\n"); |
|
388 |
377 let |
389 let |
378 val tst = (lexing_simp while_regs prog2 = lexing_acc while_regs prog2) |
390 val tst = (lexing_simp while_regs prog2 = lexing_acc while_regs prog2) |
379 in |
391 in |
380 print("Sanity test: >>" ^ (PolyML.makestring tst) ^ "<<\n") |
392 print("Sanity test: >>" ^ (PolyML.makestring tst) ^ "<<\n") |
381 end; |
393 end; |
382 |
394 |
|
395 print("Size after 50: " ^ |
|
396 PolyML.makestring(size (ders_simp while_regs (explode (string_repeat prog2 50)))) ^ "\n"); |
|
397 |
|
398 print("Size after 5000: " ^ |
|
399 PolyML.makestring(size (ders_simp while_regs (explode (string_repeat prog2 5000)))) ^ "\n"); |
|
400 |
|
401 |
383 (* loops in ML *) |
402 (* loops in ML *) |
384 datatype for = to of int * int |
403 datatype for = to of int * int |
385 infix to |
404 infix to |
386 |
405 |
387 val for = |
406 val for = |
388 fn lo to up => |
407 fn lo to up => |
389 (fn f => |
408 (fn f => |
390 let fun loop lo = |
409 let fun loop lo = |
391 if lo > up then () else (f lo; loop (lo + 1)) |
410 if lo > up then () else (f lo; loop (lo + 1)) |
392 in loop lo end) |
411 in loop lo end); |
393 |
412 |
394 fun forby n = |
413 fun forby n = |
395 fn lo to up => |
414 fn lo to up => |
396 (fn f => |
415 (fn f => |
397 let fun loop lo = |
416 let fun loop lo = |
398 if lo > up then () else (f lo; loop (lo + n)) |
417 if lo > up then () else (f lo; loop (lo + n)) |
399 in loop lo end) |
418 in loop lo end); |
400 |
419 |
401 |
420 |
402 fun step_simp i = |
421 fun step_simp i = |
403 (print ((Int.toString i) ^ ": ") ; |
422 (print ((Int.toString i) ^ ": ") ; |
404 time (lexing_simp while_regs) (string_repeat prog2 i)) |
423 time (lexing_simp while_regs) (string_repeat prog2 i)); |
405 |
424 |
406 fun step_simp2 i = |
425 fun step_simp2 i = |
407 (print ((Int.toString i) ^ ": ") ; |
426 (print ((Int.toString i) ^ ": ") ; |
408 time (lexing_simp2 while_regs) (string_repeat prog2 i)) |
427 time (lexing_simp2 while_regs) (string_repeat prog2 i)); |
409 |
428 |
410 fun step_acc i = |
429 fun step_acc i = |
411 (print ((Int.toString i) ^ ": ") ; |
430 (print ((Int.toString i) ^ ": ") ; |
412 time (lexing_acc while_regs) (string_repeat prog2 i)) |
431 time (lexing_acc while_regs) (string_repeat prog2 i)); |
413 |
432 |
414 fun step_acc2 i = |
433 fun step_acc2 i = |
415 (print ((Int.toString i) ^ ": ") ; |
434 (print ((Int.toString i) ^ ": ") ; |
416 time (lexing_acc2 while_regs) (string_repeat prog2 i)) |
435 time (lexing_acc2 while_regs) (string_repeat prog2 i)); |
417 |
436 |
|
437 |
|
438 |
|
439 print("\nTest step_simp\n"); |
418 val main1 = forby 1000 (1000 to 5000) step_simp; |
440 val main1 = forby 1000 (1000 to 5000) step_simp; |
419 print "\n"; |
441 |
|
442 print("\nTest step_simp2\n"); |
420 val main2 = forby 1000 (1000 to 5000) step_simp2; |
443 val main2 = forby 1000 (1000 to 5000) step_simp2; |
421 print "\n"; |
444 |
|
445 (* |
|
446 print("\nTest step_acc\n"); |
422 val main3 = forby 1000 (1000 to 5000) step_acc; |
447 val main3 = forby 1000 (1000 to 5000) step_acc; |
423 print "\n"; |
448 |
424 val main4 = forby 1000 (1000 to 5000) step_acc2; |
449 print("\nTest step_acc2\n"); |
425 |
450 val main4 = forby 1000 (1000 to 5000) step_acc2; |
426 |
451 *) |
|
452 |
|
453 |
|
454 |