[Date Prev] [Date Next] [Thread Prev] [Thread Next] Date Index Thread Index Search archive:
Date:Mon Apr 19 19:28:21 1994 
Subject:Source file reference and objectclass 
From: Robin Popplestone  
Volume-ID:940421.05 

Some time ago Aaron and I put together a -ved_source- procedure which
allows immediate access to the source of a POP-11 procedure that has been
compiled -after- ved_source itself has been loaded. This facility did
not work to find methods etc. of  -lib objectclass-. It still does not work
fully - partly of course because the definition of methods is distributed.
However it is often helpful to be put in the right ball-park (to adopt a
metaphor from the variety of rounders that is played here). So here is
a version that at least takes notice of some of definitions made by
lib objectclass, and will at least go to a relevant file at a relevant
place, even if it squeaks as it does so.

==============================================================================

HELP ved_source                              Robin Popplestone APR 1994

Source reference to user defined procedures  POP-11. This is not to be
confused with -lib sourcefile- which finds things in the POPLOG system.

To use the facility put:

  uses ved_source;

in init.p (not vedinit.p, since you want to start building the directories
-before- you start ved)

 <enter> source <proc>

will find the source of procedure <proc>. To get source for the current
item in your Ved buffer do

  <enter> source

If the item is a system identifier, you will get help information instead.
The VED command

    <enter> procslike <name>

will list procedures whose name contains <name> as a substring.

Other facilities
----------------
ved_source warns you if you are redefining a procedure, and tells you in
what file this is being done. It also tells you in what file any undeclared
variables are being automatically declared by extending the "DECLARING ..."
message.

xx =>

DECLARING VAR xx
Current file: [/nfs/roo/local/pop/.article|52]
** <undef xx>

The "Current file:" message is only printed out when the file differs
from the previous one mentioned in such a message.

Limitations
-----------
ved_source does not distinguish between different procedures with the same
name, so it is not very reliable where sections etc.. are concerned.


==============================================================================



;;; ved_source.p                  A.Sloman and R.Popplestone Fall and Autumn 87

/*

OCT91 R.Popplestone changed "Redefining procedure.." message to "Redefining.."
to reflect what actually happens (and to make it shorter).

??? Problems - the ** in example refers to the exponentiation operator

?? Quote the function names when explaining bindings.

?? How about variables bound to constants.

?? How about recognising that you are in a comment, including the open
and close comment brackets.

 I have tried to line everything up with their GEMACS experience (with
added oomph). I have bound ctrl-H to be a slightly modified version of the
ved_source operation that we did some time ago.

(a) I have replaced the call to get the one-line explanation of system
identifiers with the call to get a few lines of text (i.e. ved_?? rather
than ved_?). This is more helpful to POPLOG beginners.

(b) I have put in a special test for  (%, since they are not beginners at
Computer Science, but closures are still(!) funny beasts to them.

(c) I have changed the "UNDECLARED IDENTIFIER" error message to "Identifier
not declared globally" since you get it with local error messages. I
contemplate a hack redefining sysVARS and sysLVARS and ved_lcp to
spot the local identifiers, but life is short...

March 94 Robin Popplestone added redefinition of sysGLOBAL to help with
lib objectclass.

*/
vars procedure source_of_proc;
uses npr;

vars rep_warning;
unless isprocedure(rep_warning) then charout -> rep_warning endunless;

define global vars ved_procslike();
    ;;; '<ENTER> procslike <string>' gets procnames containing <string>
    lconstant tempfile=systmpfile( false, 'procslike', '' );
    dlocal cucharout = vedcharinsert, vedbreak=false;
    vededitor(vedhelpdefaults,tempfile);
    vedendfile();
    appproperty(source_of_proc,
        procedure(name,file);
            lvars name,file;
            if issubstring(vedargument,1,name) then
                pr(name);
                max(vedcolumn + 2, 30) -> vedcolumn;
                pr(if isref(file) then cont(file)
                    elseif file then file
                    else '(unknown)' endif);
                pr(newline);
            endif
        endprocedure)
enddefine;

section $-source rep_warning npr=>
        source, ved_source, ved_source_table_size, source_of_proc;

lvars rep_pr_warning;

define pr_current_file();
    if rep_pr_warning/==cucharin then
        printf('Current file: %p\n', [%pdprops(cucharin)%]);
        cucharin -> rep_pr_warning;
    endif;
