From 435bd374052ea5e2bb1f2a86c872108196b4551d Mon Sep 17 00:00:00 2001 From: moculus Date: Sun, 5 Aug 2007 04:05:14 +0000 Subject: [PATCH] --HG-- branch : pmacs2 --- code_examples/example.scm | 146 ++++++++++++++++++++++++++++++++++++++ mode/scheme.py | 46 +++++------- 2 files changed, 164 insertions(+), 28 deletions(-) create mode 100644 code_examples/example.scm diff --git a/code_examples/example.scm b/code_examples/example.scm new file mode 100644 index 0000000..bb5ec68 --- /dev/null +++ b/code_examples/example.scm @@ -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 ) ...) + (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))) diff --git a/mode/scheme.py b/mode/scheme.py index d97682e..a31e638 100644 --- a/mode/scheme.py +++ b/mode/scheme.py @@ -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)