moculus
parent
d484d5b676
commit
435bd37405
|
|
@ -0,0 +1,146 @@
|
|||
(define-syntax cond
|
||||
(syntax-rules (else =>)
|
||||
((cond (else result1 result2 ...))
|
||||
(begin result1 result2 ...))
|
||||
((cond (test => result))
|
||||
(let ((temp test))
|
||||
(if temp (result temp))))
|
||||
((cond (test => result) clause1 clause2 ...)
|
||||
(let ((temp test))
|
||||
(if temp
|
||||
(result temp)
|
||||
(cond clause1 clause2 ...))))
|
||||
((cond (test)) test)
|
||||
((cond (test) clause1 clause2 ...)
|
||||
(let ((temp test))
|
||||
(if temp
|
||||
temp
|
||||
(cond clause1 clause2 ...))))
|
||||
((cond (test result1 result2 ...))
|
||||
(if test (begin result1 result2 ...)))
|
||||
((cond (test result1 result2 ...)
|
||||
clause1 clause2 ...)
|
||||
(if test
|
||||
(begin result1 result2 ...)
|
||||
(cond clause1 clause2 ...)))))
|
||||
|
||||
(define-syntax case
|
||||
(syntax-rules (else)
|
||||
((case (key ...)
|
||||
clauses ...)
|
||||
(let ((atom-key (key ...)))
|
||||
(case atom-key clauses ...)))
|
||||
((case key
|
||||
(else result1 result2 ...))
|
||||
(begin result1 result2 ...))
|
||||
((case key
|
||||
((atoms ...) result1 result2 ...))
|
||||
(if (memv key '(atoms ...))
|
||||
(begin result1 result2 ...)))
|
||||
((case key
|
||||
((atoms ...) result1 result2 ...)
|
||||
clause clauses ...)
|
||||
(if (memv key '(atoms ...))
|
||||
(begin result1 result2 ...)
|
||||
(case key clause clauses ...)))))
|
||||
|
||||
(define-syntax and
|
||||
(syntax-rules ()
|
||||
((and) #t)
|
||||
((and test) test)
|
||||
((and test1 test2 ...)
|
||||
(if test1 (and test2 ...) #f))))
|
||||
|
||||
(define-syntax or
|
||||
(syntax-rules ()
|
||||
((or) #f)
|
||||
((or test) test)
|
||||
((or test1 test2 ...)
|
||||
(let ((x test1))
|
||||
(if x x (or test2 ...))))))
|
||||
|
||||
(define-syntax let
|
||||
(syntax-rules ()
|
||||
((let ((name val) ...) body1 body2 ...)
|
||||
((lambda (name ...) body1 body2 ...)
|
||||
val ...))
|
||||
((let tag ((name val) ...) body1 body2 ...)
|
||||
((letrec ((tag (lambda (name ...)
|
||||
body1 body2 ...)))
|
||||
tag)
|
||||
val ...))))
|
||||
|
||||
(define-syntax let*
|
||||
(syntax-rules ()
|
||||
((let* () body1 body2 ...)
|
||||
(let () body1 body2 ...))
|
||||
((let* ((name1 val1) (name2 val2) ...)
|
||||
body1 body2 ...)
|
||||
(let ((name1 val1))
|
||||
(let* ((name2 val2) ...)
|
||||
body1 body2 ...)))))
|
||||
|
||||
(define-syntax letrec
|
||||
(syntax-rules ()
|
||||
((letrec ((var1 init1) ...) body ...)
|
||||
(letrec "generate_temp_names"
|
||||
(var1 ...)
|
||||
()
|
||||
((var1 init1) ...)
|
||||
body ...))
|
||||
((letrec "generate_temp_names"
|
||||
()
|
||||
(temp1 ...)
|
||||
((var1 init1) ...)
|
||||
body ...)
|
||||
(let ((var1 <undefined>) ...)
|
||||
(let ((temp1 init1) ...)
|
||||
(set! var1 temp1)
|
||||
...
|
||||
body ...)))
|
||||
((letrec "generate_temp_names"
|
||||
(x y ...)
|
||||
(temp ...)
|
||||
((var1 init1) ...)
|
||||
body ...)
|
||||
(letrec "generate_temp_names"
|
||||
(y ...)
|
||||
(newtemp temp ...)
|
||||
((var1 init1) ...)
|
||||
body ...))))
|
||||
|
||||
(define-syntax begin
|
||||
(syntax-rules ()
|
||||
((begin exp ...)
|
||||
((lambda () exp ...)))))
|
||||
|
||||
(define-syntax begin
|
||||
(syntax-rules ()
|
||||
((begin exp)
|
||||
exp)
|
||||
((begin exp1 exp2 ...)
|
||||
(let ((x exp1))
|
||||
(begin exp2 ...)))))
|
||||
|
||||
(define-syntax do
|
||||
(syntax-rules ()
|
||||
((do ((var init step ...) ...)
|
||||
(test expr ...)
|
||||
command ...)
|
||||
(letrec
|
||||
((loop
|
||||
(lambda (var ...)
|
||||
(if test
|
||||
(begin
|
||||
(if #f #f)
|
||||
expr ...)
|
||||
(begin
|
||||
command
|
||||
...
|
||||
(loop (do "step" var step ...)
|
||||
...))))))
|
||||
(loop init ...)))
|
||||
((do "step" x)
|
||||
x)
|
||||
((do "step" x y)
|
||||
y)))
|
||||
|
|
@ -12,36 +12,27 @@ class StringGrammar(Grammar):
|
|||
class SchemeGrammar(Grammar):
|
||||
rules = [
|
||||
PatternRule(r'comment', r';.*$'),
|
||||
PatternRule(r'delimiter', r'\(|\)|,'),
|
||||
|
||||
PatternRule(r'quote', r"'"),
|
||||
PatternRule(r'backquote', r"`"),
|
||||
PatternRule(r'atcomma', r',@'),
|
||||
PatternRule(r'comma', r',@'),
|
||||
|
||||
PatternRule(r'delimiter', r'\(|\)'),
|
||||
RegionRule(r'string', r'"', StringGrammar, r'"'),
|
||||
PatternRule(r'spaces', r' +'),
|
||||
PatternRule(r'eol', r'\n'),
|
||||
PatternRule(r'abbrev', r"'|`|,\@|,"),
|
||||
|
||||
PatternRule(r'keyword', r'quote|lambda|if|set|begin|cond|and|or|case|let\*|letrec|let|do|delay|quasiquote|else|=>|define|unquote-splicing|unquote'),
|
||||
PatternRule(r'keyword', r'define-syntax|define-macro|syntax-rules'),
|
||||
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'),
|
||||
|
||||
PatternRule(r'predicate', r'(?:boolean|symbol|char|vector|procedure|pair|number|string|port)\?'),
|
||||
PatternRule(r'predicate', r'(?:eqv|equal|complex|real|rational|integer|zero|positive|negative|odd|even|null|list|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)\?'),
|
||||
|
||||
PatternRule(r'procedure', r'max|min|\+|-|\*|/|abs|quotient|remainder|modulo|lcm|gcd|numerator|denominator|floor|ceiling|truncate|round|rationalize|exp|log|sin|cos|tan|asin|acos|atan|make-rectangular|make-polar|real-part|imag-part|magnitude|angle|not|cons|car|cdr|list-tail|list-ref|list|length|append|reverse|memq|memv|member|assq|assv|assoc|char-upcase|char-downcase|make-string|string|string-ref'),
|
||||
PatternRule(r'procedure', r'char->integer|integer->char'),
|
||||
|
||||
PatternRule(r'mutator', r'(?:set-car|set-cdr|string-set)\!'),
|
||||
|
||||
PatternRule(r'variable', r'[a-zA-Z!$%&*/:<=>?\^_~][a-zA-Z0-9!$%&*/:<=>?^_~+-.@]*|\+|-|...'),
|
||||
# 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)(?![^ ()])'),
|
||||
|
||||
PatternRule(r'boolean', r'#[tf]'),
|
||||
PatternRule(r'char', r'#\\space|#\\newline|#\\.'),
|
||||
|
||||
# these are basically right and very easy
|
||||
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!$%&*/:<=>?^_~+-.@]*|\+|-|...'),
|
||||
]
|
||||
|
||||
class SchemeTabber(tab2.StackTabber):
|
||||
|
|
@ -55,20 +46,19 @@ class Scheme(mode2.Fundamental):
|
|||
closetokens = ('delimiter',)
|
||||
closetags = {')': '(',},
|
||||
colors = {
|
||||
'keyword': ('cyan', 'default'),
|
||||
'reserved': ('blue', 'default'),
|
||||
'symbol': ('magenta', 'default'),
|
||||
'type': ('blue', 'default'),
|
||||
'comment': ('red', 'default'),
|
||||
|
||||
'keyword': ('cyan', 'default'),
|
||||
'builtin': ('blue', 'default'),
|
||||
|
||||
'string.start': ('green', 'default'),
|
||||
'string.null': ('green', 'default'),
|
||||
'string.octal': ('magenta', 'default'),
|
||||
'string.escaped': ('magenta', 'default'),
|
||||
'string.format': ('yellow', 'default'),
|
||||
'string.end': ('green', 'default'),
|
||||
'integer': ('default', 'default'),
|
||||
'float': ('default', 'default'),
|
||||
'imaginary': ('default', 'default'),
|
||||
'comment': ('red', 'default'),
|
||||
|
||||
'boolean': ('magenta', 'default'),
|
||||
'number': ('default', 'default'),
|
||||
}
|
||||
def __init__(self, w):
|
||||
mode2.Fundamental.__init__(self, w)
|
||||
|
|
|
|||
Loading…
Reference in New Issue