diff options
Diffstat (limited to 'src/guile')
| -rw-r--r-- | src/guile/skribilo/lib.scm | 22 | ||||
| -rw-r--r-- | src/guile/skribilo/types.scm | 12 |
2 files changed, 22 insertions, 12 deletions
diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm index aaf1a8f..8667f7e 100644 --- a/src/guile/skribilo/lib.scm +++ b/src/guile/skribilo/lib.scm @@ -28,7 +28,7 @@ (define-module (skribilo lib) :export (skribe-eval-location skribe-ast-error skribe-error - skribe-type-error skribe-line-error + skribe-type-error skribe-warning skribe-warning/ast skribe-message @@ -167,13 +167,14 @@ (let ((l (ast-loc obj)) (shape (if (markup? obj) (markup-markup obj) obj))) (if (location? l) - (error "~a:~a: ~a: ~a ~s" (location-file l) (location-pos l) proc msg shape) - (error "~a: ~a ~s " proc msg shape)))) + (error (format #f "~a:~a: ~a: ~a ~s" (location-file l) + (location-line l) proc msg shape)) + (error (format #f "~a: ~a ~s " proc msg shape))))) (define (skribe-error proc msg obj) (if (ast? obj) (skribe-ast-error proc msg obj) - (error proc msg obj))) + (error (format #f "~a: ~a ~s" proc msg obj)))) ;;; @@ -183,17 +184,16 @@ (skribe-error proc (format "~a ~s (~a expected)" msg obj etype) #f)) - -;;; FIXME: Peut-être virée maintenant -(define (skribe-line-error file line proc msg obj) - (error (format "%a:%a: ~a:~a ~S" file line proc msg obj))) - - ;;; ;;; SKRIBE-WARNING & SKRIBE-WARNING/AST ;;; (define (%skribe-warn level file line lst) (let ((port (current-error-port))) + (if (or (not file) (not line)) + (begin + ;; XXX: This is a bit hackish, but it proves to be quite useful. + (set! file (port-filename (current-input-port))) + (set! line (port-line (current-input-port))))) (when (and file line) (format port "~a:~a: " file line)) (format port "warning: ") @@ -210,7 +210,7 @@ (if (>= *skribe-warning* level) (let ((l (ast-loc ast))) (if (location? l) - (%skribe-warn level (location-file l) (location-pos l) obj) + (%skribe-warn level (location-file l) (location-line l) obj) (%skribe-warn level #f #f obj))))) ;;; diff --git a/src/guile/skribilo/types.scm b/src/guile/skribilo/types.scm index 8d51c8c..4b3729c 100644 --- a/src/guile/skribilo/types.scm +++ b/src/guile/skribilo/types.scm @@ -45,6 +45,7 @@ document-options document-end <language> language? <location> location? ast-location + location-file location-line location-pos *node-table*) :use-module (oop goops)) @@ -65,6 +66,15 @@ (parent :accessor ast-parent :init-keyword :parent :init-value 'unspecified) (loc :init-value #f)) +(define-method (initialize (ast <ast>) . args) + (next-method) + (let ((file (port-filename (current-input-port))) + (line (port-line (current-input-port))) + (column (port-column (current-input-port)))) + (slot-set! ast 'loc + (make <location> + :file file :line line :pos (* line column))))) + (define (ast? obj) (is-a? obj <ast>)) (define (ast-loc obj) (slot-ref obj 'loc)) (define (ast-loc-set! obj v) (slot-set! obj 'loc v)) @@ -313,5 +323,5 @@ (> lenf len)) (substring fname len (+ 1 (string-length fname))) fname))) - (format "~a, line ~a" file line)) + (format #f "~a, line ~a" file line)) "no source location"))) |