From ca488b918794c92c47c157a9e18ccb478cf6be40 Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Sun, 5 Dec 2010 13:52:43 +0000 Subject: [PATCH] algol68-fringe: New language. Well, not that new. But it's a language which wasn't represented here before. I'm using the Algol 68 Genie implementation, which works as a dynamic-ish runtime. Astonishingly, it can call execve(2) but not exit(3), so there's an appalling hack. Sorry. --- Makefile | 15 +++++ algol68-fringe.a68 | 161 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 176 insertions(+) create mode 100644 algol68-fringe.a68 diff --git a/Makefile b/Makefile index fea0598..2c43ae8 100644 --- a/Makefile +++ b/Makefile @@ -204,6 +204,21 @@ erlang-fringe: } >$@.new $(V_HIDE)chmod +x $@.new && mv $@.new $@ +###-------------------------------------------------------------------------- +### Algol 68. + +ALGOL68 = /usr/local/bin/a68g + +LANGS += algol68 +TARGETS += algol68-fringe +SOURCES += algol68-fringe.a68 + +algol68-fringe: algol68-fringe.a68 + $(call v_echo,GENSH){ echo '#! $(ALGOL68) --script'; \ + cat $<; \ + } >$@.new + $(V_HIDE)chmod +x $@.new && mv $@.new $@ + ###----- That's all, folks -------------------------------------------------- all:: $(TARGETS) diff --git a/algol68-fringe.a68 b/algol68-fringe.a68 new file mode 100644 index 0000000..fdea7c8 --- /dev/null +++ b/algol68-fringe.a68 @@ -0,0 +1,161 @@ +COMMENT -*-algol-68-*- + + Algol 68 implementation of a `same-fringe' solver. + +COMMENT +BEGIN + +###-------------------------------------------------------------------------- +# # Reporting errors. +# # +# # This stuff is specific to Algol 68 Genie. +### + +[] CHAR program name = + BEGIN [] CHAR prog = argv(3); + INT i := UPB prog; + WHILE (i >= LWB prog | prog[i] /= "/" | FALSE) DO i -:= 1 OD; + prog[i + 1:] + END; + +PROC fail = ([] CHAR message) VOID: + ### Mournfully announce an error and quit. + # + BEGIN put(stand error, (program name, ": ", message, new line)); + execve("/bin/false", "false", ()) # Can this be any worse? # + END; + +###-------------------------------------------------------------------------- +# # Nodes and trees. +### + +MODE NODE = STRUCT (REF NODE left, right, CHAR data); + +PROC tree is not empty = (REF NODE node) BOOL: node :/=: NIL; + +PROC parse tree = ([] CHAR string) REF NODE: + ### Parse STRING, and return the tree described. + ## + ## The syntax is simple: + ## + ## tree ::= empty | `(' tree char tree `)' + ## + ## The amiguity is resolved by always treating `(' as a tree when a tree + ## is expected. + # + BEGIN INT i := LWB string; + PROC parse = REF NODE: + BEGIN IF i > UPB string THEN NIL + ELIF string[i] /= "(" THEN NIL + ELSE i +:= 1; + REF NODE left = parse; + IF i > UPB string THEN fail("no data") FI; + CHAR data = string[i]; i +:= 1; + REF NODE right = parse; + IF (i > UPB string | TRUE | string[i] /= ")") + THEN fail("missing )") FI; + i +:= 1; + HEAP NODE := (left, right, data) + FI + END; + REF NODE tree = parse; + IF i <= UPB string THEN fail("trailing junk") FI; + tree + END; + +###-------------------------------------------------------------------------- +# # Iteration. +### + +MODE NODEITER = STRUCT (REF [] REF NODE stack, INT sp); + +PROC push nodes = (REF NODEITER iter, REF NODE node) VOID: + ### Helper function for iteration. + ## + ## If NODE is not null, push it onto ITER's stack, and then do the same + ## for NODE's left child. + # + BEGIN REF NODE n := node; + WHILE tree is not empty(n) + DO IF sp OF iter > UPB (stack OF iter) + THEN INT max = UPB (stack OF iter); + HEAP [2 * max] REF NODE new stack; + FOR i FROM 1 TO max DO new stack[i] := (stack OF iter)[i] OD; + stack OF iter := new stack + FI; + (stack OF iter)[sp OF iter] := n; + n := left OF n; + sp OF iter +:= 1 + OD + END; + +PROC next node = (REF NODEITER iter) REF NODE: + ### Return the next node in order for the tree being traversed by ITER. + ## + ## Returns NIL if the iteration is complete. + # + IF sp OF iter = 1 THEN NIL + ELSE sp OF iter -:= 1; + REF NODE node = (stack OF iter)[sp OF iter]; + push nodes(iter, right OF node); + node + FI; + +PROC node iterator = (REF NODE node) REF NODEITER: + ### Return a new iterator traversing the tree rooted at NODE. + # + BEGIN REF NODEITER iter = HEAP NODEITER := (HEAP [1] REF NODE, 1); + push nodes(iter, node); + iter + END; + +###-------------------------------------------------------------------------- +# # Fringe operations. +### + +PROC print fringe = (REF NODE tree) VOID: + ### Print the characters stored in the tree headed by TREE in order. + # + BEGIN REF NODEITER iter = node iterator(tree); + WHILE REF NODE n = next node(iter); tree is not empty(n) + DO print(data OF n) OD; + print(new line) + END; + +PROC same fringes = (REF NODE n, REF NODE nn) BOOL: + ### Answer whether traversing the trees rooted at N and NN yields the same + ## items in the same order. + # + BEGIN REF NODEITER i = node iterator(n), ii = node iterator(nn); + BOOL win := FALSE; + DO REF NODE n = next node(i), nn = next node(ii); + IF tree is not empty(n) + THEN IF tree is not empty(nn) + THEN IF data OF n = data OF nn THEN SKIP ELSE done FI + ELSE done + FI + ELIF tree is not empty(nn) THEN done + ELSE win := TRUE; done + FI + OD; + done: win + END; + +###-------------------------------------------------------------------------- +# # Main program. +# # +# # Argument fetching is specific to Algol 68 Genie. +### + +CASE argc - 3 IN + BEGIN REF NODE tree = parse tree(argv(4)); + print fringe(tree) + END, + BEGIN REF NODE t = parse tree(argv(4)), tt = parse tree(argv(5)); + print(((same fringes(t, tt) | "match" | "no match"), new line)) + END +OUT fail("bad args") +ESAC +END + +###----- That's all, folks -------------------------------------------------# -- 2.11.0