enddefine;

;;; Allow user to pre-define size of table or source_of_proc

global vars ved_source_table_size;
unless isinteger( ved_source_table_size) then
    126 -> ved_source_table_size
endunless;

global vars procedure source_of_proc;

if isundef(source_of_proc) then
    newproperty([],ved_source_table_size,undef,false) -> source_of_proc
endif;


define constant property_print(f);
  pr('\nThis is a property (see *HELP PROPERTIES)\n Entries:\n');
  appproperty(f, procedure(k,v); k.pr; pr('  =  '); v.pr; pr('\n    ');
     endprocedure)
enddefine;


define constant array_print(f);
  pr('\nThis is an array (see *HELP ARRAYS)\n boundslist:\n');
  pr(f.boundslist);
enddefine;

define constant closure_print(f);
    ;;; print information about closures.
    ;;; Altered [A.S] to print in ved buffer if vedlmr_print_in_file is string
    lvars i,f,n=f.length;
    dlocal vedargument cucharout;
    if isstring(vedlmr_print_in_file) then
        vedselect(vedlmr_print_in_file);
        vedendfile();
        vedcharinsert -> cucharout
    endif;
    f.pdpart.pdprops.recursive_front.pr; '(%'.pr;
    for i to n do
        pr(frozval(i,f));
        if i < n then pr(",") endif;
    endfor;
    pr('%)');
enddefine;

define explain_constant(c);
    pr('This is an object of type "' >< dataword(c) >< """)
enddefine;

define is_in_comment() -> bool;     ;;; Special check reqd. since comments
                                    ;;; are not reported by the itemiser.
  dlocal vedline vedcolumn;
  while (vedcurrentchar() ->> c) = ` ` or c= `\^I` do
          vedrepeater() ->;
  endwhile;
  lvars c1 = vedrepeater(),
    c2 = vedrepeater(),
    c3 = vedrepeater();
  if c1 = `;` and c2 = `;` and c3 = `;` then
    pr(';;; makes rest of line into comment');
  elseif c1 = `/` and c2 = `*` then
    pr('/* is start of comment - text ignored until */');
  elseif c1 = `*` and c2 = `/` then
    pr('*/ is end of comment begun by /*');
  elseif c1 = `*` and c2 = `*` then
    pr(
    '** is output by the print-arrow, => as well as exponentiation');
    false -> bool
  else false -> bool
  endif;

enddefine;

/*
ved_source moves the cursor to the source code of a procedure
--------------------------------------------------------------
*/


define global vars procedure ved_source;
    ;;; Argument is name of a procedure. Get source file into VED
    lvars  file, name, oldarg, im_file = false, p;
    ;;; If no argument supplied, use item to right of cursor
    if vedargument = vednullstring then
        if is_in_comment() then return
        endif;
        vednextitem() -> name;
        name sys_>< vednullstring -> vedargument;
    else
        lvars rep_item = incharitem(stringin(vedargument));
        rep_item() -> name;
        consstring(destword(name)) -> vedargument;
    endif;
    unless isword(name) then
        explain_constant(name);
        return
    endunless;

    name.source_of_proc -> file;

    if isref(file) then
        ;;; Was compiled in "immediate mode".
        ;;; ved_f will be screwed by prompts, so set im_file
        true -> im_file;
        cont(file) -> file
    endif;
file) then
        vedargument -> oldarg;
        ;;; With luck, vvedgotoplace can ensure cursor starts in right place
        space >< oldarg -> vvedgotoplace;
        file -> vedargument;
        if vedediting then ved_ved()
        else
            ;;; prepare to run ved_source inside vededitor
            vedinput(procedure; oldarg -> vedargument; ved_source()
                    endprocedure);
            chain(ved_ved);
        endif;
        ;;; only gets here if vedediting is true
        oldarg -> vedargument;
        if im_file then
            ;;; already at possible location, because of vvedgotoplace
            ;;; ved_f will not work.
        else
            ;;; use '-x' for exact match
            '-x ' sys_>< vedargument -> vedargument;
            ved_f();         ;;; find the procedure

            vedcharuplots(); vedchardown();
        endif

    elseif file.not then
        ;;; In table, but source file not available
        vederror(
            vedargument sys_>< ' defined in POPVAL or direct from keyboard')

    elseif identprops(name) == undef then
        pr('IDENTIFIER not declared globally: ' sys_>< name)

    elseif isproperty(valof(name)) then
        property_print(valof(name))      ;;; not sure this is right

    elseif isarray(valof(name)) then
        array_print(valof(name))      ;;; not sure this is right

    elseif isclosure(valof(name)) then
        closure_print(valof(name))      ;;; not sure this is right

    elseif name = "("
    and (vedmoveitem()->>; vednextitem() = "%") then
         ved_help('partapply'->vedargument)

    elseif isprocedure(valof(name))
    and isword(pdprops(valof(name))->>p)
    and name /= pdprops(valof(name)) then
    pr('\nFunction variable "'><name><'" bound to "'>< p >< """);
    ved_source(p><'' -> vedargument);
    else
    lvars n = identprops(name),
          msg = if isword(n) then n
                elseif n==0 then "general"
                else 'operator precedence ' >< n
                endif;

    vedputmessage('\n"'
       >< name
       >< '"  is identifier of type :  '
       >< msg);

      ved_??()

    endif
