aboutsummaryrefslogtreecommitdiff
path: root/src/guile/skribilo/location.scm
diff options
context:
space:
mode:
Diffstat (limited to 'src/guile/skribilo/location.scm')
-rw-r--r--src/guile/skribilo/location.scm46
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