AndrewNikitin/Jtangle

unwrap=: 3 : 0

unwrap returns contents of a section named y. If this section contains references to ther sections, they are substituted recursively. It uses globals generated by extract_pieces.

  y=.boxopen y
  if. y e. STACK do. return. end. NB. prevent circular referencing
  assert. (#SECTIONS)>k=.SECTIONS i. y
  STACK=:STACK,y

Only one section reference per line is allowed. Nothing but whitespaces can be in that line. TODO: (?) Whitespaces before section reference should be inserted before each line of section text.

  result=.>k{TEXT
  r=.'^(\s*)«(.*)»\s*$' rxmatches result
  n=.(2{"2 r) rxfrom result
  rplcdata=.unwrap &.>n
  result=.rplcdata  (0&{"2 r) rxmerge result

We used to update section text with unwrapped data, but then decided against it.

  TEXT=:(<result) k} TEXT

  STACK=:_1}.STACK
  result
)

readlit

«read»=

readlit=:3 : 0
  extract_pieces 1!:1 < jpath > y
  i=.1 i.~ (1&,^:([: -. +./)) ([: +./ '.ijs'&E.)&> SECTIONS
  unwrap i{SECTIONS
:
  extract_pieces 1!:1 < jpath > y
  unwrap x
)

Optional left argument specifies which section to output. If not specified, then first section name that contains .ijs is used. If there is no such section, then first section in the file.

test commands

T=:1!:1 <jpath '~nsg\literate\jtangle.lit'
readlit '~nsg\literate\jtangle.lit'

Perl script download

For convenirnce the generated perl code is provided as an attachment. It is not necessarily the latest one (which also may be a good thing).

jtangle.pl.txt

Perl script

Note on comments

«jtangle.pl»=

«perl»

Current literate parser attaches comment (which points to the literate source from which script was generated) on top of file. Usually it correctly guesses the form of comment (J-style NB. comments or Perl # comments), but may make a mistake once in a while. Please check downloaded source for consistency if you encounter problems.

# 2007-03-19
use strict;
use bytes;
«perloptions»
«perlvar»

Perl script options

use Getopt::Std;
our(

  $opt_f, # use section names as filenames, otherwise dump everything to STDOUT;

Default behaviour is to ignore filenames and dump everything to STDOUT. The problem is that filename may contain relative paths and attempt to overwrite system files via

{ { {#!literate name='c:\autoexec.bat'
... something sinister

This way the harm can be done during source extraction stage wich is less expected. Need to implement some kind of checking mechanism.

  $opt_s, # extract only section with given name

If this option is not specified, then script will extract sections that have '.' in their names, assuming those are source files. If only one file or only specific section is needed, then the name of this section may be specified.

  $opt_l, # list section names and their relationships

  $opt_q, # quiet mode, do not show any warnings

);
getopts("fs:lq");
die "-f and -l are mutually exclusive" if $opt_f && $opt_l;

Instead of die we could have quietly turn -f off when -l is on, but it seems better to not try to guess user intentions.

Scan entire file

our %piece;
our $section;

For each line in a file grab lines into global hash %piece, which contains named sections in form of arrays of strings. Current section name is in global $section

my $CLOSE='}' x 3; # kludge to work around current literate parsing
while(<>) {
  my $n;
  if( $n=/^\s*{{{#!literate.*name='([^']*)'/ .. /^\s*$CLOSE\s*$/ ) {
    if( 1==$n ) {
      $section=$1;
      $piece{$section}=[] unless exists $piece{$section};
    }

Perl's .. (range operator) returns 'E0' attached to the position number when line matches final expression. This does not change position's numeric value but gives something to look for to test for final expression.

    elsif( 'E0' ne substr($n,-2,2) ) {
      push @{$piece{$section}},$_;
    }
  }
}

Select and unwrap top-level section

Scan through named sections and recursively unwrap those that contain '.' in their name.

our $PREFIX;

Global $PREFIX contains string to prepend to indented sections (for now can only be whitespaces. TODO(?) comments).

our @STACK;

Global @STACK contains list of pending sections to detect self references.

close STDOUT if $opt_f;
for my$s(keys %piece) {
  if( $s eq $opt_s || ('' eq $opt_s && 0<=index($s,'.'))  ) {
    $PREFIX='';
    @STACK=();
    if( $opt_f ) {
      warn "Write section to $s\n" unless $opt_q;
      open STDOUT, ">$s" if $opt_f;
    }
    unwrap($s);
    close STDOUT if $opt_f;
  }
}

Procedure that recursively unwraps sections

sub unwrap($)
{
  my $s=shift;
  if( !exists $piece{$s} ) {
    warn "Section $s is referenced but not defined. Nothing is substituted.\n" unless $opt_q;
    return;
  }

If name of a current section is already in @STACK then substitution will never finish. Give warning and ignore this occurence of section.

  for my$e(@STACK) {
    if( $s eq $e ) {
      warn "Recursion detected: $s" unless $opt_q;
      return;
    }
  }

For each line of section either output it (with prepended $PREFIX) or, if it is a section reference, recursively unwrap it. For now there can be only one section reference per line and nothing but whitespace is allowed around it.

our %unwrapped;

The hash %unwrapped keeps track of which sections were used and how many times. Currently it is possible to use section more than once. Maybe, this needs to be signalled as a mistake.

  $unwrapped{$s}++;
  if( $opt_l ) {
    print "",("  " x @STACK),("@" x (1<$unwrapped{$s})),$s,"\n";
    return if $unwrapped{$s}>1;
  }
  push @STACK,$s;
  for my$l(@{$piece{$s}}) {
    if( $l=~/^(\s*)«(.*)»\s*$/ ) {
      my $p=$PREFIX;
      $PREFIX=$p.$1;
      unwrap($2);
      $PREFIX=$p;
    } else {
      print "",$PREFIX,$l unless $opt_l;
    }
  }
  pop @STACK;
}

Warn about unused sections

In the end check if any of the named sections were not used by unwrap and give warning.