ref: a411870ee4640241e3c494367d922847da84f972
dir: purgatorio/appl/lib/fslib.b
implement Fslib;
#
# Copyright © 2003 Vita Nuova Holdings Limited
#
include "sys.m";
sys: Sys;
include "draw.m";
include "sh.m";
include "fslib.m";
# Fsdata stream conventions:
#
# Fsdata: adt {
# dir: ref Sys->Dir;
# data: array of byte;
# };
# Fschan: type chan of (Fsdata, chan of int);
# c: Fschan;
#
# a stream of values sent on c represent the contents of a directory
# hierarchy. after each value has been received, the associated reply
# channel must be used to prompt the sender how next to proceed.
#
# the first item sent on an fsdata channel represents the root directory
# (it must be a directory), and its name holds the full path of the
# hierarchy that's being transferred. the items that follow represent
# the contents of the root directory.
#
# the set of valid sequences of values can be described by a yacc-style
# grammar, where the terminal tokens describe data values (Fsdata adts)
# passed down the channel. this grammar describes the case where the
# entire fs tree is traversed in its entirety:
#
# dir: DIR dircontents NIL
# | DIR NIL
# dircontents: entry
# | dircontents entry
# entry: FILE filecontents NIL
# | FILE NIL
# | dir
# filecontents: DATA
# | filecontents DATA
#
# the tests for the various terminal token types, given a token (of type
# Fsdata) t:
#
# FILE t.dir != nil && (t.dir.mode & Sys->DMDIR) == 0
# DIR t.dir != nil && (t.dir.mode & Sys->DMDIR)
# DATA t.data != nil
# NIL t.data == nil && t.dir == nil
#
# when a token is received, there are four possible replies:
# Quit
# terminate the stream immediately. no more tokens will
# be on the channel.
#
# Down
# descend one level in the hierarchy, if possible. the next tokens
# will represent the contents of the current entry.
#
# Next
# get the next entry in a directory, or the next data
# block in a file, or travel one up the hierarchy if
# it's the last entry or data block in that directory or file.
#
# Skip
# skip to the end of a directory or file's contents.
# if we're already at the end, this is a no-op (same as Next)
#
# grammar including replies is different. a token is the tuple (t, reply),
# where reply is the value that was sent over the reply channel. Quit
# always causes the grammar to terminate, so it is omitted for clarity.
# thus there are 12 possible tokens (DIR_DOWN, DIR_NEXT, DIR_SKIP, FILE_DOWN, etc...)
#
# dir: DIR_DOWN dircontents NIL_NEXT
# | DIR_DOWN dircontents NIL_SKIP
# | DIR_DOWN dircontents NIL_DOWN
# | DIR_NEXT
# dircontents:
# | FILE_SKIP
# | DIR_SKIP
# | file dircontents
# | dir dircontents
# file: FILE_DOWN filecontents NIL_NEXT
# | FILE_DOWN filecontents NIL_SKIP
# | FILE_DOWN filecontents NIL_DOWN
# | FILE_NEXT
# filecontents:
# | data
# | data DATA_SKIP
# data: DATA_NEXT
# | data DATA_NEXT
#
# both the producer and consumer of fs data on the channel must between
# them conform to the second grammar. if a stream of fs data
# is sent with no reply channel, the stream must conform to the first grammar.
valuec := array[] of {
tagof(Value.V) => 'v',
tagof(Value.X) => 'x',
tagof(Value.P) => 'p',
tagof(Value.S) => 's',
tagof(Value.C) => 'c',
tagof(Value.T) => 't',
tagof(Value.M) => 'm',
};
init()
{
sys = load Sys Sys->PATH;
}
# copy the contents (not the entry itself) of a directory from src to dst.
copy(src, dst: Fschan): int
{
indent := 1;
myreply := chan of int;
for(;;){
(d, reply) := <-src;
dst <-= (d, myreply);
r := <-myreply;
case reply <-= r {
Quit =>
return Quit;
Next =>
if(d.dir == nil && d.data == nil)
if(--indent == 0)
return Next;
Skip =>
if(--indent == 0)
return Next;
Down =>
if(d.dir != nil || d.data != nil)
indent++;
}
}
}
Report.new(): ref Report
{
r := ref Report(chan of string, chan of (string, chan of string), chan of int);
spawn reportproc(r.startc, r.enablec, r.reportc);
return r;
}
Report.start(r: self ref Report, name: string): chan of string
{
if(r == nil)
return nil;
errorc := chan of string;
r.startc <-= (name, errorc);
return errorc;
}
Report.enable(r: self ref Report)
{
r.enablec <-= 0;
}
reportproc(startc: chan of (string, chan of string), startreports: chan of int, errorc: chan of string)
{
realc := array[2] of chan of string;
p := array[len realc] of string;
a := array[0] of chan of string;;
n := 0;
for(;;) alt{
(prefix, c) := <-startc =>
if(n == len realc){
realc = (array[n * 2] of chan of string)[0:] = realc;
p = (array[n * 2] of string)[0:] = p;
}
realc[n] = c;
p[n] = prefix;
n++;
<-startreports =>
if(n == 0){
errorc <-= nil;
exit;
}
a = realc;
(x, report) := <-a =>
if(report == nil){
# errorc <-= "exit " + p[x];
--n;
if(n != x){
a[x] = a[n];
a[n] = nil;
p[x] = p[n];
p[n] = nil;
}
if(n == 0){
errorc <-= nil;
exit;
}
}else if(a == realc)
errorc <-= p[x] + ": " + report;
}
}
type2s(c: int): string
{
case c{
'a' =>
return "any";
'x' =>
return "fs";
's' =>
return "string";
'v' =>
return "void";
'p' =>
return "gate";
'c' =>
return "command";
't' =>
return "entries";
'm' =>
return "selector";
* =>
return sys->sprint("unknowntype('%c')", c);
}
}
typeerror(tc: int, v: ref Value): string
{
sys->fprint(sys->fildes(2), "fs: bad type conversion, expected %s, was actually %s\n", type2s(tc), type2s(valuec[tagof v]));
return "type conversion error";
}
Value.t(v: self ref Value): ref Value.T
{
pick xv :=v {T => return xv;}
raise typeerror('t', v);
}
Value.c(v: self ref Value): ref Value.C
{
pick xv :=v {C => return xv;}
raise typeerror('c', v);
}
Value.s(v: self ref Value): ref Value.S
{
pick xv :=v {S => return xv;}
raise typeerror('s', v);
}
Value.p(v: self ref Value): ref Value.P
{
pick xv :=v {P => return xv;}
raise typeerror('p', v);
}
Value.x(v: self ref Value): ref Value.X
{
pick xv :=v {X => return xv;}
raise typeerror('x', v);
}
Value.v(v: self ref Value): ref Value.V
{
pick xv :=v {V => return xv;}
raise typeerror('v', v);
}
Value.m(v: self ref Value): ref Value.M
{
pick xv :=v {M => return xv;}
raise typeerror('m', v);
}
Value.typec(v: self ref Value): int
{
return valuec[tagof v];
}
Value.discard(v: self ref Value)
{
if(v == nil)
return;
pick xv := v {
X =>
(<-xv.i).t1 <-= Quit;
P =>
xv.i <-= (Nilentry, nil);
M =>
xv.i <-= (nil, nil, nil);
V =>
xv.i <-= 0;
T =>
xv.i.sync <-= 0;
}
}
sendnulldir(c: Fschan): int
{
reply := chan of int;
c <-= ((ref Sys->nulldir, nil), reply);
if((r := <-reply) == Down){
c <-= ((nil, nil), reply);
if(<-reply != Quit)
return Quit;
return Next;
}
return r;
}
quit(errorc: chan of string)
{
if(errorc != nil)
errorc <-= nil;
exit;
}
report(errorc: chan of string, err: string)
{
if(errorc != nil)
errorc <-= err;
}
# true if a module with type sig t1 is compatible with a caller that expects t0
typecompat(t0, t1: string): int
{
(rt0, at0, ot0) := splittype(t0);
(rt1, at1, ot1) := splittype(t1);
if((rt0 != rt1 && rt0 != 'a') || at0 != at1) # XXX could do better for repeated args.
return 0;
for(i := 1; i < len ot0; i++){
for(j := i; j < len ot0; j++)
if(ot0[j] == '-')
break;
(ok, t) := opttypes(ot0[i], ot1);
if(ok == -1 || ot0[i:j] != t)
return 0;
i = j + 1;
}
return 1;
}
splittype(t: string): (int, string, string)
{
if(t == nil)
return (-1, nil, nil);
for(i := 1; i < len t; i++)
if(t[i] == '-')
break;
return (t[0], t[1:i], t[i:]);
}
opttypes(opt: int, opts: string): (int, string)
{
for(i := 1; i < len opts; i++){
if(opts[i] == opt && opts[i-1] == '-'){
for(j := i+1; j < len opts; j++)
if(opts[j] == '-')
break;
return (0, opts[i+1:j]);
}
}
return (-1, nil);
}
cmdusage(s, t: string): string
{
if(s == nil)
return nil;
for(oi := 0; oi < len t; oi++)
if(t[oi] == '-')
break;
if(oi < len t){
single, multi: string;
for(i := oi; i < len t - 1;){
for(j := i + 1; j < len t; j++)
if(t[j] == '-')
break;
optargs := t[i+2:j];
if(optargs == nil)
single[len single] = t[i+1];
else{
multi += sys->sprint(" [-%c", t[i+1]);
for (k := 0; k < len optargs; k++)
multi += " " + type2s(optargs[k]);
multi += "]";
}
i = j;
}
if(single != nil)
s += " [-" + single + "]";
s += multi;
}
multi := 0;
if(oi > 2 && t[oi - 1] == '*'){
multi = 1;
oi -= 2;
}
for(k := 1; k < oi; k++)
s += " " + type2s(t[k]);
if(multi)
s += " [" + type2s(t[k]) + "...]";
s += " -> " + type2s(t[0]);
return s;
}