--HG--

branch : pmacs2

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 <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)))

mode/scheme.py

@@ -12,36 +12,27 @@ class StringGrammar(Grammar):
 class SchemeGrammar(Grammar):
     rules = [
         PatternRule(r'comment', r';.*$'),
-        PatternRule(r'delimiter', r'\(|\)|,'),
+        PatternRule(r'delimiter', r'\(|\)'),
-
-        PatternRule(r'quote', r"'"),
-        PatternRule(r'backquote', r"`"),
-        PatternRule(r'atcomma', r',@'),
-        PatternRule(r'comma', 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)\?'),
+        # builtin predicates, mutators, and general procedures
-        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'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'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'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'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!$%&*/:<=>?^_~+-.@]*|\+|-|...'),
 
         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 = {
+        'comment': ('red', 'default'),
+
         'keyword': ('cyan', 'default'),
-        'reserved':       ('blue', 'default'),
+        'builtin': ('blue', 'default'),
-        'symbol':         ('magenta', 'default'),
+
-        'type':           ('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'),
+        'boolean': ('magenta', 'default'),
-        'imaginary':      ('default', 'default'),
+        'number':  ('default', 'default'),
-        'comment':        ('red', 'default'),
     }
     def __init__(self, w):
         mode2.Fundamental.__init__(self, w)