diff options
Diffstat (limited to 'src/guile/skribilo/location.scm')
| -rw-r--r-- | src/guile/skribilo/location.scm | 46 |
1 files changed, 40 insertions, 6 deletions
diff --git a/src/guile/skribilo/location.scm b/src/guile/skribilo/location.scm index 7c870fa..1ca278f 100644 --- a/src/guile/skribilo/location.scm +++ b/src/guile/skribilo/location.scm @@ -1,7 +1,7 @@ ;;; location.scm -- Skribilo source location. ;;; -;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> -;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> +;;; Copyright 2005, 2007 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -23,7 +23,9 @@ :use-module (oop goops) :use-module ((skribilo utils syntax) :select (%skribilo-module-reader)) :export (<location> location? ast-location - location-file location-line location-pos)) + location-file location-line location-column + location-pos + invocation-location)) ;;; Author: Ludovic Courtès ;;; @@ -41,13 +43,17 @@ ;;; (define-class <location> () - (file :init-keyword :file :getter location-file) - (pos :init-keyword :pos :getter location-pos) - (line :init-keyword :line :getter location-line)) + (file :init-keyword :file :getter location-file) + (column :init-keyword :column :getter location-column) + (line :init-keyword :line :getter location-line)) (define (location? obj) (is-a? obj <location>)) +(define (location-pos loc) + ;; Kept for compatibility with Skribe. XXX: Move to `compat.scm'. + 0) + (define (ast-location obj) (let ((loc (slot-ref obj 'loc))) (if (location? loc) @@ -63,6 +69,34 @@ (format #f "~a, line ~a" file line)) "no source location"))) +(define-method (write (loc <location>) port) + (format port "#<<location> ~a \"~a\":~a:~a>" + (object-address loc) + (location-file loc) + (location-line loc) + (location-column loc))) + + + +;;; +;;; Getting an invocation's location. +;;; + +(define (invocation-location . depth) + ;; Return a location object denoting the place of invocation of this + ;; function's caller. + (let ((depth (if (null? depth) 4 (car depth)))) + (let* ((stack (make-stack #t)) + (frame (stack-ref stack depth)) + (source (frame-source frame))) + (and source + (let ((file (source-property source 'filename)) + (line (source-property source 'line)) + (col (source-property source 'column))) + (and file + (make <location> :file file + :line (and line (+ line 1)) + :column col))))))) ;;; arch-tag: d68fa45d-a200-465e-a3c2-eb2861907f83 |