scheme mode fixes

--HG--
branch : pmacs2
This commit is contained in:
moculus 2007-08-15 14:37:35 +00:00
parent fcfe78b4a9
commit 90c0c654dc
2 changed files with 79 additions and 13 deletions

71
code_examples/demo.scm Normal file
View File

@ -0,0 +1,71 @@
; a helper function which prints each argument seperated by a space
(define output
(lambda (. things)
(cond
((null? things) (display #\newline))
(else
(display (car things))
(display #\space)
(apply output (cdr things))))))
; a helper function which shows arguments before calling them
(define explicit-apply
(lambda (f . args)
(let ((result (apply f args)))
(output f args result)
result)))
; determine whether or not a given attack roll will hit
(define is-hit?
(lambda (roll attack ac)
(or (= roll 20) (and (< 1 roll) (>= (+ roll attack) ac)))))
; determine whether or not a given attack roll will crit
(define is-crit?
(lambda (roll attack ac threat)
(or (= roll 20) (and (is-hit? roll attack ac) (>= roll threat)))))
; determine the expected damage of a particular attack roll
(define roll-dmg
(lambda (roll attack ac dmg threat mult)
(cond
((is-crit? roll attack ac threat) (* dmg mult))
((is-hit? roll attack ac) dmg)
(else 0))))
; determine the expected damage across all attack rolls
(define expected-dmg
(lambda (. args)
(define adder
(lambda (total roll)
(if (> roll 20)
total
(adder (+ total (apply roll-dmg roll args)) (+ roll 1)))))
(/ (adder 0 1) 20)))
; find the best power attack score (and expected damage) versus an AC
(define find-best-power
(lambda (power-max attack ac dmg threat mult)
(define checker
(lambda (power best-power best-dmg)
(if (> power power-max)
(list best-power best-dmg)
(let* ((a (- attack power))
(d (+ dmg power))
(ed (expected-dmg a ac d threat mult)))
(if (> ed best-dmg)
(checker (+ power 1) power ed)
(checker (+ power 1) best-power best-dmg))))))
(checker 0 0 0)))
; iterate across a range of armor classes
(define iter
(let ((max-power 6)
(attack 6)
(dmg 5.5)
(threat 20)
(mult 3))
(lambda (ac max-ac)
(explicit-apply find-best-power max-power attack ac dmg threat mult)
(if (> ac max-ac) #f (iter (+ ac 1) max-ac)))))
(iter 10 30)

View File

@ -13,21 +13,16 @@ class SchemeGrammar(Grammar):
PatternRule(r'eol', r'\n'),
PatternRule(r'abbrev', r"'|`|,\@|,"),
PatternRule(r'keyword', r'define-syntax|define-macro|syntax-rules|let-syntax|letrec-syntax'),
PatternRule(r'keyword', r'quote|lambda|if|set\!|begin|cond|and|or|case|let\*|letrec|let|do|delay|quasiquote|else|=>|define|unquote-splicing|unquote|loop'),
# builtin predicates, mutators, and general procedures
PatternRule(r'builtin', r'(?:eqv|equal|eq|number|complex|real|rational|integer|exact|inexact|=|<=|>=|<|>|zero|positive|negative|odd|even|boolean|pair|null|list|symbol|char=|char<=|char>=|char<|char>|char-ci=|char-ci<=|char-ci>=|char-ci<|char-ci>|char-alphabetic|char-numeric|char-whitespace|char-upper-case|char-lower-case|char|string|string=|string-ci=|string<=|string>=|string<|string>|string-ci<=|string-ci>=|string-ci>|string-ci<|vector|procedure|input-port|output-port|port|eof-object|char-ready)\?'),
PatternRule(r'builtin', r'(?:set-car|set-cdr|string-set|string-fill|vector-set|vector-fill|set)\!'),
PatternRule(r'builtin', r'(?:max|min|\+|\*|-|/|abs|quotient|remainder|modulo|gcd|lcm|numerator|denominator|floor|ceiling|truncate|round|rationalize|exp|log|sin|cos|tan|asin|acos|atan|sqrt|expt|make-rectangular|make-polar|real-part|imag-part|magnitude|angle|exact->inexact|inexact->exact|number->string|string->number|not|cons|car|cdr|caar|cadr|cdar|cddr|caaar|caadr|cadar|cdaar|caddr|cdadr|cddar|cdddr|caaaar|caaadr|caadar|cadaar|cdaaar|caaddr|cadadr|caddar|cdadar|cddaar|cadddr|cdaddr|cddadr|cdddar|cddddr|list-tail|list-ref|length|append|reverse|memq|memv|member|assq|assv|assoc|symbol->string|string->symbol|char->integer|integer->char|char-upcase|char-downcase|make-string|string-length|string-ref|string-append|string->list|list->string|string-copy|substring|make-vector|vector-length|vector-ref|vector->list|list->vector|apply|map|for-each|force|call-with-current-continuation|values|call-with-values|dynamic-wind|eval|scheme-report-environment|null-environment|interaction-environment|call-with-input-file|call-with-output-file|current-input-port|current-output-port|with-input-from-file|with-output-to-file|open-input-file|open-output-file|close-input-port|close-output-port|read-char|peek-char|eof-object|read|write-char|write|display|newline|load|transcript-on|transcript-off|list|string|vector)(?![^ ()])'),
# from r5rs
PatternRule(r'keyword', r'(?:=>|unquote-splicing|unquote|syntax-rules|set!|quote|quasiquote|or|map|loop|letrec-syntax|letrec|let-syntax|let\*|let|lambda|if|for-each|else|dynamic-wind|do|delay|define-syntax|define-macro|define|cond|case|call-with-output-file|call-with-input-file|call-with-current-continuation|begin|and)(?![^ )])'),
PatternRule(r'boolean', r'#[tf]'),
PatternRule(r'char', r'#\\space|#\\newline|#\\.'),
PatternRule(r'number', '[+-]?[0-9][^ \n]+'),
PatternRule(r'number', '#[bodx][ie]?[^ \n]+'),
PatternRule(r'number', '#[ie][bodx]?[^ \n]+'),
PatternRule(r'number', '[+-]?[0-9][^ ()\n]+'),
PatternRule(r'number', '#[bodx][ie]?[^ ()\n]+'),
PatternRule(r'number', '#[ie][bodx]?[^ ()\n]+'),
PatternRule(r'variable', r'[a-zA-Z!$%&*/:<=>?\^_~][a-zA-Z0-9!$%&*/:<=>?^_~+-.@]*|\+|-|...'),
PatternRule(r'variable', r'[a-zA-Z!$%&*/:<=>?\^_~][-a-zA-Z0-9!$%&*/:<=>?^_~+.@]*|\+|-|\.\.\.'),
]
class Scheme(mode2.Fundamental):
@ -41,14 +36,14 @@ class Scheme(mode2.Fundamental):
'comment': ('red', 'default'),
'keyword': ('cyan', 'default'),
'builtin': ('blue', 'default'),
'builtin': ('cyan', 'default'),
'string.start': ('green', 'default'),
'string.null': ('green', 'default'),
'string.octal': ('magenta', 'default'),
'string.escaped': ('magenta', 'default'),
'string.end': ('green', 'default'),
'char': ('green', 'default'),
'boolean': ('magenta', 'default'),
'number': ('default', 'default'),
}