## anchor-dictionary.pkg -- Operations over abstract names for makelib source files.
# Compiled by:
# src/app/makelib/paths/srcpath.sublib# See comments in src/app/makelib/paths/anchor-dictionary.apistipulate
package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package wp = winix__premicrothread::path; # winix__premicrothread is from src/lib/std/winix--premicrothread.pkg package wf = winix__premicrothread::file;
package id = file_id; # file_id is from src/app/makelib/paths/fileid.pkgherein
package anchor_dictionary
: Anchor_Dictionary # Anchor_Dictionary is from src/app/makelib/paths/anchor-dictionary.api {
exception FORMAT;
# # red_black_map_g is from src/lib/src/red-black-map-g.pkg package string_map
=
red_black_map_g (
package {
Key = String;
compare = string::compare;
}
);
fun impossible s
=
raise exception DIE ("impossible error in anchor_dictionary: " + s);
Anchor = String;
Stable_Id = Int;
# A Reverse_Path is like the result of winix__premicrothread::path::from_string,
# except that we keep the list of arcs in reversed order.
# This makes adding and removing arcs at the end easier:
#
Reverse_Path
=
{ reverse_arcs: List( String ),
disk_volume: String,
is_absolute: Bool
};
# Having both paths and reverse paths complicates the code
# to no good purpose -- we should just support a single
# Elab's primary purpose seems to be to be the return type of the 'get' fn
#
Elab = { reverse_path: Reverse_Path,
valid: Void -> Bool,
reanchor: (Anchor -> String) -> Null_Or( Reverse_Path )
};
Anchor_Val
=
( (Void -> Elab),
(Bool -> String)
);
# Nomenclature: "CWD" == "current working directory".
Path_Root # Root of a path
= ROOT String
| DIR File0
| CWD { name: String, # Full directory path as a string.
reverse_path: Reverse_Path # 'name', parsed and reversed.
}
| ANCHOR { name: Anchor, # In practice our anchor is always "ROOT" these days.
get: Void -> Elab,
encode: Bool -> Null_Or( String )
}
also
File0 = PATH { path_root: Path_Root,
arcs: List( String ), # At least one arc!
elab: Ref( Elab ),
id: Ref( Null_Or( id::Id ) )
};
File = (File0, Stable_Id);
Dir_Path = { path_root: Path_Root,
arcs: List( String ),
plaint_sink: String -> Void # Where to send error messages.
};
Renaming = { anchor: Anchor, value: Dir_Path }; # MUSTDIE
Renamings = List( Renaming ); # MUSTDIE
Anchor_Dictionary
=
{ get_free: Anchor -> Elab,
set_free: (Anchor, Null_Or( Reverse_Path )) -> Void,
is_set: Anchor -> Bool,
reset: Void -> Void,
print_me: String -> Void
};
Key = File;
# Stable comparison:
#
fun compare ( f1: File,
f2: File
)
=
int::compare (
#2 f1,
#2 f2
);
my null_reverse_path
:
Reverse_Path
=
{ reverse_arcs => [],
disk_volume => "",
is_absolute => FALSE
};
my bogus_elab
:
Elab
=
{ reverse_path => null_reverse_path,
valid => \\ _ = FALSE,
reanchor => \\ _ = NULL
};
#
fun string_to_reverse_path n
=
{ my { arcs, disk_volume, is_absolute }
=
wp::from_string n;
{ reverse_arcs => reverse arcs,
disk_volume,
is_absolute
};
};
cwd_info
=
{ path_string = wf::current_directory ();
REF { name => path_string,
reverse_path => string_to_reverse_path path_string
};
};
cwd_notify
=
REF TRUE;
#
fun abs_elab (arcs, disk_volume)
=
{ valid => \\ () = TRUE,
reanchor => \\ _ = NULL,
reverse_path => { reverse_arcs => reverse arcs,
disk_volume,
is_absolute => TRUE
}
};
#
fun unintern (f: File)
=
#1 f;
#
fun file_to_basename0 (PATH { arcs, path_root, ... } )
=
{ arcs,
path_root,
plaint_sink => \\ (_: String) = () # Discard error messages.
};
file_to_basename
=
file_to_basename0 o unintern;
# home = posix::getenv "HOME"
#
fun say string_list
=
fil::write (fil::stderr, cat string_list);
#
fun print_reverse_path {
reverse_arcs: List( String ),
disk_volume: String,
is_absolute: Bool
}
=
{ if (disk_volume != "")
say [ disk_volume, ":" ]; # RSX-11 will never die :-/
fi;
say [ is_absolute ?? "/"
:: "" ];
apply
(\\ arc = say [ arc, "/" ])
(reverse reverse_arcs);
};
#
fun print_elab {
reverse_path: Reverse_Path,
valid: Void -> Bool,
reanchor: (Anchor -> String) -> Null_Or( Reverse_Path )
}
=
{ print_reverse_path reverse_path;
if (not (valid ()))
say [ " INVALID" ];
fi;
};
#
fun print_dir (ROOT root)
=>
say [ " ROOT=", root ];
print_dir (DIR file0)
=>
{ say [ " DIR="];
print_file0 file0;
};
print_dir (CWD { name, reverse_path } )
=>
{ say [ " CWD=", name, " " ];
print_reverse_path reverse_path;
};
print_dir (ANCHOR { name, get, encode } )
=>
{ say [ " ANCHOR=", name, " "];
print_elab (get ()) ;
};
end
#
also
fun print_file0 (PATH { path_root, arcs, elab, id } )
=
{ say [ " PATH="];
print_dir path_root;
say [ " "];
apply
(\\ arc = say [ arc, "/" ])
arcs;
print_elab *elab;
};
#
fun print_basename { path_root, arcs, plaint_sink }
=
{ print_dir path_root;
say [ " " ];
apply
(\\ arc = say [ arc, "/" ])
arcs;
};
#
# fun print_renamings renaming_list
# =
# apply print_renaming renaming_list
# where
# fun print_renaming { anchor, value }
# =
# { say [ " $", (number_string::pad_right ' ' 24 anchor), "\t= " ];
# print_basename value;
# say [ "\n" ];
# };
# end;
#
fun encode0 bracket (basename: Dir_Path)
=
encode_arcs (basename.arcs, basename.path_root, FALSE, [])
where
# We need to convert a path character to
# a \031 style octal escape sequence if
# it isn't printable or contains one of
# our special path metacharacters like /
#
fun need_escape c
=
not (char::is_print c) or char::contains "/:\\$%()" c;
# Re-express char as a \031 style octal escape sequence:
fun to_octal_escape c
=
"\\" + number_string::pad_left '0' 3 (int::to_string (char::to_int c));
fun translate_char c
=
need_escape c ?? to_octal_escape c
:: string::from_char c;
translate_arc
=
string::translate translate_char;
my (dot, dotdot)
=
{ translate_arc'
=
string::translate to_octal_escape;
( translate_arc' ".",
translate_arc' ".."
);
};
infixr my 60 ::/:: ;
fun arc ::/:: [] => [arc];
arc ::/:: a => arc ! "/" ! a;
end;
fun arc a
=
if (a == wp::current_arc ) ".";
elif (a == wp::parent_arc ) "..";
elif (a == "." ) dot;
elif (a == ".." ) dotdot;
else translate_arc a;
fi;
fun encode_arcs ([], path_root, _, a)
=>
encode_path_root (path_root, a, NULL);
encode_arcs (arcs, path_root, context, a)
=>
{ l = map arc arcs;
a0 = list::head l;
l' = map arc (reverse l);
l'' = if (context and bracket)
cat ["(", list::head l', ")"] ! list::tail l';
else l'; fi;
a' = fold_forward
(\\ (x, l) = x ::/:: l)
(list::head l'' ! a)
(list::tail l'');
encode_path_root (path_root, a', THE a0);
};
end
also
fun encode_path_root (ROOT "", a, _)
=>
cat ("/" ! a);
encode_path_root (ROOT disk_volume, a, _)
=>
cat ("%" ! translate_arc disk_volume ::/:: a);
encode_path_root (CWD _, a, _)
=>
cat a;
encode_path_root (ANCHOR x, a, a1opt)
=>
case (x.encode bracket, a1opt)
(THE ad, _)
=>
not bracket ?? cat (ad ::/:: a)
:: cat ("$" ! translate_arc x.name ! "(=" ! ad ! ")/" ! a);
(NULL, NULL )
=>
cat ("$" ! translate_arc x.name ::/:: a);
(NULL, THE a1)
=>
{ a0 = translate_arc x.name;
cat ((bracket and a0 == a1) ?? ("$/" ! a)
:: ("$" ! a0 ::/:: a));
};
esac;
encode_path_root (DIR (PATH { arcs, path_root, ... } ), a, _)
=>
encode_arcs (arcs, path_root, TRUE, ":" ! a);
end;
end; # fun encode0
#
fun make_anchor (e: Anchor_Dictionary, a)
=
{ name => a,
get => \\ () = e.get_free a,
encode => \\ _ = NULL
};
encode_basename = encode0 FALSE;
encode = encode_basename o file_to_basename;
clients = REF ([]: List( String -> Void ) ); # This looks like icky thread-hostile mutable global state again :( XXX BUGGO FIXME
#
fun add_cwd_watcher client
=
clients := client ! *clients;
#
fun revalidate_cwd ()
=
{ (*cwd_info)
->
{ name => n, reverse_path };
n' = wf::current_directory ();
reverse_path'
=
string_to_reverse_path n';
if (n != n')
#
cwd_info := { name => n',
reverse_path => reverse_path'
};
cwd_notify := TRUE;
fi;
if *cwd_notify
#
basename
=
{ arcs => reverse reverse_path.reverse_arcs,
path_root => ROOT reverse_path.disk_volume,
plaint_sink => \\ (_: String) = () # Discard error messages.
};
encoded_basename
=
encode_basename basename;
apply
(\\ client = client encoded_basename)
*clients;
cwd_notify := FALSE;
fi;
};
#
fun schedule_notification ()
=
{
cwd_notify := TRUE;
};
# Given a reverse path naming a file,
# return a reverse path naming the
# directory containing that file.
#
# This just requires dropping the
# first element of the reverse path:
#
fun parent_directory_of_reverse_path { reverse_arcs => _ ! reverse_arcs, disk_volume, is_absolute }
=> { reverse_arcs, disk_volume, is_absolute };
parent_directory_of_reverse_path _
=>
impossible "parent_directory_of_reverse_path";
end;
#
fun dir_elab { reverse_path, valid, reanchor }
=
{ reverse_path => parent_directory_of_reverse_path
reverse_path,
valid,
reanchor => null_or::map
parent_directory_of_reverse_path
o
reanchor
};
# Add a list of args to the
# logical end-of-path.
#
# Since we have the path
# stored in reverse, this
# physically requires reversing
# the new list and PREpending
# it to the existing arc list:
#
fun augment_reverse_path arcs { reverse_arcs, disk_volume, is_absolute }
=
{ reverse_arcs => list::reverse_and_prepend (arcs, reverse_arcs),
disk_volume,
is_absolute
};
#
fun augment_elab arcs { reverse_path, valid, reanchor }
=
{ reverse_path => augment_reverse_path arcs reverse_path,
valid,
reanchor => null_or::map (augment_reverse_path arcs) o reanchor
};
#
fun eval_dir (ANCHOR { name, get, encode } ) => get ();
eval_dir (ROOT disk_volume) => abs_elab ([], disk_volume);
eval_dir (DIR path) => dir_elab (eval_file path);
eval_dir (CWD { name, reverse_path } )
=>
{ fun valid ()
=
name == .name *cwd_info;
fun reanchor (a: Anchor -> String)
=
NULL;
if (valid ()) { reverse_path => null_reverse_path, valid, reanchor };
else { reverse_path, valid => \\ () = TRUE, reanchor };
fi;
};
end
also
fun eval_file (PATH { path_root, arcs, elab, id })
=
{ (*elab)
->
e as { reverse_path, valid, reanchor };
if (valid ())
#
e;
else
e' = augment_elab arcs (eval_dir path_root);
elab := e';
id := NULL;
e';
fi;
};
#
fun reverse_path_to_name { reverse_arcs, disk_volume, is_absolute }
=
wp::to_string
{
arcs => reverse reverse_arcs,
disk_volume,
is_absolute
};
#
fun id_of (p as PATH { id, ... } )
=
{ (eval_file p) -> { reverse_path, ... };
case *id
#
THE i => i;
#
NULL => {
i = id::file_id (reverse_path_to_name reverse_path);
id := THE i;
i;
};
esac;
};
#
fun compare0 (file1, file2)
=
id::compare (
id_of file1,
id_of file2
);
package file0_map
=
red_black_map_g (
Key = File0;
compare = compare0;
);
stipulate
known = REF (file0_map::empty: file0_map::Map( Int )); # XXX BUGGO FIXME more thread-hostile global state :-(
next = REF 0; # XXX BUGGO FIXME more thread-hostile global state :-(
herein
fun clear ()
=
known := file0_map::empty;
#
fun intern f
=
case (file0_map::get (*known, f))
#
THE i => (f, i);
#
NULL =>
{ i = *next;
#
next := i + 1;
known := file0_map::set (*known, f, i);
(f, i);
};
esac;
#
fun sync ()
=
{ km = *known;
fun inval (PATH { id, ... }, _)
=
id := NULL;
fun reinsert (k, v, m)
=
file0_map::set (m, k, v);
file0_map::keyed_apply
inval
km;
known
:=
file0_map::keyed_fold_forward
reinsert
file0_map::empty
km;
};
end;
dir0 = DIR;
dir = dir0 o unintern;
#
fun current_working_directory ()
=
{ revalidate_cwd ();
#
CWD *cwd_info;
};
os_string
=
id::canonical
o reverse_path_to_name
o .reverse_path
o eval_file
o unintern;
#
fun os_string_basename { path_root, arcs, plaint_sink }
=
id::canonical
(reverse_path_to_name
(.reverse_path
(augment_elab arcs
(eval_dir path_root))));
describe = encode0 TRUE o file_to_basename;
#
fun os_string_dir d
=
case (reverse_path_to_name (.reverse_path (eval_dir d)))
#
"" => wp::current_arc;
s => id::canonical s;
esac;
#
fun os_string' f
=
{ oss = os_string f;
#
if (not (wp::is_absolute oss))
#
oss;
else
ross = wp::make_relative
{
path => oss,
relative_to => .name *cwd_info
};
if (size ross < size oss) ross;
else oss;
fi;
fi;
};
#
fun new_anchor_dictionary ()
=
{ free_map = REF string_map::empty;
fun fetch anchor
=
case (winix__premicrothread::process::get_env ("MYTHRYL_" + anchor))
#
THE path
=>
( string_to_reverse_path path,
REF TRUE # "validity"
);
#
NULL
=>
case (string_map::get (*free_map, anchor))
#
THE x => x;
#
NULL =>
{ validity = REF TRUE;
#
reverse_path
=
{ reverse_arcs => [cat ["$Undef<", anchor, ">"]],
disk_volume => "",
is_absolute => FALSE
};
x = (reverse_path, validity);
free_map
:=
string_map::set (*free_map, anchor, x);
x;
};
esac;
esac;
fun get_free anchor
=
{ (fetch anchor)
->
(reverse_path, validity);
fun reanchor convert
=
THE (string_to_reverse_path (convert anchor));
{ reverse_path,
valid => \\ () = *validity,
reanchor
};
};
fun set_free (anchor, optional_reverse_path)
=
{ (fetch anchor) -> (_, validity);
#
validity := FALSE; # Invalidate earlier elaborations.
free_map
:=
case optional_reverse_path
#
NULL => string_map::drop (*free_map, anchor);
#
THE reverse_path => string_map::set (*free_map, anchor, (reverse_path, REF TRUE));
esac;
};
# A little debug-support routine to
# dump the complete state of an
# anchor_dictionary to stdout:
#
fun print_me (title: String)
=
{ item_list
=
string_map::keyvals_list *free_map;
fun print_item
(
anchor: String,
(
{ disk_volume: String,
is_absolute: Bool,
reverse_arcs: List( String )
},
valid: Ref( Bool )
)
)
=
{ say [ " $", (number_string::pad_right ' ' 24 anchor), "\t= " ];
if (disk_volume != "")
#
say [ disk_volume, ":" ]; # RT-11 will never die :-/
fi;
say [ is_absolute ?? "/"
:: ""
];
apply
(\\ arc = say [ arc, "/" ])
(reverse reverse_arcs);
say [ *valid ?? ""
:: " >>>>INVALID<<<<",
"\n"
];
};
say [ title ];
apply print_item item_list;
};
fun is_set a
=
string_map::contains_key (*free_map, a);
fun reset ()
=
{ fun invalidate (_, validity)
=
validity := FALSE;
string_map::apply
invalidate
*free_map;
free_map := string_map::empty;
};
{ get_free,
set_free,
is_set,
reset,
print_me
}
: Anchor_Dictionary;
};
#
fun get_anchor (dictionary: Anchor_Dictionary, anchor)
=
# Allow anchor to be overridden via Unix environment:
#
case (winix__premicrothread::process::get_env ("MYTHRYL_" + anchor))
#
THE path => THE path;
#
NULL =>
if (dictionary.is_set anchor)
#
THE (reverse_path_to_name (.reverse_path (dictionary.get_free anchor)));
else
NULL;
fi;
esac;
#
fun set0 make_absolute (e: Anchor_Dictionary, a, so) # so == string Null_Or
=
{ fun name_to_reverse_path s
=
string_to_reverse_path
( wp::is_absolute s ?? s
:: make_absolute s
);
e.set_free (a, null_or::map name_to_reverse_path so);
};
#
fun set_anchor x
=
{ set0
(\\ n = wp::make_absolute { path => n, relative_to => wf::current_directory () })
x
then
sync ();
};
# NB: The 'current_directory' call is executed at 'compiletime',
# before we dump the compiler executable, and is thus
# a locked-in runtime constant recording where to find
# our original sourcetree (and thus the libraries in it):
#
dictionary
=
{ dictionary = new_anchor_dictionary ();
set_anchor (dictionary, "ROOT", THE (winix__premicrothread::file::current_directory ()));
dictionary;
};
# Given a full pathname, change
# the prefix to $ROOT/ if possible:
#
fun abbreviate (full_pathname: String)
=
{ root = the (get_anchor (dictionary, "ROOT"));
if (string::is_prefix root full_pathname)
#
"$ROOT" + string::extract (full_pathname, string::length_in_bytes root, NULL);
else
full_pathname;
fi;
};
#
fun print_anchors (e: Anchor_Dictionary, title: String)
=
e.print_me title;
Stdspec
= RELATIVE List( String )
| ABSOLUTE List( String )
| ANCHORED (Anchor, List( String ))
;
#
fun parse_stdspec plaint_sink s
=
{ fun delim '/' => TRUE;
delim '\\' => TRUE;
delim _ => FALSE;
end;
fun transl ".." => wp::parent_arc;
transl "." => wp::current_arc;
transl arc => arc;
end;
impossible
=
\\ s = impossible ("AbsPath::parseStdspec: " + s);
case (map transl (string::fields delim s))
#
[""] => impossible "zero-length name";
[] => impossible "no fields";
"" ! arcs => ABSOLUTE arcs;
arcs as (["$"] | "$" ! "" ! _)
=>
{ plaint_sink (cat ["invalid zero-length anchor name in: `", s, "'"]);
RELATIVE arcs;
};
"$" ! (arcs as (arc1 ! _))
=>
ANCHORED (arc1, arcs);
arcs as (arc1 ! arcn)
=>
if (string::get_byte_as_char (arc1, 0) != '$') RELATIVE arcs;
else ANCHORED (string::extract (arc1, 1, NULL), arcn);
fi;
esac;
};
#
fun file0 ( { path_root, arcs, plaint_sink }: Dir_Path)
=
PATH { path_root,
elab => REF bogus_elab,
id => REF NULL,
arcs => case arcs
#
[] =>
{ plaint_sink (
cat [
"path needs at least one arc relative to `",
reverse_path_to_name ((eval_dir path_root).reverse_path),
"'"
]
);
["<bogus>"];
};
#
_ => arcs;
esac
};
file = intern o file0;
#
fun basename (path_root, arcs, plaint_sink)
=
{ path_root,
arcs,
plaint_sink
};
#
fun from_native { plaint_sink } { path_root, file_path }
=
case (wp::from_string file_path)
#
{ arcs, disk_volume, is_absolute => TRUE }
=>
basename (ROOT disk_volume, arcs, plaint_sink);
{ arcs, ... }
=>
basename (path_root, arcs, plaint_sink);
esac;
#
fun from_standard'
{ anchor_dictionary,
plaint_sink
}
{ path_root, # Typically anchor_dictionary::current_working_directory ().
file_path # E.g. "$ROOT/src/lib/core/init/init.cmi"
} # or "$ROOT/src/lib/std/standard.lib"
= # or "$ROOT/src/lib/core/mythryl-compiler-compiler/mythryl-compiler-compiler-for-this-platform.lib".
case (parse_stdspec plaint_sink file_path)
#
RELATIVE l => basename (path_root, l, plaint_sink);
ABSOLUTE l => basename (ROOT "", l, plaint_sink);
ANCHORED (a, l) => basename (ANCHOR (make_anchor (anchor_dictionary, a)), l, plaint_sink);
esac;
#
fun extend { path_root, arcs, plaint_sink } morearcs
=
{ path_root, arcs => arcs @ morearcs, plaint_sink };
#
fun os_string_basename_relative (p as { arcs, path_root, ... } )
=
case path_root
#
DIR _ =>
id::canonical
(wp::to_string { arcs, disk_volume => "", is_absolute => FALSE } );
_ => os_string_basename p;
esac;
os_string_relative
=
os_string_basename_relative
o
file_to_basename;
#
fun timestamp f
=
timestamp::last_file_modification_time
(os_string f);
#
fun pickle
{ warn }
{ file => (basename: Dir_Path),
relative_to => (freezefile, _)
}
=
pickle_basename basename
where
warn
=
\\ flag =
warn (flag,
# HACK! We are cheating here, turning the basename into
# a file even when there are no arcs. This is ok
# because of (bracket = FALSE) for encode0:
#
encode_basename
{ arcs => basename.arcs,
path_root => basename.path_root,
plaint_sink => \\ (_: String) = ()
}
);
fun pickle_path file
=
pickle_basename (file_to_basename0 file)
also
fun pickle_basename { arcs, path_root, plaint_sink }
=
arcs ! pickle_path_root path_root
also
fun pickle_path_root (ROOT disk_volume) => { warn TRUE; [[disk_volume, "r"]];};
pickle_path_root (CWD _) => impossible "pickle: CWD";
pickle_path_root (ANCHOR { name, ... } ) => [[name, "a"]];
pickle_path_root (DIR path)
=>
if (compare0 (path, freezefile) == EQUAL)
#
warn FALSE;
[["c"]];
else
pickle_path path;
fi;
end;
end;
#
fun unpickle anchor_dictionary { pickled, relative_to }
=
unpickle_basename pickled
where
fun unpickle_basename (arcs ! l) => basename (unpickle_path_root l, arcs, \\ _ = raise exception FORMAT);
unpickle_basename _ => raise exception FORMAT;
end
also
fun unpickle_path l
=
file0 (unpickle_basename l)
also
fun unpickle_path_root [[disk_volume, "r"]] => ROOT disk_volume;
unpickle_path_root [[ "c"]] => dir relative_to;
unpickle_path_root [[n, "a"]] => ANCHOR (make_anchor (anchor_dictionary, n));
unpickle_path_root l => DIR (unpickle_path l);
end;
end;
#
fun decode anchor_dictionary string
=
{ fun is_char (c1: Char) c2
=
c1 == c2;
fun unesc string
=
{ decode_char
=
char::from_int o # char is from src/lib/std/char.pkg the o # string is from src/lib/std/string.pkg int::from_string o # int is from src/lib/std/int.pkg implode;
fun loop ([], r) => string::implode (reverse r);
loop ('\\' ! d0 ! d1 ! d2 ! l, r) => (loop (l, decode_char [d0, d1, d2] ! r)
except _ = loop (l, d2 ! d1 ! d0 ! '\\' ! r));
loop ( c ! l, r) => loop (l, c ! r);
end;
loop (string::explode string, []);
};
fun arc "." => wp::current_arc;
arc ".." => wp::parent_arc;
arc a => unesc a;
end;
fun file (c, l)
=
file0 (basename (c, l, \\ s = raise exception DIE ("anchor_dictionary::decode: " + s)));
fun add_segment (segment, path)
=
file (dir0 path, map arc (string::fields (is_char '/') segment));
fun do_segment0 string
=
case (string::fields (is_char '/') string)
#
[] => impossible "decode: no fields in segment 0";
#
arc0 ! arcs
=>
{ arcs = map arc arcs;
#
fun extract ()
=
unesc (string::extract (arc0, 1, NULL));
fun say l
=
fil::write (fil::stderr, cat l);
if (arc0 == "")
#
file (ROOT "", arcs);
else
case (string::get_byte_as_char (arc0, 0))
#
'%' => file (ROOT (extract ()), arcs);
#
'$' => { n = extract ();
#
file (ANCHOR (make_anchor (anchor_dictionary, n)), arcs);
};
_ => file (current_working_directory (), arc arc0 ! arcs);
esac;
fi;
};
esac;
case (string::fields (is_char ':') string)
#
[] => impossible "decode: no segments";
seg0 ! segs => intern (fold_forward add_segment (do_segment0 seg0) segs);
esac;
}; # fun decode
#
fun encoding_is_absolute string
=
case (string::get_byte_as_char (string, 0))
#
('/' | '%') => TRUE;
_ => FALSE;
esac
except
_ = FALSE;
# A convenience version of from_standard':
#
fun from_standard anchor_dictionary file_path
=
file (
#
from_standard'
#
{ plaint_sink => \\ string = raise exception DIE string,
anchor_dictionary
}
#
{ path_root => current_working_directory (),
file_path
}
);
};
end;