Skip to content

Commit

Permalink
Some fixes.
Browse files Browse the repository at this point in the history
  • Loading branch information
@skaller
skaller committed Mar 18, 2024
1 parent b290653 commit 37320cc
Show file tree
Hide file tree
Showing 3 changed files with 46 additions and 24 deletions.
15 changes: 13 additions & 2 deletions src/compiler/flx_core/flx_beta.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -427,12 +427,23 @@ print_endline ("Beta-reducing typeop " ^ op ^ ", type=" ^ sbt bsym_table t);
btyp_variant (List.combine ss (List.map br ls))

| BTYP_polyvariant ts ->
let rec merge_ctors a b = match b with
| (s,t) :: tail ->
if not (List.mem_assoc s a) then merge_ctors ((s,t) :: a) tail
else let arg = List.assoc s a in
if arg = t then merge_ctors a tail
else Flx_exceptions.clierr sr (
"Merging alias in polyvariant duplicate constructors " ^ s ^
" of distinct types\n" ^ Flx_btype.st t ^ "\nand\n" ^ Flx_btype.st arg
)
| [] -> a
in
(* NO DEPTH INCREASE FOR ALIAS EXPANSION *)
let br' t = beta_reduce' calltag counter bsym_table sr depth termlist t in
let ctors = List.fold_left (fun acc term -> match term with
| `Ctor (s,t) -> (s,br t)::acc (* depth expansion *)
| `Ctor (s,t) -> merge_ctors acc [(s,br t)] (* depth expansion *)
| `Base t -> match br' t with (* No depth expansion *)
| BTYP_variant ts -> ts @ acc
| BTYP_variant ts -> merge_ctors acc ts
| _ -> print_endline ("Reduction of polyvariant failed"); assert false
) [] ts
in
Expand Down
44 changes: 22 additions & 22 deletions src/packages/flx_web.fdoc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1527,7 +1527,7 @@ println$ "formatting fpc data";
}
}

eprintln$ Version::felix_version+"Fpc2html initialisation";
//eprintln$ Version::felix_version+"Fpc2html initialisation";

fun setup(config_data:string) = {
var config_lines = split(config_data, "\n");
Expand Down Expand Up @@ -1725,7 +1725,7 @@ fin:>
}


eprintln$ Version::felix_version+"ocaml2html initialisation";
//eprintln$ Version::felix_version+"ocaml2html initialisation";

fun setup(x:string) = {
C_hack::ignore(x); // which means, don't ignore it!
Expand Down Expand Up @@ -1923,7 +1923,7 @@ fin:>
}
}

eprintln$ Version::felix_version+"Py2html initialisation";
//eprintln$ Version::felix_version+"Py2html initialisation";

fun setup(x:string) = {
C_hack::ignore(x); // which means, don't ignore it .. :)
Expand Down Expand Up @@ -2573,7 +2573,7 @@ fin:>
}


eprintln$ Version::felix_version+" flx2html initialisation";
//eprintln$ Version::felix_version+" flx2html initialisation";

fun setup(config_data:string) = {
var config_lines = split(config_data, "\n");
Expand Down Expand Up @@ -2828,7 +2828,7 @@ fin:>
return false, out;
}
}
eprintln$ Version::felix_version+ " cpp2html initialisation";
//eprintln$ Version::felix_version+ " cpp2html initialisation";

fun setup(config_data:string) = {
var config_lines = split(config_data, "\n");
Expand Down Expand Up @@ -3031,7 +3031,7 @@ object xlat_fdoc (t:string, filename:string) implements fdoc_t = {
| Some _ =>
println$ "Duplicate definition of tangler " + id;
| #None =>
println$ "Add tangler id=" + id + " filename=" + filename;
//println$ "Add tangler id=" + id + " filename=" + filename;
add tanglers id filename;
endmatch;
}
Expand Down Expand Up @@ -3270,23 +3270,23 @@ next:>
| #None =>
match Match (tangler_use_re2, b) with
| Some s =>
println$ "Tangle id=" + s.1;
//println$ "Tangle id=" + s.1;
match get tanglers s.1 with
| Some x =>
println$ "Tangler filename=" + x;
//println$ "Tangler filename=" + x;
var xtn = Filename::get_extension x;
println$ "Extension=" + xtn;
//println$ "Extension=" + xtn;
if xtn in (".flx",".flxh",".fsyn") do
write_string("<pre class='inclusion'>\n"+x+"</pre>\n");
println$ "flx ....";
//println$ "flx ....";
inline_felix (#get_text);
elif xtn in (".cxx",".cpp",".hpp",".c",".cc",".h") do
write_string("<pre class='inclusion'>\n"+x+"</pre>\n");
println$ "cpp ....";
//println$ "cpp ....";
inline_cpp (#get_text);
else
write_string("<pre class='inclusion'>\n"+x+"</pre>\n");
println$ "pre ....";
//println$ "pre ....";
inline_pre (#get_text);
done
| #None =>
Expand Down Expand Up @@ -3364,7 +3364,7 @@ next:>
}
}

eprintln$ Version::felix_version + " fdoc2html initialisation";
//eprintln$ Version::felix_version + " fdoc2html initialisation";

fun setup(config_data:string) = {
var config_lines = split(config_data, "\n");
Expand Down Expand Up @@ -3563,7 +3563,7 @@ interface slideshow_t {
include "./button-interface";

fun setup(config_data:string) = {
eprintln$ "Setup fdoc_button " + config_data;
//eprintln$ "Setup fdoc_button " + config_data;
return 0;
}

Expand Down Expand Up @@ -3660,7 +3660,7 @@ export fun fdoc_button of (unit) as "fdoc_button";
include "./edit-interface";

fun setup(config_data:string) = {
eprintln$ "Setup fdoc_edit " + config_data;
//eprintln$ "Setup fdoc_edit " + config_data;
return 0;
}

Expand Down Expand Up @@ -3740,7 +3740,7 @@ include "./button-interface";
var button-factory : unit -> button-factory_t;

fun setup(config_data:string) = {
eprintln$ "Setup fdoc_fileseq " + config_data;
//eprintln$ "Setup fdoc_fileseq " + config_data;
button-factory = Dynlink::load-plugin-func0 [button-factory_t] (dll-name="fdoc_button");
return 0;
}
Expand Down Expand Up @@ -3819,7 +3819,7 @@ include "./fdoc-frame-interface";
include "./toc_menu-interface";

fun setup (config_data:string) = {
eprintln$ "Setup fdoc_frame v1.4 " + config_data;
//eprintln$ "Setup fdoc_frame v1.4 " + config_data;
return 0;
}

Expand Down Expand Up @@ -4148,7 +4148,7 @@ fun escape_sp(h: string) => map (fun (c: char) => if c == ' ' then '_'.char else

fun setup(config_data:string) = {
button-factory = Dynlink::load-plugin-func0 [button-factory_t] (dll-name="fdoc_button");
eprintln$ "Setup fdoc_heading " + config_data;
//eprintln$ "Setup fdoc_heading " + config_data;
return 0;
}

Expand Down Expand Up @@ -4226,7 +4226,7 @@ export fun fdoc_heading of (paragraph-control_t * (string->0)) as "fdoc_heading"
include "./paragraph-interface";

fun setup(config_data:string) = {
eprintln$ "Setup fdoc_paragraph" + config_data;
//eprintln$ "Setup fdoc_paragraph" + config_data;
return 0;
}

Expand All @@ -4253,7 +4253,7 @@ export fun fdoc_paragraph of (string->0) as "fdoc_paragraph";
include "./scanner-interface";

fun setup(config_data:string) = {
eprintln$ "Setup fdoc_scanner " + config_data;
//eprintln$ "Setup fdoc_scanner " + config_data;
return 0;
}

Expand Down Expand Up @@ -4418,7 +4418,7 @@ function reset_slides() {
include "./slideshow-interface";

fun setup(config_data:string) = {
eprintln$ "Setup fdoc_slideshow " + config_data;
//eprintln$ "Setup fdoc_slideshow " + config_data;
return 0;
}

Expand Down Expand Up @@ -4520,7 +4520,7 @@ open class WebserverPluginCommon
include "./toc_menu-interface";

fun setup (config_data:string) = {
eprintln$ "Setup toc_menu v1.1 " + config_data;
//eprintln$ "Setup toc_menu v1.1 " + config_data;
return 0;
}

Expand Down
11 changes: 11 additions & 0 deletions src/packages/regex.fdoc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -368,6 +368,17 @@ class Regdef {
| Perl of string
;

instance Str[regex] {
fun str (x: regex) => match x with
| Alts ls => "(" + cat " | " (map str of regex ls) + ")"
| Seqs ls => "(" + cat " " (map str of regex ls) + ")"
| Rpt (r,min,max) => "Rpt(" + r.str + "," + min.str + "," + max.str + ")"
| Group r => "Group(" + r.str + ")"
| String r => "String(" + r.repr + ")"
| Perl r => "Perl(" + r.repr + ")"
| Charset r => "Charset(" + r.repr + ")"
;
}
private fun prec: regex -> int =
| Perl _ => 3
| Alts _ => 3
Expand Down

0 comments on commit 37320cc

Please sign in to comment.