comparison modules/parser.tp @ 256:03a07e540b9f

Memoize results of match:where:yield and matchOne: macros. Fix opsym rule to use the symbol ast node.
author Michael Pavone <pavone@retrodev.com>
date Sun, 01 Jun 2014 00:14:36 -0700
parents 004946743678
children 9d93e65a34be
comparison
equal deleted inserted replaced
255:08081b0a9382 256:03a07e540b9f
1 { 1 {
2 _matchid <- 0
3 getMatchId <- {
4 id <- _matchid
5 _matchid <- _matchid + 1
6 id
7 }
8 matchMemo <- {
9 _posdata <- #[]
10 _checkInitData <- :len {
11 len <- len + 1
12 while: { (_posdata length) < len } do: {
13 _posdata append: (dict hash)
14 }
15 }
16 #{
17 memo:at:withId:length <- :val :at :id :len {
18 _checkInitData: len
19 (_posdata get: at) set: id val
20 self
21 }
22
23 getMemo:at:else <- :id :at :else {
24 if: (_posdata length) > at {
25 (_posdata get: at) ifget: id :val {
26 val
27 } else: else
28 } else: else
29 }
30 }
31 }
2 light:from:withLength <- :_base :_start :_len { 32 light:from:withLength <- :_base :_start :_len {
33 _matchmemo <- matchMemo:
3 if: (not: (_base isBasicString?)) { 34 if: (not: (_base isBasicString?)) {
4 _start <- _start + (_base start) 35 _start <- _start + (_base start)
36 _matchmemo <- _base memoData
5 _base <- _base base 37 _base <- _base base
6 } 38 }
7 _needsflat? <- true 39 _needsflat? <- true
8 _flat <- false 40 _flat <- false
9 #{ 41 #{
51 } 83 }
52 isString? <- { true } 84 isString? <- { true }
53 isBasicString? <- { false } 85 isBasicString? <- { false }
54 base <- { _base } 86 base <- { _base }
55 start <- { _start } 87 start <- { _start }
88 memoData <- { _matchmemo }
89
90 memo:at:withId <- :val :at :id {
91 _matchmemo memo: val at: (at + _start) withId: id length: (_base length)
92 self
93 }
94
95 getMemo:at:else <- :id :at :else {
96 _matchmemo getMemo: id at: (at + _start) else: else
97 }
56 } 98 }
57 } 99 }
58 100
59 light:from <- :base :start { 101 light:from <- :base :start {
60 light: base from: start withLength: (base length) - start 102 light: base from: start withLength: (base length) - start
369 onePlus <- macro: :matchexpr { 411 onePlus <- macro: :matchexpr {
370 _nPlus: matchexpr 1 412 _nPlus: matchexpr 1
371 } 413 }
372 414
373 matchOne <- macro: :options { 415 matchOne <- macro: :options {
416 myid <- getMatchId:
374 options <- (options value) map: :option { 417 options <- (options value) map: :option {
375 _makeMatchCall: option 418 _makeMatchCall: option
376 } 419 }
377 body <- options foldr: (quote: false) with: :acc el { 420 body <- options foldr: (quote: false) with: :acc el {
378 if: (el valid?) { 421 if: (el valid?) {
382 print: "#error Invalid matchOne macro call: " . (el message) . "\n" 425 print: "#error Invalid matchOne macro call: " . (el message) . "\n"
383 acc 426 acc
384 } 427 }
385 } 428 }
386 quote: :tomatch { 429 quote: :tomatch {
387 body 430 tomatch <- light: tomatch from: 0
431 tomatch getMemo: myid at: 0 else: {
432 ret <- body
433 tomatch memo: ret at: 0 withId: myid
434 ret
435 }
388 } 436 }
389 } 437 }
390 438
391 match <- macro: :matchexpr { 439 match <- macro: :matchexpr {
392 mc <- _makeMatchCall: matchexpr 440 mc <- _makeMatchCall: matchexpr
429 print: "#error Invalid macth:yield macro call: " . (mc message) . "\n" 477 print: "#error Invalid macth:yield macro call: " . (mc message) . "\n"
430 } 478 }
431 } 479 }
432 480
433 match:where:yield <- macro: :matchexpr :whereclause :ylambda { 481 match:where:yield <- macro: :matchexpr :whereclause :ylambda {
482 myid <- getMatchId:
434 syms <- [] 483 syms <- []
435 withwhere <- (whereclause expressions) fold: (quote: :tomatch {}) with: :acc el { 484 withwhere <- (whereclause expressions) fold: (quote: {}) with: :acc el {
436 485
437 if: (el nodeType) = "assignment" { 486 if: (el nodeType) = "assignment" {
438 valassign <- quote: (val <- false) 487 valassign <- quote: (val <- false)
439 valsym <- (valassign) symbol 488 valsym <- (valassign) symbol
440 valsym <- valsym name!: (valsym name) . ((el symbol) name) 489 valsym <- valsym name!: (valsym name) . ((el symbol) name)
521 lsym <- el orig 570 lsym <- el orig
522 rsym <- el matchval 571 rsym <- el matchval
523 (quote: (lsym <- rsym)) | acc 572 (quote: (lsym <- rsym)) | acc
524 } 573 }
525 successLambda <- successLambda expressions!: sucexp 574 successLambda <- successLambda expressions!: sucexp
526 withwhere addExpression: (quote: (if: matchres successLambda else: { 575 withwhere addExpression: (quote: (ret <- if: matchres successLambda else: {
527 matchres 576 matchres
528 })) 577 }))
529 withwhere 578 withwhere addExpression: (quote: (tomatch memo: ret at: 0 withId: myid))
579 withwhere addExpression: (quote: ret)
580
581 quote: :tomatch {
582 tomatch <- light: tomatch from: 0
583 tomatch getMemo: myid at: 0 else: withwhere
584 }
530 } else: { 585 } else: {
531 print: "#error Error in main match expression of match:where:yield: " . (mcMain message) . "\n" 586 print: "#error Error in main match expression of match:where:yield: " . (mcMain message) . "\n"
532 } 587 }
533 } 588 }
534 589
795 } 850 }
796 851
797 opsym <- match: Name where: { 852 opsym <- match: Name where: {
798 Name <- matchOne: ["&&" "||" "<=" ">=" "<" ">" "=" "!=" "=" "-" "." "*" "/" "%" "|"] 853 Name <- matchOne: ["&&" "||" "<=" ">=" "<" ">" "=" "!=" "=" "-" "." "*" "/" "%" "|"]
799 } yield: { 854 } yield: {
800 #{ 855 ast symbol: Name
801 name <- Name
802 string <- {
803 name
804 }
805 }
806 } 856 }
807 857
808 assignment <- match: ws . Symbol . hws . "<-" . Expr where: { 858 assignment <- match: ws . Symbol . hws . "<-" . Expr where: {
809 Symbol <- matchOne: [ 859 Symbol <- matchOne: [
810 symexpr 860 symexpr