Committed a lot of work on error management and structs

8 files changed, 406 insertions, 34 deletions

diff --git a/artima/scheme/errors.ss b/artima/scheme/errors.ss
new file mode 100644
index 0000000..591fb3d
--- /dev/null
+++ b/artima/scheme/errors.ss
@@ -0,0 +1,274 @@
+#|
+
+Statements versus expressions: the functional way
+----------------------------------------------------------------
+
+One of the substantial differences between an imperative language
+and a functional one is the lack of statements in the latter.
+
+There are least two reasons
+for this lack.
+One is just a matter of economy: since expressions
+are enough, why should we introduce an additional concept?
+As we know, functional languages have a monastic vocation and they
+try to remove as many concepts as possible.
+
+The other reason is that since a statement cannot return anything
+(after all, this is part of the definition of statement),
+the only way the statement
+has to have an effect on the surrounding code is way side effects
+and we all know that functional languages dislike side effects,
+therefore they dislike statements.
+
+The final outcome is that all the constructs which in other languages
+are implemented as statements in a functional language must be
+implemented as expressions. In this episode I will give a concrete
+example, explaining how the ``try .. except .. finally`` construct of
+Python can be translated into Scheme.
+
+Error management in Scheme
+-------------------------------------------------------------
+
+One of the major new things in the R6RS specification was the
+stardardization of a condition system. The
+condition system is not a new concept, since Common Lisp has featured
+a condition system for years and many R5RS Scheme implementation
+provided equivalent systems. Nevertheless, conditions systems are more
+or less unknown outside the Lisp family of languages.
+
+If you have no idea of what "condition system" means, think of it
+like an ordinary exception system, with two differences:
+exceptions are described by records and not by classes, 
+and there is a special class of exceptions which are resumable.
+That means that
+the control flow, in specific circumnstances - basically when
+the condition is a mild error that can be recovered - can re-enter
+at the point the condition was raised and continue from there.
+This is impossible in Python and in most languages.
+
+
+The condition mechanism is pretty
+complex and I would need an entire episode to discuss it in detail.
+Moreover, I cannot discuss it right now, since I have not introduced
+the concepts underlying it, i.e. records and continuations.
+
+Records are relatively easy to explain, since they are more or
+less similar to records in othe languages.
+Since Scheme is not expecially object oriented, it should not come
+as a surprise that exceptions
+(more correctly called conditions) are implemented as records
+and not as classes; moreover, since Scheme records
+features inheritance, they are enough to implement a hierarchical
+system of conditions.
+
+On the other hand, continuations are pretty difficult to explain
+and I will not even attempt
+to start here: therefore I will ignore completely resumable exceptions
+for the time being.
+I will focus on non-resumable conditions, i.e. exceptions, instead.
+
+The standard specifies an easy way to raise exceptions , via the ``error``
+procedure
+
+ ``(error who message . args)``
+
+and the ``syntax-violation`` procedure
+
+ ``(syntax-violation who message form subform)``
+
+which raises syntax errors at compile time.
+
+The identifier ``who`` is usually the name of the function raising the error,
+whereas the string ``message`` is the error message we want to display.
+We can also pass exception arguments which are collected in the so-called
+lists of irritants::
+
+ > (error 'from-repl "An example error raised frome the REPL" 'arg1 'arg2)
+ Unhandled exception
+  Condition components:
+    1. &error
+    2. &who: from-repl
+    3. &message: "An example error raised frome the REPL"
+    4. &irritants: (arg1 arg2) 
+
+Unfortunately, there is no shortcut for trapping such simple errors,
+therefore
+I will have to implement my own by using the R6RS ``guard``
+macro, which is quite cumbersome to use (at least for me).
+
+You can find all the gory details about the condition system and
+the ``guard`` macro in the `R6RS library`_; the basic syntax is
+``(guard (<variable>  <cond clause1> <cond clause2> ...) <body>)``
+where ``<variable>`` is the name of the variable describing
+the condition, the clauses are like in a ``cond`` expression
+and the ``body`` is an expression which may raise conditions.
+
+We can implement a simple ``_try-except``
+expression on top of ``guard`` as follows:
+
+$$try:_TRY-EXCEPT
+
+``_try-except`` is able to trap exceptions coming from ``error`` or
+from ``syntax-violation``: those a small subclass of all available
+conditions, but they are enough for our purposes. In particular,
+such exceptions are not hierarchical, so we are not trying to
+catch a class of exceptions, but just a set of specific
+exceptions identified by their names (the ``who`` attribute).
+For instance, we could write a calculator of numeric expressions
+as follows:
+
+$$CALC
+
+Here are a few tests:
+
+$$TESTS
+
+try .. except .. else
+---------------------------------------------
+
+Python ``try .. except`` statement also features an ``else`` clause which
+is invoked if the exceptions is not raised. Our ``_try-except`` syntax
+does not have an ``else`` clause, since it is unneeded. We can just
+put the content in the ``else`` clause in the body of the expression:
+if there is no exception, the code will be run, otherwise it will be not.
+The only trick is that the expression must return the value of the
+original expression, not the value of the ``else`` clause. That
+can be easily accomplished by means of a ``begin0`` form.
+
+``begin0`` is a macro which takes a number of expressions and returns
+the zero-th expressions: it is somewhat the opposite of ``begin``, which
+takes the last expression. ``begin0`` is not standard, however it is
+built-in in various Scheme implementations (for instance in PLT Scheme
+and Gauche) and has equivalent in various functional languages (for
+instance ``before`` in SML).                         
+
+Here is practical example of how you can convert a ``try ..  except .. else``
+form into a ``_try-except`` form, by using ``begin0``::
+
+ import ieee
+
+ def save_invert(x):
+     try:
+        res = 1/x
+     except ZeroDivisionError, e:
+        print e
+        return if x>0 ieee.PINF else ieee.MINF
+     else:
+        print 'ok'
+        return res
+
+becomes
+
+$$SAFE-INVERT
+
+Finalization in Scheme
+---------------------------------------------------------
+
+One work is not finished. We have just implemented a ``try .. except``
+syntax, but if we really want to parallels Python, we need to
+extend it ti a ``try .. except .. finally`` syntax.
+
+Scheme does not have
+a standard syntax for ``try .. finally``, however, it has a higher
+order function called ``dynamic-wind`` which takes three thunks
+(the *before* thunk, the *body* thunk, and the *after* thunk) and
+execute them in order: in particular the after thunk is run
+even if there is an exception of if the control flow of the
+body is non trivial (for instance if the body invokes a
+continuation, but this is a subject we will leave for a
+future episode). Therefore it is pretty obvious that
+a ``try .. finally`` macro can be implemented in terms
+of ``dynamic-wind`` as follows:
+
+$$try:_TRY-FINALLY
+
+Notice that U did not enforce ``finally`` to be a literal identifier
+here, since ``_try-finally`` is intended to be a helper syntax
+which is never called directly. The final ``try`` syntax will be
+built on top of ``_try-finally`` and will enforce ``finally`` to
+be a literal identifier.
+
+Here is an example showing that ``_try-finally`` does its job, i.e.
+the ``finally`` clause is honored even in presence of an error::
+
+ > (_try-finally
+    (error 'some-error "An example")
+    (finally (display "done")))
+ Unhandled exception
+  Condition components:
+    1. &error
+    2. &who: some-error
+    3. &message: "An example"
+    4. &irritants: ()
+ done>
+
+At this point, it is easy to define a fully featured
+``(try .. except .. else .. finally)`` construct:
+
+$$try:TRY
+
+The construct here is less powerful than the Python equivalent,
+since exceptions are identified by a simple identifier and
+not by classes, so that you cannot catch subclasses of
+exceptions, but it is enough to be used in the following
+episodes. 
+
+.. _dynamic-wind: http://www.r6rs.org/final/html/r6rs/r6rs-Z-H-14.html#node_idx_764
+.. _R6RS library: http://www.r6rs.org/final/html/r6rs-lib/r6rs-lib-Z-H-8.html
+
+
+|#
+
+(import (rnrs) (sweet-macros) (easy-test) (ikarus))
+
+;BEGIN0
+(def-syntax (begin0 e0 e ...)
+  #'(let ((out e0)) e ... out))
+;END
+
+;CALC
+(def-syntax (calc numeric-expr)
+  #'(_try-except
+     (let ((n numeric-expr))
+       (if (number? n) n
+           (error 'calc "not a number" n)))
+     (except (arithmetic-error / * + -)
+             (display arithmetic-error)
+             (newline)
+             (condition-message arithmetic-error))
+     (except (other-error)
+             (display other-error)
+             (newline)
+             "some error")))
+;END
+
+
+;;SAFE-INVERT
+(define PINF (expt 10. 1000))
+(define MINF (- (expt 10. 1000)))
+
+(define (safe-invert x)
+  (_try-except
+   (begin0 (/ 1 x)
+     (display "ok\n"))
+   (except (exn /)
+     (display "zero division error\n")
+     (if (> x 0) PINF MINF))))
+;END
+
+;;_TRY-FINALLY
+(def-syntax (_try-finally e e* ... (finally f f* ...))
+  #'(dynamic-wind
+        void
+        (lambda () e e* ...)
+        (lambda () f f* ...)))
+;;END
+
+
+;;TESTS
+(run
+ (test "0" (calc (+ 1 1)) 2)
+ (test "1" (calc (/ 1 0)) "division by 0")
+ (test "2" (calc (+ 1 "0")) "not a number")
+ (test "3" (calc "a") "some error"))
+;;END
diff --git a/artima/scheme/scheme11.ss b/artima/scheme/scheme11.ss
index 06001df..4f1aa73 100644
--- a/artima/scheme/scheme11.ss
+++ b/artima/scheme/scheme11.ss
@@ -83,14 +83,14 @@ time. However, it is possible to replace the higher order function
 with a macro, therefore avoiding the cost of a function call.
 Here is the code for a ``repeat`` macro doing the job of ``call``:
 
-@@repeat-macro.sls
+$$repeat-macro:
 
 ``repeat`` expands into a loop and therefore the body is evaluated ``n``
 times, which is exactly what we need for a benchmark.
 To check that the macro is effectively more efficient, I did measure
 the time spent in summing 1+1 ten million of times:
 
-@@repeat-benchmark.ss
+$$repeat-benchmark:
 
 I took the number ``n`` from the command line arguments
 in order to fool the compiler: if I hard coded ``(+ 1 1)``, the compiler
@@ -137,7 +137,7 @@ The source code takes just a page:
 
 .. image:: http://www.phyast.pitt.edu/~micheles/scheme/feu_rouge.jpg
 
-@@easy-test.sls
+$$easy-test:
 
 The core of the framework is the ``test`` macro, which is a bit different
 from the macros we have defined until now. The reason why the ``test``
diff --git a/artima/scheme/scheme8.ss b/artima/scheme/scheme8.ss
index 42d77b1..4728277 100644
--- a/artima/scheme/scheme8.ss
+++ b/artima/scheme/scheme8.ss
@@ -182,7 +182,7 @@ writing of compilers easy.
 In this case you can write a compiler expanding ``for`` expressions
 into named lets as follows:
 
-@@simple-compiler.ss
+$$simple-compiler:
 
 Running the script you will see that it replaces the ``for`` expression
 with a *named let* indeed. It is not difficult to extend the compiler
diff --git a/scheme/list-utils.sls b/scheme/list-utils.sls
index be43bbd..66705d9 100644
--- a/scheme/list-utils.sls
+++ b/scheme/list-utils.sls
@@ -1,7 +1,7 @@
 (library (list-utils)
  (export list-of fold range enumerate zip transpose distinct? perm
          remove-dupl merge-unique)
- (import (rnrs) (sweet-macros))
+ (import (rnrs) (sweet-macros) (list-match))
 
 (define range 
   (case-lambda 
@@ -86,6 +86,6 @@
           acc
           (cons el acc))) '() lst)))
 
-(define (merge-unique eq? . lists)
+(define (append-unique eq? . lists)
   (remove-dupl eq? (apply append lists)))
 )
diff --git a/scheme/struct.sls b/scheme/struct.sls
new file mode 100644
index 0000000..217d2e8
--- /dev/null
+++ b/scheme/struct.sls
@@ -0,0 +1,42 @@
+(library (struct)
+(export struct base-struct struct->alist struct-get)
+(import (rnrs) (sweet-macros))
+
+;; ex: (remove-dupl '(1 2 3 1 5 2 4))
+(define (remove-dupl eq? lst)
+  (reverse
+   (fold-left
+    (lambda (acc el)
+      (define (is-el? x) (eq? x el))
+      (if (find is-el? acc); duplicate
+          acc
+          (cons el acc))) '() lst)))
+
+(define (append-unique eq? . lists)
+  (remove-dupl eq? (apply append lists)))
+
+(define (base-struct k)
+  (case k
+    ((->keys) '())
+    (else (error 'struct-key-error "Missing key" k))))
+
+(def-syntax struct
+  (syntax-match ()
+    (sub (struct (name value) ...)
+         #'(struct base-struct (name value) ...))
+    (sub (struct parent (name value) ...)
+         #'(lambda (k)
+             (case k
+               ((->keys) (append-unique eq? '(name ...) (parent '->keys)))
+               ((name) value) ...
+               (else (parent k))))
+         (for-all identifier? #'(name ...)))
+    ))
+             
+(define (struct->alist s)
+  (map (lambda (k) (list k (s k))) (s '->keys)))
+
+(def-syntax (struct-get s name default)
+  #'(let ((value (s 'name)))
+      (if (eq? value struct-null) default value)))
+)
diff --git a/scheme/test-struct.ss b/scheme/test-struct.ss
new file mode 100644
index 0000000..439103f
--- /dev/null
+++ b/scheme/test-struct.ss
@@ -0,0 +1,16 @@
+(import (rnrs) (struct) (sweet-macros) (ikarus))
+
+;(display (syntax-expand (struct (a 1) (b 2))))
+
+;(pretty-print (syntax-expand (struct base-struct (a 1) (b 2))))
+
+(define s1 (struct (a 1) (b 2)))
+(define s2 (struct s1 (c 3)))
+(define s3 (struct s2 (a 4)))
+
+(define (struct->alist s)
+  (map (lambda (k) (list k (s k))) (s '->keys)))
+
+(display (struct->alist s3))
+
+(for-each (lambda (k) (display (s3 k))) (s3 '->keys))
diff --git a/scheme/try.sls b/scheme/try.sls
index 7d465f5..22cda50 100644
--- a/scheme/try.sls
+++ b/scheme/try.sls
@@ -2,7 +2,7 @@
 (export try)
 (import (rnrs) (sweet-macros))
 
-; _try-except
+;; _TRY-EXCEPT
 (def-syntax _try-except
   (syntax-match (except)
      (sub (_try-except expr
@@ -10,12 +10,11 @@
            ...
            (except (err) else-action ...))
           #'(guard (err ((or (assertion-violation? err) (error? err))
-                         (let ((who (condition-who err)))
-                           (case who
-                            ((id id* ...) (let ((e err)) action ...))
-                            ...
-                            (else else-action ...)
-                            ))))
+                         (case (condition-who err)
+                           ((id id* ...) (let ((e err)) action ...))
+                           ...
+                           (else else-action ...)
+                           )))
                  expr))
      (sub (_try-except expr
            (except (e id id* ...) action ...)
@@ -25,12 +24,17 @@
              ...
              (except (err) (raise err))))
      ))
+;; END
 
-; _try-finally
+;; _TRY-FINALLY
 (def-syntax (_try-finally e e* ... (finally f f* ...))
-  #'(dynamic-wind (lambda () #f) (lambda () e e* ...) (lambda () f f* ...)))
+  #'(dynamic-wind
+        (lambda () #f)
+        (lambda () e e* ...)
+        (lambda () f f* ...)))
+;; END
 
-; try
+;; TRY
 (def-syntax try
   (syntax-match (except finally)
      (sub (try expr (finally f f* ...))
@@ -42,4 +46,5 @@
              (_try-except expr (except (e id ...) action ...) ... )
              (finally f f* ...)))
      ))
+;; END
 )
diff --git a/scheme2rst.py b/scheme2rst.py
index ad45337..74d2bad 100644
--- a/scheme2rst.py
+++ b/scheme2rst.py
@@ -3,46 +3,81 @@ usage: %prog [options]
 -r, --rst: make an .rst file only
 """
 
+"""
+This script is able to include libraries in the IKARUS_LIBRARY_PATH
+(with the @@NAME) syntax and to include snippets defined in the
+current file.
+"""
+
 import os, sys, re, webbrowser
 from docutils.core import publish_cmdline
 from ms.optionparser import OptionParser
 
 BIGCOMMENT = re.compile(r'#\|(.*)\|#(.*)', re.DOTALL)
-SNIPPET = re.compile(r'\n;\s*([-A-Z\d_/!\?]+)\s*\n(.*?)\n\s*;END', re.DOTALL)
+SNIPPET = re.compile(r'\n;+\s*([-A-Z\d_/!\?]+)\s*\n(.*?)\n\s*;+\s*END',
+                     re.DOTALL)
 SNIPPETNAME = re.compile(r'\n\$\$([-A-Z\d_/!\?]+)\n')
-INCLUDE = re.compile(r'@@([-\w\d_\.]+)')
+INCLUDE = re.compile(r'\$\$([-\w\d_\.]+):')
+INCLUDESNIPPET = re.compile(r'\$\$([-\w\d_\.]+):([-A-Z\d_/!\?]+)\n')
 
 PATH = os.environ['IKARUS_LIBRARY_PATH']
 
-def include(fname):
-    try:
-        txt = file(fname).read()
-    except IOError:
-        txt = file(os.path.join(PATH, fname)).read()
-    return txt
+def include(fname, paths=('.', PATH), exts=('.ss', '.sls')):
+    for path in paths:
+        for ext in exts:
+            try:
+                return file(os.path.join(path, fname + ext)).read()
+            except IOError, e:
+                pass
+    raise e
 
 def indent(text):
     return '\n'.join('  ' + ln for ln in text.splitlines())
 
+class SnippetExtractor(object):
+    """
+    Given some Scheme code, parses it to find snippets. Provides a .get method
+    to extract a properly indented snippet and a cached .make classmethod to
+    extract the code from a file name.
+    """
+    _cache = {}
+    @classmethod
+    def make(cls, fname, codeblock=False):
+        try:
+            self = cls._cache[fname]
+        except KeyError:
+            self = cls._cache[fname] = cls(include(fname), codeblock)
+        return self
+    def __init__(self, code, codeblock):
+        if codeblock:
+            self.templ = '\n.. code-block:: scheme\n\n%s\n'
+        else:
+            self.templ = '\n::\n\n%s\n'
+        self._dict = dict(
+            (mo.group(1), mo.group(2)) for mo in SNIPPET.finditer(code))
+    def get(self, name):
+        return self.templ % indent(self._dict.get(name, name))
+        
 def scheme2rst(fname, codeblock=False):
     mo = BIGCOMMENT.search(file(fname).read())
     if mo is None: 
         sys.exit('No #| ..|# found!')
     text, code = mo.groups()
-    snippet = dict((mo.group(1), mo.group(2)) for mo in SNIPPET.finditer(code))
-    if codeblock:
-        templ = '\n.. code-block:: scheme\n\n%s\n'
-    else:
-        templ = '\n::\n\n%s\n'
+    snippet = SnippetExtractor(code, codeblock)
     def repl(mo):
         "replace SNIPPETNAME with the content of the snippet dictionary"
-        name = mo.group(1)
-        return templ % indent(snippet[name])
+        return snippet.get(mo.group(1))
     def include_file(mo):
-        return templ % indent(include(mo.group(1)))
-    rst = INCLUDE.sub(include_file, SNIPPETNAME.sub(repl, text))
+        return snippet.templ % indent(include(mo.group(1)))
+    def include_snippet(mo):
+        fname, name = mo.groups()
+        snippet = SnippetExtractor.make(fname)
+        return snippet.get(name)
+    text = SNIPPETNAME.sub(repl, text)
+    text = INCLUDESNIPPET.sub(include_snippet, text)
+    text = INCLUDE.sub(include_file, text)
     rstfile = os.path.splitext(fname)[0] + '.rst'
-    file(rstfile, 'w').write(rst)
+    file(rstfile, 'w').write(text)
     return rstfile
 
 if __name__ == "__main__":