From mboxrd@z Thu Jan  1 00:00:00 1970
Received: (from weis@localhost) by pauillac.inria.fr (8.7.6/8.7.3) id UAA24347 for caml-red; Thu, 2 Nov 2000 20:52:25 +0100 (MET)
Received: from nez-perce.inria.fr (nez-perce.inria.fr [192.93.2.78]) by pauillac.inria.fr (8.7.6/8.7.3) with ESMTP id TAA11907 for <caml-list@pauillac.inria.fr>; Thu, 2 Nov 2000 19:50:23 +0100 (MET)
Received: from oxmail.ox.ac.uk (oxmail1.ox.ac.uk [129.67.1.1])
	by nez-perce.inria.fr (8.11.1/8.10.0) with ESMTP id eA2IoNv19323
	for <caml-list@inria.fr>; Thu, 2 Nov 2000 19:50:23 +0100 (MET)
Received: from heraldgate1.oucs.ox.ac.uk
	([163.1.2.49] helo=frontend1.herald.ox.ac.uk ident=exim)
	by oxmail.ox.ac.uk with esmtp (Exim 3.12 #3)
	id 13rPRO-0006QP-00
	for caml-list@inria.fr; Thu, 02 Nov 2000 18:50:22 +0000
Received: from maurice.oriel.ox.ac.uk ([163.1.147.101] ident=root)
	by frontend1.herald.ox.ac.uk with esmtp (Exim 2.02 #1)
	id 13rPRN-0005s8-00
	for caml-list@inria.fr; Thu, 2 Nov 2000 18:50:21 +0000
Received: from mike by maurice.oriel.ox.ac.uk with local (Exim 3.16 #1)
	id 13rPQi-0004Wi-00; Thu, 02 Nov 2000 18:49:40 +0000
From: Mike Spivey <mike@comlab.ox.ac.uk>
To: caml-list@inria.fr
Subject: Error context from ocamlc
Message-Id: <E13rPQi-0004Wi-00@maurice.oriel.ox.ac.uk>
Date: Thu, 02 Nov 2000 18:49:40 +0000
Sender: weis@pauillac.inria.fr

I'm quite happy using emacs, but some of my students prefer other
editors.  To help them, I've written the script below, which can take
the error messages output by ocamlc and display the source line in the
same way the Caml Light compiler used to do.

-- Mike


Je suis content avec l'editeur emacs, mais quelques d'entre mes
etudiants preferent des autre editeurs.  Donc j'ai ecrit le petit
script ci-joint, qui prend les messages produit par ocamlc, et montre
la ligne du source, dans le meme style utilise par Caml Light.

-- Maik


#!/usr/bin/tclsh

# Usage: 
#    "ocamlerror FILE LINE BEG-END" 
#	to locate error in FILE on LINE, characters BEG-END
#    "ocamlerror ERRFILE"
#	to locate all errors reported in ERRFILE
#    "ocamlc FILE.ml 2>&1 | ocamlerror"
#	to locate errors reported by compiler

# lsplit -- split a list into multiple variables
proc lsplit {xs args} {
    set n [llength $args]
    for {set i 0} {$i < $n} {incr i} {
	uplevel [list set [lindex $args $i] [lindex $xs $i]]
    }
}

# getline -- fetch single line from file
proc getline {file line} {
    set f [open $file]
    for {set i 0} {$i < $line} {incr i} {
	gets $f buf
    }
    close $f
    return $buf
}

# tab -- compute tab location
proc tab {n} {
    return [expr {($n+8)/8*8}]
}

# locate -- echo line with error location
proc locate {file line chars} {
    set buf [getline $file $line]

    # Analyse $chars into $beg and $end
    regexp {([0-9]+)-([0-9]+)} $chars dummy beg end
    if {$beg == $end} {incr end}
    if {$end > [string length $buf]} {
	set buf "$buf ..."
	set end [string length $buf]
    }

    puts $buf

    # Output spaces up to position BEG
    for {set i 0; set j 0} {$i < $beg} {incr i} {
	if {[string index $buf $i] == "\t"} {
	    puts -nonewline "\t"; set j [tab $j]
	} else {
	    puts -nonewline " "; incr j
	}
    }

    # Output markers up to position END
    for {} {$i < $end} {incr i} {
	if {[string index $buf $i] == "\t"} {
	    for {set k [tab $j]} {$j < $k} {incr j} {
		puts -nonewline "^"
	    }
	} else {
	    puts -nonewline "^"; incr j
	}
    }

    puts ""
}

proc scanfile {f} {
    global status

    while {[gets $f buf] >= 0} {
	puts $buf
	if {[regexp \
		{^File "(.*)", line ([0-9]+), characters ([0-9]+-[0-9]+):} \
		$buf dummy file line chars]} {
	    set status 1
	    locate $file $line $chars
	}
    }
}

set status 0

proc usage {} {
    global argv0
    puts stderr "Usage: ocamlerror file line begin-end"
    puts stderr "   or: ocamlerror errfile"
    puts stderr "   or: ocamlc file.ml 2>&1 | ocamlerror"
    exit 2
}

proc main {} {
    global argv
    switch [llength $argv] {
	0 {scanfile stdin}
	1 {set f [open [lindex $argv 0]]; scanfile $f}
	3 {lsplit $argv file line chars; locate $file $line $chars}
	default {usage}
    }
}

if {[catch main msg]} {
    puts "ocamlerror: $msg"
    exit 2
}

exit $status