diff options
| -rw-r--r-- | modules/language/python/compile.scm | 99 | ||||
| -rw-r--r-- | modules/language/python/exceptions.scm | 58 | ||||
| -rw-r--r-- | modules/language/python/module/sys.scm | 6 |
3 files changed, 103 insertions, 60 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index 3bf81ef..619ef1b 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -21,7 +21,7 @@ #:use-module ((language python format2) #:select (fnm)) #:use-module ((language python with) #:select ()) #:use-module (ice-9 pretty-print) - #:export (comp)) + #:export (comp exit-fluid exit-prompt)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) @@ -43,6 +43,29 @@ (define-inlinable (H x) `(@ (language python hash) ,x)) (define-inlinable (W x) `(@ (language python with) ,x)) +(define exit-prompt (make-prompt-tag)) +(define exit-fluid (make-fluid #f)) + +(define-syntax-rule (with-exit code ...) + (with-fluids ((exit-fluid #t)) + (call-with-prompt exit-prompt + (lambda () code ...) + (lambda (k val) + (if (not (= val 0)) + (format #t "exit with error ~a~%" val)))))) + +(define (get-exported-symbols x) + (aif it (resolve-module x) + (aif it (module-public-interface it) + (let ((l '())) + (module-for-each + (lambda (k b) + (set! l (cons k l))) + it) + l) + '()) + '())) + (define cvalues (G 'values)) (define-syntax-rule (wth code) @@ -118,12 +141,16 @@ (fold f (f (car l) init) (cdr l)) init)) +(define do-pr #t) + (define (pr . x) - (define port (open-file "/home/stis/src/python-on-guile/log.txt" "a")) - (with-output-to-port port - (lambda () - (pretty-print (syntax->datum x)))) - (close port) + (if do-pr + (let () + (define port (open-file "/home/stis/src/python-on-guile/log.txt" "a")) + (with-output-to-port port + (lambda () + (pretty-print (syntax->datum x)))) + (close port))) (car (reverse x))) (define (pf x) @@ -1010,29 +1037,39 @@ (#:import ((_ (#:from (() . nm) . #f)) - `(,(C 'use) (language python module ,@(map (lambda (nm) (exp vs nm)) - nm)))) + (let* ((xl (map (lambda (nm) (exp vs nm)) nm)) + (l `(language python module ,@xl))) + + ;; Make sure to load the module in + (catch #t + (lambda () (Module (reverse l) (reverse xl))) + (lambda x #f)) + + (for-each dont-warn (get-exported-symbols l)) + + `(,(C 'use) ,l))) + ((_ (#:from (() . nm) l)) - `(,(C 'use) ((language python module ,@(map (lambda (nm) (exp vs nm)) - nm)) - #:select ,(map (lambda (x) - (match x - ((a . #f) - (let ((s (exp vs a))) - (fluid-set! ignore - (cons s (fluid-ref ignore))) - (dont-warn s) - s)) + `(,(C 'use) ((language python module ,@(map (lambda (nm) (exp vs nm)) nm)) + #:select + ,(map (lambda (x) + (match x + ((a . #f) + (let ((s (exp vs a))) + (fluid-set! ignore + (cons s (fluid-ref ignore))) + (dont-warn s) + s)) - ((a . b) - (let ((s1 (exp vs a)) - (s2 (exp vs b))) - (fluid-set! ignore - (cons s2 - (fluid-ref ignore))) - (dont-warn s2) - (cons s1 s2))))) - l)))) + ((a . b) + (let ((s1 (exp vs a)) + (s2 (exp vs b))) + (fluid-set! ignore + (cons s2 + (fluid-ref ignore))) + (dont-warn s2) + (cons s1 s2))))) + l)))) ((_ (#:name ((ids ...) . as) ...) ...) @@ -1717,13 +1754,10 @@ (if (pair? start) (set! x (cdr x))) - (clear-warning-data) - (let* ((globs (get-globals x)) (e (map (g globs exp) x))) `(begin ,@start - (fluid-set! (@@ (system base message) %dont-warn-list) '()) (define ,fnm (make-hash-table)) ,@(map (lambda (s) (if (member s (fluid-ref ignore)) @@ -1740,19 +1774,16 @@ (if (pair? start) (set! x (cdr x))) - (clear-warning-data) - (let* ((globs (get-globals x)) (res (gensym "res")) (e (map (g globs exp) x))) `(begin ,@start - (fluid-set! (@@ (system base message) %dont-warn-list) '()) ,@(map (lambda (s) (if (member s (fluid-ref ignore)) `(,cvalues) `(,(C 'var) ,s))) globs) - ,@e))))) + (,(C 'with-exit) ,@e)))))) diff --git a/modules/language/python/exceptions.scm b/modules/language/python/exceptions.scm index 990f9c3..80d1e7d 100644 --- a/modules/language/python/exceptions.scm +++ b/modules/language/python/exceptions.scm @@ -12,7 +12,9 @@ InterruptedError BaseException ZeroDivisionError ArithmeticError OverflowError RecursionError - Warning DeprecationWarning BytesWarning)) + Warning DeprecationWarning BytesWarning + UnicodeDecodeError LookupError IndentationError + KeyboardInterrupt)) (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y))) @@ -64,31 +66,39 @@ (define StopIteration 'StopIteration) (define GeneratorExit 'GeneratorExit) -(define-er OverflowError 'OverflowError) -(define-er RecursionError 'RecursionError) -(define-er ArithmeticError 'ArithmeticError) -(define-er BaseException 'BaseException) -(define-er ZeroDivisionError 'ZeroDivisionError) -(define-er SystemException 'SystemException) -(define-er RuntimeError 'RuntimeError) -(define-er IndexError 'IndexError) -(define-er ArgumentError 'IndexError) -(define-er ValueError 'ValueError) + +(define-er UnicodeDecodeError 'UnicodeDecodeError) +(define-er LookupError 'LookupError) +(define-er IndentationError 'IndentationError) +(define-er OverflowError 'OverflowError) +(define-er KeyboardInterrupt 'KeyboardInterrupt) +(define-er RecursionError 'RecursionError) +(define-er ArithmeticError 'ArithmeticError) +(define-er BaseException 'BaseException) +(define-er ZeroDivisionError 'ZeroDivisionError) +(define-er SystemException 'SystemException) +(define-er RuntimeError 'RuntimeError) +(define-er IndexError 'IndexError) +(define-er ArgumentError 'IndexError) +(define-er ValueError 'ValueError) + (define None 'None) -(define-er KeyError 'KeyError) -(define-er TypeError 'TypeError) -(define-er AttributeError 'AttributeError) -(define-er SyntaxError 'SyntaxError) -(define-er OSError 'OSError) -(define-er ProcessLookupError 'ProcessLookupError) -(define-er PermissionError 'PermissionError) -(define-er NotImplementedError 'NotImplementedError) -(define-er RunTimeError 'RunTimeError) + +(define-er KeyError 'KeyError) +(define-er TypeError 'TypeError) +(define-er AttributeError 'AttributeError) +(define-er SyntaxError 'SyntaxError) +(define-er OSError 'OSError) +(define-er ProcessLookupError 'ProcessLookupError) +(define-er PermissionError 'PermissionError) +(define-er NotImplementedError 'NotImplementedError) +(define-er RunTimeError 'RunTimeError) + (define AssertionError 'AssertionError) -(define-er ImportError 'ImportError) -(define-er ModuleNotFoundError (ImportError) 'ModuleNotFoundError) -(define-er BlockingIOError 'BlockingIOError) -(define-er InterruptedError 'OSError) +(define-er ImportError 'ImportError) +(define-er ModuleNotFoundError (ImportError) 'ModuleNotFoundError) +(define-er BlockingIOError 'BlockingIOError) +(define-er InterruptedError 'OSError) (define NotImplemented (list 'NotImplemented)) diff --git a/modules/language/python/module/sys.scm b/modules/language/python/module/sys.scm index d24b7e2..aa4a166 100644 --- a/modules/language/python/module/sys.scm +++ b/modules/language/python/module/sys.scm @@ -2,6 +2,7 @@ #:use-module (rnrs bytevectors) #:use-module (language python exceptions) #:use-module (language python hash) + #:use-module (language python compile) #:use-module (language python module io) #:use-module (language python try) #:use-module (language python string) @@ -94,8 +95,9 @@ (define executable "") (define exit (lambda (arg) - (raise (SystemException ((@ (guile) format) - #f "exit called with arg ~a" arg))))) + (if (fluid-ref exit-fluid) + (abort-to-prompt exit-prompt arg) + ((@ (guile) exit) arg)))) (define flags '()) (define float_info '()) |