enddefine;


;;; A version for use outside VED. Should be a syntax word and plant code.
define global syntax source;
    sysPUSHQ(readstringline());
    sysPOP("vedargument");
    sysCALL("ved_source");
    ";" :: proglist -> proglist;
enddefine;


;;; Now redefine sysPASSIGN after saving original
sysunprotect("sysPASSIGN");

;;; Next bit guards against re-compilation
constant oldPASSIGN;
unless isprocedure(oldPASSIGN) then
    sysPASSIGN -> oldPASSIGN
endunless;

define lvars record_for_source(word);
    ;;; Store association between word and the source file using source_of_proc
    lvars proc,word,arg1,frozargs,filename, do_print_file = false;
    dlocal cucharout = rep_warning;
    ;;; Find name of file or VED buffer from which compiling

    if   isword(word)
    and  identprops(word) /= undef
    and  not(isundef(valof(word)))
    and  not(word=="_")
    then lvars file = source_of_proc(word);
        if isstring(file) then
            printf('Redefining: %p, first defined in %p\n ',
                [%word,source_of_proc(word)%]);
        else printf('Redefining : %p, not defined in this program\n',
                [%word%])
        endif;
        true -> do_print_file;
    endif;

    unless  isincharitem(itemread) then
        ;;; No character repeater, so can't be a file. Might be popval(list)
        false

    elseif popfilename then
        sysfileok(popfilename) -> filename;
        ;;; add directory if necessary
        if sysfiledir(filename) = vednullstring then
            current_directory dir_>< filename
            else
            filename
            endif

    elseif vedediting and cucharin == charin and iscaller(vedsetpop) then
        ;;; Immediate mode, so put file name in reference, as cue
        consref(vedpathname)

    elseunless isclosure(cucharin) then
        false   ;;; Can't identify file name. Perhaps typed in direct

    else
        ;;; Compiling from result of discin, or ved buffer perhaps

        length(cucharin) -> frozargs;
        frozval(1,cucharin) -> arg1;
        if frozargs == 1 and isdevice(arg1) then
            device_open_name(arg1)

            ;;; Next bit recognises compilation from VED buffer, etc. UGH!!
        elseif frozargs == 3
        and    ispair(arg1)
        and    isref(frozval(2,cucharin))
        and    isprocedure(frozval(3,cucharin))
        then
            vedpathname     ;;; should be compiling from VED buffer...?
        else
            false           ;;; could be any repeater
        endif
    endunless  ->> source_of_proc(word) -> file;
    if do_print_file then
        pr_current_file();
    endif;
enddefine;

define vars procedure sysPASSIGN(proc,word);
    record_for_source(word);
    chain(proc,word,oldPASSIGN);
enddefine;

sysunprotect("sysGLOBAL");
constant oldGLOBAL;
unless isprocedure(oldGLOBAL) then
    sysGLOBAL -> oldGLOBAL
endunless;

define vars procedure sysGLOBAL(word);
  record_for_source(word);
  chain(word,oldGLOBAL);
enddefine;


define prwarning(v);
  lvars v, r = cucharin;
;;;  dlocal cucharout = rep_warning;
;;;  vedputcommand('ved warning.tmp');
  if isclosure(r) then frozval(1,r) -> r
  endif;

  pr('DECLARING VAR '); npr(v);
  pr_current_file();

enddefine;


sysprotect("sysPASSIGN");

endsection;