diff options
Diffstat (limited to 'ipl/packs/tcll1')
34 files changed, 2865 insertions, 0 deletions
diff --git a/ipl/packs/tcll1/Makefile b/ipl/packs/tcll1/Makefile new file mode 100644 index 0000000..d15cf0b --- /dev/null +++ b/ipl/packs/tcll1/Makefile @@ -0,0 +1,10 @@ +tcll1: + icont -s -c xcode escape ebcdic + icont -s -c gramanal ll1 semstk readll1 parsell1 scangram semgram + icont -s -fs tcll1 + +Iexe: tcll1 + cp tcll1 ../../iexe/ + +Clean: + rm -f *.u[12] tcll1 diff --git a/ipl/packs/tcll1/NOTICE b/ipl/packs/tcll1/NOTICE new file mode 100644 index 0000000..625626b --- /dev/null +++ b/ipl/packs/tcll1/NOTICE @@ -0,0 +1,4 @@ +In order to comply with the file-naming requirements for +CD-ROM production, dashes in file names have been converted to +underscores. You may find references to file names with +dashes in the documentation; use the underscore versions. diff --git a/ipl/packs/tcll1/README b/ipl/packs/tcll1/README new file mode 100644 index 0000000..690d7c9 --- /dev/null +++ b/ipl/packs/tcll1/README @@ -0,0 +1,94 @@ + TCLL1 + The TCLL1 Parser Generator and Parser + (TC: "Tools of Computing") + +BUILD1.BAT MS-DOS batch file to compile TCLL1. It should be + able to execute as a shell script under UNIX. + +TCLL1.ICN main program for TCLL1 +LL1.ICN LL(1) parser generation routines +SCANGRAM.ICN scanner for input grammars +SEMGRAM.ICN semantics routines for handling the input grammars +TCLL1.GRM grammar for input grammars +TCLL1.LL1 translated input grammar for input grammars +GRAMANAL.ICN context-free grammar analysis module + +PARSELL1.ICN LL(1) parser +READLL1.ICN input routine for translated grammars +SEMSTK.ICN semantics routines called by PARSELL1.ICN to handle + the semantics stack + +RPTPERR.ICN routine to report syntax errors + +SEMOUT.ICN semantics routines just to write out the tokens and + action symbols (for early stages of debugging the + grammar) + + + Building the parser generator + +Before reading the rest of this description of TCLL1, you +should compile it on your own system. That will allow you to +try out the test grammars as they are discussed. + +If you do not have a copy of Icon, you can get it over the +Internet: ftp it from cs.arizona.edu: + ftp ftp.cs.arizona.edu + name: anonymous + password: your_e-mail_address + cd icon + +Versions of Icon for several machines are in subdirectories of +directory icon. You may also want to pick up the Icon +Programming Library. + +If you have the Icon Programming Library (IPL) installed on a +DOS/WINDOWS machine, you can execute the batch file +mktcll1.bat to build the parser generator. The three files from +the IPL that the parser generator uses are included with this +distribution and can be compiled separately. To build the +parser generator by hand, you may execute + + rem These are from the Icon Program Library: + + icont -c escape ebcdic xcode + + rem These form the parser generator proper + + icont -c gramanal ll1 semstk readll1 parsell1 scangram semgram + icont -fs tcll1 + +The first icont line compiles the files from the IPL. You may +omit the line if you have the IPL installed. The second icont +line compiles modules used by the parser generator. The third +line compiles the parser generator's main program. The flag -fs +tells the translator that the parser generator calls some +procedures by giving their names as strings. In Icon version 8, +this flag is not needed; in version 9 it is. + +To use TCLL1 to build a parsing table, execute + + Under Icon version 8: + + iconx tcll1 grammar.grm + + Under Icon version 9: + + tcll1 grammar.grm + +where grammar.grm is the grammar file. The output of the parser +generator will be encoded parse tables in file grammar.ll1 . If +you would also like a listing of the grammar and diagnostic +information, execute + + Under Icon version 8: + + iconx tcll1 -p grammar.grm + + Under Icon version 9: + + tcll1 -p grammar.grm + +Tlcll1 reads its own parsing table from file tcll1.ll1 which +must be in the current directory. + diff --git a/ipl/packs/tcll1/bugs.grm b/ipl/packs/tcll1/bugs.grm new file mode 100644 index 0000000..832932d --- /dev/null +++ b/ipl/packs/tcll1/bugs.grm @@ -0,0 +1,9 @@ +start = e. +e = e "+" t . +e = e "-" t . +t = t "*" t . +t = t "/" t . +t = f . +p = i . +p = "(" e ")" . + diff --git a/ipl/packs/tcll1/build1.bat b/ipl/packs/tcll1/build1.bat new file mode 100644 index 0000000..2dd52d2 --- /dev/null +++ b/ipl/packs/tcll1/build1.bat @@ -0,0 +1,9 @@ +rem These are from the Icon Program Library: + +icont -c xcode escape ebcdic + +rem These form the parser generator proper + +icont -c gramanal ll1 semstk readll1 parsell1 scangram semgram +icont -fs tcll1 + diff --git a/ipl/packs/tcll1/c_ll1.grm b/ipl/packs/tcll1/c_ll1.grm new file mode 100644 index 0000000..9bfec7c --- /dev/null +++ b/ipl/packs/tcll1/c_ll1.grm @@ -0,0 +1,18 @@ +# c-ll1 +# LL(1) +start = s . + +s = i ("=" e | ttail etail) . +s = n ttail etail . +s = "(" e ")" ttail etail . + +e = t etail. +etail = { "+" t | "-" t } . + +t = f ttail . +ttail = [ "*" t | f "/" t ]. + +f = i . +f = n . +f = "(" e ")" . + diff --git a/ipl/packs/tcll1/c_nll1.grm b/ipl/packs/tcll1/c_nll1.grm new file mode 100644 index 0000000..dd21dc5 --- /dev/null +++ b/ipl/packs/tcll1/c_nll1.grm @@ -0,0 +1,16 @@ +# c-nll1 +# not LL(1) + +start = s . +s = e . +s = i "=" e . +e = e "+" t . +e = e "-" t . +e = t . +t = f "*" t . +t = f "/" t . +t = f . +f = i . +f = n . +f = "(" e ")" . + diff --git a/ipl/packs/tcll1/declacts.icn b/ipl/packs/tcll1/declacts.icn new file mode 100644 index 0000000..835f200 --- /dev/null +++ b/ipl/packs/tcll1/declacts.icn @@ -0,0 +1,48 @@ +link readLL1 +record LL1(sel,deflt, + terminals,actions, + fiducials,firstFiducials, + minLengRHS, + start,eoi) + + +procedure main(L) +local filename,baseFilename,flags,outfile +local ll1 +flags := "" +if L[1][1]=="-" then { + flags := L[1] + filename := L[2] +} else { + filename:=L[1] +} +if /filename then + stop("usage: [iconx] tcll1 [flags] filename.ll1") + +baseFilename:=fileSuffix(filename)[1] +if filename==(baseFilename||".inv") then + stop("will not write output over input") + +ll1:=readLL1(baseFilename||".ll1") + +if *ll1.actions > 0 then { + outfile:=open(baseFilename||".inv","r") + every write("invocable \"",!ll1.actions,"\"") +} + +end + +# From: filename.icn in Icon Program Library +# Author: Robert J. Alexander, 5 Dec. 89 +# Modified: Thomas Christopher, 12 Oct. 94 + +procedure fileSuffix(s,separator) + local i + /separator := "." + i := *s + 1 + every i := find(separator,s) + return [s[1:i],s[(*s >= i) + 1:0] | &null] +end + + + diff --git a/ipl/packs/tcll1/e.grm b/ipl/packs/tcll1/e.grm new file mode 100644 index 0000000..2a200db --- /dev/null +++ b/ipl/packs/tcll1/e.grm @@ -0,0 +1,5 @@ +start = e . +e = t { ("+" | "-") t } . +t = f [ ("*" | "/") t ]. +f = i | "(" e ")" . + diff --git a/ipl/packs/tcll1/e_notll1.grm b/ipl/packs/tcll1/e_notll1.grm new file mode 100644 index 0000000..f9657a2 --- /dev/null +++ b/ipl/packs/tcll1/e_notll1.grm @@ -0,0 +1,12 @@ +# errors--not LL(1) + +start = e . +e = e "+" t . +e = e "-" t . +e = t . +t = f "*" t . +t = f "/" t . +t = f . +f = i . +f = "(" e ")" . + diff --git a/ipl/packs/tcll1/ea_ll1.grm b/ipl/packs/tcll1/ea_ll1.grm new file mode 100644 index 0000000..f39a25f --- /dev/null +++ b/ipl/packs/tcll1/ea_ll1.grm @@ -0,0 +1,8 @@ +# ea-ll1.grm +# action symbols +# LL(1) +start = e . +e = t { "+" t A! | "-" t S!} . +t = f [ "*" t M! | "/" t D!]. +f = i N! | "(" e ")" P!. + diff --git a/ipl/packs/tcll1/ea_nll1.grm b/ipl/packs/tcll1/ea_nll1.grm new file mode 100644 index 0000000..56f0535 --- /dev/null +++ b/ipl/packs/tcll1/ea_nll1.grm @@ -0,0 +1,14 @@ +# ea-nll1.grm +# action symbols +# not LL(1) + +start = e . +e = e "+" t A!. +e = e "-" t S!. +e = t . +t = f "*" t M!. +t = f "/" t D!. +t = f . +f = i N!. +f = "(" e ")" P!. + diff --git a/ipl/packs/tcll1/ebcdic.icn b/ipl/packs/tcll1/ebcdic.icn new file mode 100644 index 0000000..1dde431 --- /dev/null +++ b/ipl/packs/tcll1/ebcdic.icn @@ -0,0 +1,157 @@ +############################################################################ +# +# File: ebcdic.icn +# +# Subject: Procedures to convert between ASCII and EBCDIC +# +# Author: Alan Beale +# +# Date: March 31, 1990 +# +############################################################################ +# +# These procedures assist in use of the ASCII and EBCDIC character sets, +# regardless of the native character set of the host: +# +# Ascii128() Returns a 128-byte string of ASCII characters in +# numerical order. Ascii128() should be used in +# preference to &ascii for applications which might +# run on an EBCDIC host. +# +# Ascii256() Returns a 256-byte string representing the 256- +# character ASCII character set. On an EBCDIC host, +# the order of the second 128 characters is essentially +# arbitrary. +# +# Ebcdic() Returns a 256-byte string of EBCDIC characters in +# numerical order. +# +# AsciiChar(i) Returns the character whose ASCII representation is i. +# +# AsciiOrd(c) Returns the position of the character c in the ASCII +# collating sequence. +# +# EbcdicChar(i) Returns the character whose EBCDIC representation is i. +# +# EbcdicOrd(c) Returns the position of the character c in the EBCDIC +# collating sequence. +# +# MapEtoA(s) Maps a string of EBCDIC characters to the equivalent +# ASCII string, according to a plausible mapping. +# +# MapAtoE(s) Maps a string of ASCII characters to the equivalent +# EBCDIC string, according to a plausible mapping. +# +# Control(c) Returns the "control character" associated with the +# character c. On an EBCDIC host, with $ representing +# an EBCDIC character with no 7-bit ASCII equivalent, +# Control("$") may not be identical to "\^$", as +# translated by ICONT (and neither result is particularly +# meaningful). +# +############################################################################ +# +# Notes: +# +# There is no universally accepted mapping between ASCII and EBCDIC. +# See the SHARE Inc. publication "ASCII and EBCDIC Character Set and +# Code Issues in Systems Application Architecture" for more information +# than you would ever want to have on this subject. +# +# The mapping of the first 128 characters defined below by Ascii128() +# is the most commonly accepted mapping, even though it probably +# is not exactly like the mapping used by your favorite PC to mainframe +# file transfer utility. The mapping of the second 128 characters +# is quite arbitrary, except that where an alternate translation of +# ASCII char(n) is popular, this translation is assigned to +# Ascii256()[n+129]. +# +# The behavior of all functions in this package is controlled solely +# by the string literals in the _Eascii() procedure. Therefore you +# may modify these strings to taste, and still obtain consistent +# results, provided that each character appears exactly once in the +# result of _Eascii(). +# +# Yes, it's really true that the EBCDIC "\n" (NL, char(16r15)) is not +# the same as "\l" (LF, char(16r25)). How can that be? "Don't blame +# me, man, I didn't do it." +# +############################################################################ + +procedure _Eascii() + static EinAorder + initial + EinAorder := +# NUL SOH STX ETX EOT ENQ ACK BEL BS HT NL VT FF CR SO SI + "\x00\x01\x02\x03\x37\x2d\x2e\x2f\x16\x05\x15\x0b\x0c\x0d\x0e\x0f"|| +# DLE DC1 DC2 DC3 DC4 NAK SYN ETB CAN EM SUB ESC FS GS RS US + "\x10\x11\x12\x13\x3c\x3d\x32\x26\x18\x19\x3f\x27\x1c\x1d\x1e\x1f"|| +# sp ! " # $ % & ' ( ) * + , - . / + "\x40\x5a\x7f\x7b\x5b\x6c\x50\x7d\x4d\x5d\x5c\x4e\x6b\x60\x4b\x61"|| +# 0 1 2 3 4 5 6 7 8 9 : ; < = > ? + "\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\x7a\x5e\x4c\x7e\x6e\x6f"|| +# @ A B C D E F G H I J K L M N O + "\x7c\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xd1\xd2\xd3\xd4\xd5\xd6"|| +# P Q R S T U V W X Y Z $< \ $> ^ _ + "\xd7\xd8\xd9\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xad\xe0\xbd\x5f\x6d"|| +# ` a b c d e f g h i j k l m n o + "\x79\x81\x82\x83\x84\x85\x86\x87\x88\x89\x91\x92\x93\x94\x95\x96"|| +# p q r s t u v w x y z $( | $) ~ DEL + "\x97\x98\x99\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xc0\x4f\xd0\xa1\x07"|| + "\x04\x06\x08\x09\x0a\x14\x17\x1a\x1b\x20\x25\x21\x22\x23\x24\x28_ + \x29\x2a\x2b\x2c\x30\x31\x33\x34\x35\x36\x38\x39\x3a\x3b\x3e\xff_ + \x41\x42\x43\x44\x4a\x45\x46\x47\x48\x49\x51\x52\x53\x54\x55\x56_ + \x57\x58\x59\x62\x63\x64\x65\x66\x67\x68\x69\x70\x71\x72\x73\x74_ + \x75\x76\x77\x78\x80\x8a\x8c\x8d\x8e\x8f\x90\x9a\x9c\x9d\x9e\x9f_ + \xa0\xaa\xab\xac\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9_ + \xba\xbb\xbc\xbe\xbf\xca\xcb\xcc\xcd\xce\xcf\xda\xdb\xdc\xdd\xde_ + \xdf\xe1\xea\xeb\xec\xed\xee\xef\xfa\xfb\xfc\x8b\x6a\x9b\xfd\xfe" + return EinAorder +end + +procedure Ascii128() + if "\l" == "\n" then return string(&ascii) + return _Eascii()[1+:128] +end + +procedure Ascii256() + if "\l" == "\n" then return string(&cset) + return _Eascii() +end + +procedure Ebcdic() + if "\l" ~== "\n" then return &cset + return map(&cset, _Eascii(), &cset) +end + +procedure AsciiChar(i) + if "\l" == "\n" then return char(i) + return _Eascii()[0 < i+1] | runerr(205,i) +end + +procedure AsciiOrd(c) + if "\l" == "\n" then return ord(c) + return ord(MapEtoA(c)) +end + +procedure EbcdicChar(i) + if "\l" ~== "\n" then return char(i) + return map(char(i), _Eascii(), &cset) +end + +procedure EbcdicOrd(c) + if "\l" ~== "\n" then return ord(c) + return ord(MapAtoE(c)) +end + +procedure MapEtoA(s) + return map(s, _Eascii(), &cset) +end + +procedure MapAtoE(s) + return map(s, &cset, _Eascii()) +end + +procedure Control(c) + return AsciiChar(iand(AsciiOrd(c),16r1f)) +end diff --git a/ipl/packs/tcll1/escape.icn b/ipl/packs/tcll1/escape.icn new file mode 100644 index 0000000..b8f2197 --- /dev/null +++ b/ipl/packs/tcll1/escape.icn @@ -0,0 +1,93 @@ +############################################################################ +# +# File: escape.icn +# +# Subject: Procedures to interpret Icon literal escapes +# +# Authors: William H. Mitchell; modified by Ralph E. Griswold and +# Alan Beale +# +# Date: April 16, 1993 +# +############################################################################ +# +# The procedure escape(s) produces a string in which Icon quoted +# literal escape conventions in s are replaced by the corresponding +# characters. For example, escape("\\143\\141\\164") produces the +# string "cat". +# +############################################################################ +# +# Links: ebcdic +# +############################################################################ + +link ebcdic + +procedure escape(s) + local ns, c + + ns := "" + s ? { + while ns ||:= tab(upto('\\')) do { + move(1) + ns ||:= case map(c := move(1)) | fail of { # trailing \ illegal + "b": "\b" + "d": "\d" + "e": "\e" + "f": "\f" + "l": "\n" + "n": "\n" + "r": "\r" + "t": "\t" + "v": "\v" + "x": hexcode() + "^": ctrlcode() + !"01234567": octcode() + default: c # takes care of ", ', and \ + } + } + return ns || tab(0) + } + +end + +procedure hexcode() + local i, s + + s := tab(many('0123456789ABCDEFabcdef')) | "" # get hex digits + + if (i := *s) > 2 then { # if too many digits, back off + s := s[1:3] + move(*s - i) + } + + return char("16r" || s) + +end + +procedure octcode() + local i, s + + move(-1) # put back first octal digit + s := tab(many('01234567')) | "" # get octal digits + + i := *s + if (i := *s) > 3 then { # back off if too large + s := s[1:4] + move(*s - i) + } + if s > 377 then { # still could be too large + s := s[1:3] + move(-1) + } + + return char("8r" || s) + +end + +procedure ctrlcode(s) + + return Control(move(1)) + +end diff --git a/ipl/packs/tcll1/euler.grm b/ipl/packs/tcll1/euler.grm new file mode 100644 index 0000000..4c679de --- /dev/null +++ b/ipl/packs/tcll1/euler.grm @@ -0,0 +1,98 @@ +start : program . +program = block ENDPROG!. +vardecl = new id NEWDECL! . +fordecl = formal id FORMALDECL! . +labdecl = label id LABELDECL! . +var = id VARID! { "[" expr "]" SUBSCR! | "." DOT! } . +logval = true LOGVALTRUE! . +logval = false LOGVALFALSE! . +number = realN | integerN. +reference = "@" var REFERENCE! . +# listhead -> "(" LISTHD1! +# listhead -> listhead expr "," LISTHD2! +# listN -> listhead ")" LISTN1! +# listN -> listhead expr ")" LISTN2! +listN = "(" LISTHD1! ( ")" LISTN1! | expr listTl ) . +listTl = ")" LISTN2! | "," LISTHD2! ( expr listTl | ")" LISTN1! ) . +prochead = "'" PROCHD! { fordecl ";" PROCFORDECL! } . +procdef = prochead expr "'" PROCDEF! . +primary = var ( listN CALL! | VALUE!) | primary1 . +primary1 = logval LOADLOGVAL! | number LOADNUM! | + symbol LOADSYMB!| reference | + listN | tail primary UOP! | procdef | + undef LOADUNDEF! | "[" expr "]" PARENS! | in INPUT! | + isb var UOP! | isn var UOP! | isr var UOP! | + isl var UOP! | isli var UOP! | isy var UOP! | + isp var UOP! | isu var UOP! | abs primary UOP! | + length var UOP! | integer primary UOP! | + real primary UOP! | logical primary UOP! | list primary UOP! . +factor = primary factortail. +factortail = { "**" primary BOP! } . +term = factor termtail. +termtail = { "*" factor BOP! | "/" factor BOP! | + div factor BOP! | mod factor BOP! } . +sum = ("+" term UPLUS! | "-" term NEG! | term) sumtail. +sumtail = { "+" term BOP! | "-" term BOP! } . +choice = sum choicetail. +choicetail = { min sum BOP! | max sum BOP! } . + +relation = choice relationtail. +relationtail = [ "=" choice BOP! | "~=" choice BOP! + | "<" choice BOP! | "<=" choice BOP! + | ">" choice BOP! | ">=" choice BOP! ] . + +negation = "~" relation UOP! | relation . +conj = negation conjtail. +conjtail = [ and CONJHD! conj CONJ! ]. +disj = conj disjtail. +disjtail = [ or DISJHD! disj DISJ! ] . +catenatail = { "&" primary BOP! }. + +truepart = expr else TRUEPT! . +ifclause = if expr then IFCLSE! . + +expr = var exprtail | expr1. +exprtail = "<-" expr BOP! | + ( listN CALL! | VALUE!) + factortail + termtail + sumtail + choicetail + relationtail + conjtail + disjtail + catenatail . + +expr1 = block . +expr1 = ifclause truepart expr IFEXPR! . +expr1 = goto primary UOP! . +expr1 = out expr UOP! . +expr1 = primary1 + factortail + termtail + sumtail + choicetail + relationtail + conjtail + disjtail + catenatail . + +expr1 = ( "+" term UPLUS! | "-" term NEG! ) + sumtail + choicetail + relationtail + conjtail + disjtail + catenatail . + +expr1 = "~" relation UOP! conjtail disjtail catenatail . + + +stat = expr1 + | id ( ":" LABDEF! stat LABSTMT! + | VARID! { "[" expr "]" SUBSCR! | "." DOT! } + exprtail ) . + +block = begin BEGIN! + { vardecl ";" BLKHD! | labdecl ";" BLKHD!} + stat { ";" BLKBODY! stat } end BLK! . diff --git a/ipl/packs/tcll1/fp.grm b/ipl/packs/tcll1/fp.grm new file mode 100644 index 0000000..30fd748 --- /dev/null +++ b/ipl/packs/tcll1/fp.grm @@ -0,0 +1,34 @@ +start : fpProg. +fpProg = { def | aplExp}. +def = DEF ident "=" fnExp DEFN!. +def = VAL ident "=" fnExp ":" obj VALU!. +aplExp = fnExp ":" obj APPL!. +fnExp = fnComp [ "->" fnComp ";" fnExp COND!] + | while func fnExp WHILE! + . +fnComp = func { "." func COMP!}. +func = ident FNID! + | ( "+" | "-" | "*" + | "=" | "~=" + | "<" | ">" | ">=" "<=" ) FNID! + | selector SEL! + | bu func obj BU! + | "/" func INSERT! + | "@" func ALL! + | "(" fnExp ")" PARENS! + | "[" ( fnExpList | EMPTYCONS! ) "]" CONS! + | literal + . +selector = signedInt. +fnExpList = fnExp CONS1! { "," fnExp CONSNEXT! }. +literal = "'" obj CONST! + | string STRCONST! + . +obj = atom + | "<" objList ">" OBJL! + . +objList = obj OBJ1! { "," obj OBJLNEXT! } | EMPTYOBJL! . +atom = signedInt INTOBJ! | signedFloat FLOATOBJ! + | string STRINGOBJ! | ident OBJID! + . +fiducials: ":" "->" ";" "]" ")" ">". diff --git a/ipl/packs/tcll1/gramanal.icn b/ipl/packs/tcll1/gramanal.icn new file mode 100644 index 0000000..c8349f1 --- /dev/null +++ b/ipl/packs/tcll1/gramanal.icn @@ -0,0 +1,573 @@ +# GRAMANAL.ICN +# +# LL(1)/LL(k) parser generator in Icon +# written by Dr. Thomas W. Christopher +# +# generally useful grammar analysis routines + +# symbId is a string + +record Symbol( + name, # symbId + kind, # string in + # { "Nonterminal","Terminal","ActionSymbol"} + minLeng)# integer, length of shortest terminal string + # that can be derived from this nonterminal +record Production( + lhs, # Symbol, left hand side + rhs, # [ Symbol, ... ], right hand side + minLeng) # minimum length of terminal string derivable from + # lhs using this production + +global symbol #table:symbId->Symbol +global first #table:Symbol->set(Symbol) +global last #table:Symbol->set(Symbol) +global follow #table:Symbol->set(Symbol) +global productions #table:Symbol->[Production,...] +global selectionSet #table:Production->Set(Symbol) + # set of symbols that choose this production + # if lhs is atop the stack +global nonterminals #set(Symbol) +global terminals #set(Symbol) +global actions #set(Symbol) +global startSymbol #Symbol +global eoiSymbol #Symbol, end of input +global errorFile #file +global errorCount #integer +global warningCount #integer +global tooLong #integer, too long for a sentence +global defaultStartName #string, default name of start symbol + +####################################################################### +# +# calls to create grammars +# + +procedure initGrammar(out) +symbol := table() +first := table() +last := table() +follow := table() +productions := table() +selectionSet := table() +nonterminals := set() +terminals := set() +actions := set() +fiducials := set() +startSymbol := &null +eoiSymbol := Symbol("EOI","Terminal") +symbol["EOI"] := eoiSymbol +errorFile := \out | &output +errorCount := warningCount := 0 +tooLong := 10000 +defaultStartName := "start" +return +end + +procedure error(e[]) +errorCount +:= 1 +writes(errorFile,"Error: ") +every writes(!e) +write() +end + +procedure warning(e[]) +warningCount +:= 1 +writes(errorFile,"Warning: ") +every writes(!e) +write() +end + +procedure declareProduction(lhs,rhs) +# lhs: symbId +# rhs: [symbId,...] +local n, #Symbol, the left hand side + r, #[Symbol,...], the right hand side + s #symbId, name of rhs element +if /symbol[lhs] then { + n := symbol[lhs] := Symbol(lhs,"Nonterminal") + insert(nonterminals,n) +} else { + n := symbol[lhs] + /n.kind := "Nonterminal" + if n.kind ~==="Nonterminal" then { + error(lhs||" is both nonterminal and "||n.kind) + fail + } +} +r := [] +every s := !rhs do { + /symbol[s] := Symbol(s) + put(r,symbol[s]) +} +/productions[n] := [] +put(productions[n],Production(n,r)) +return +end + +procedure declareAction(s) +local t +/symbol[s] := Symbol(s) +t := symbol[s] +/t.kind := "ActionSymbol" +if t.kind ~== "ActionSymbol" then { + error(t.kind||" "||s||" being declared an ActionSymbol") + fail +} +insert(actions,t) +return +end + +procedure declareStartSymbol(s) +local n +if \startSymbol then { + error( + "attempt to redeclare start symbol from "|| + startSymbol.name|| + " to "|| + s) + fail +} +if n := \symbol[s] then { + /n.kind := "Nonterminal" + if n.kind ~== "Nonterminal" then { + error( "attempt to declare " || + n.kind || " " || + s || " as start symbol") + fail + } + startSymbol := n + return +} +startSymbol := Symbol(s,"Nonterminal") +symbol[s] := startSymbol +insert(nonterminals,startSymbol) +/productions[startSymbol] := [] +return +end + +procedure declareEOI(s) +local eoi +if eoiSymbol.name == s then return +if \symbol[s] then { + error( + "attempt to redeclare "|| + symbol[s].kind||" "|| + s||" as EOI symbol") + fail +} +remove(symbol,eoiSymbol.name) +eoiSymbol.name := s +symbol[s] := eoiSymbol +return +end + +procedure finishDeclarations() +local s #Symbol + +insert(terminals,eoiSymbol) + +#what if no start symbol specified? Create one. +if /startSymbol then { + declareStartSymbol(defaultStartName) +} + +every s := !symbol do + case s.kind of { + &null : { + s.kind := "Terminal" + insert(terminals,s) + s.minLeng := 1 + } + "Terminal": { + s.minLeng := 1 + insert(terminals,s) + } + "ActionSymbol": { + s.minLeng := 0 + insert(actions,s) + } + "Nonterminal": { + s.minLeng := tooLong + insert(nonterminals,s) + } + } +return +end + +####################################################################### +# +# local utility procedures +# + +# succeed returning s if s is a null-deriving symbol +# (only valid after execution of findMinLeng() ) +# +procedure isNullDeriving(s) +if s.minLeng <= 0 then return s else fail +end + +# succeed returning symbol s only if s is the specified type of symbol +procedure isNonterminal(s) +return member(nonterminals,s) #returning s +end + +procedure isTerminal(s) +return member(terminals,s) #returning s +end + +procedure isActionSymbol(s) +return member(actions,s) #returning s +end + +####################################################################### +# +#debugging & output routines +# + +procedure writeIndented(s,i,l,b) +# write string s, indenting by i positions any overflow lines, +# breaking after characters in set b (if practical), with overall +# line length l +# +local j,k,r,h +/l := 72 #default line length +/i := 8 #default indent +if /b := ' \t' #default break set--white space + then l+:=1 +r := l - i #remaining length after indent +if r <= 1 then fail +#cut off initial i chars (or all of string if it's short): +s ?:= (h := tab(i+1 | 0) & tab(0)) +repeat { + # find a position j at which to cut the line: + j := -1 + if *s>r then {s ? every k := upto(b) & k <= r & j := k} + write(h,s[1:j+1]) + s := s[j+1:0] + if *s = 0 then break + h := repl(" ",i) +} +return +end + +procedure symbolToString(s) +static nonIdChars +initial nonIdChars:=~(&letters++&digits++'_') +return if upto(nonIdChars,s) then "\"" || s || "\"" else s +end + +procedure productionToString(p) +local s +s := symbolToString(p.lhs.name) || " =" +every s ||:= " " || symbolToString((!p.rhs).name) +return s||"." +end + +procedure showProductions() +local p,S,n,i +write() +write("Productions:") +write("start:",startSymbol.name,", EOI:",eoiSymbol.name) +S:=table() +every n:=!nonterminals do S[n.name]:=n +S:=sort(S,1) +every i:=1 to *S do S[i]:=S[i][2] +every p := !productions[!S] do { + writeIndented(productionToString(p)) +} +return +end + +procedure showSymbol(s) + write(s.name,": ",\s.kind|"Type undefined", + ", minLeng=",\s.minLeng|"Undefined") +return +end + +procedure showSymbols() +local s +write() +write("Symbols:") +every s := !symbol do { + showSymbol(s) +} + +return +end + +procedure showSymbolSet(prefix,s) +local t, i, L +t:=set() +every insert(t,(!s).name) +L:=sort(t) +prefix ||:= "{" +every i := 1 to *L-1 do prefix ||:= symbolToString(L[i]) || ", " +prefix ||:= symbolToString(L[-1]) +prefix ||:= "}" +writeIndented(prefix) + +return +end + +procedure showSelectionSets() +local p,s,L +write() +write("selection sets:") +L := sort(selectionSet,3) +while p:=get(L) & s:=get(L) do { + showSymbolSet("selection[ "||productionToString(p)||" ] = ",s) +} +return +end + +procedure showSymbolSets(setName,s) +local n,st,L +L := sort(s,3) +write() +write(setName," sets:") +while n := get(L) & st := get(L) do { + showSymbolSet(n.name||"=",st) +} +return +end + +procedure showFirstSets() +showSymbolSets("first",first) +return +end + +procedure showLastSets() +showSymbolSets("last",last) +return +end + +procedure showFollowSets() +showSymbolSets("follow",follow) +return +end + +####################################################################### +# +# Grammar analysis +# + +# compute the min lengths of terminal strings that can be derived +# from nonterminals and starting from particular productions. +# +procedure findMinLeng() +local n, ns, p, s, changes, leng + +every ns:=!symbol do case ns.kind of { + "Nonterminal": ns.minLeng := tooLong + "Terminal": ns.minLeng := 1 + "ActionSymbol": ns.minLeng := 0 + } +every p := !!productions do p.minLeng := tooLong +### showSymbols() #### +changes := 1 +while \changes do { + changes := &null + every n := !nonterminals do { + every p := !productions[n] do { + leng := 0 + every s := !p.rhs do { + leng +:= s.minLeng + } + p.minLeng := leng + ### showSymbol(n) ### + if n.minLeng > leng then { + changes := 1 + n.minLeng := leng + } + } + } +} +return +end + +procedure checkMinLeng() + local n + every n := !nonterminals & n.minLeng >= tooLong do { + error(n.name," does not appear to derive a terminal string") + } + return +end + +# +# compute transitive closure of a relation +# +procedure transitiveClosure(s) +local n,r,i,k + +every k := key(s) & + i := key(s) & + member(s[i],k) + do { + s[i] ++:= s[k] +} +return +end + +# +# generate exposed symbols on rhs or in string +# "exposed" means preceded (Left) or followed (Right) +# by nullable nonterminal or action symbols +# includes all symbols, nonterminal, terminal and action +# +procedure exposedLeft(p) + local s + case type(p) of { +"Symbol": p:=[p] +"Production": p:=p.rhs + } + every s := !p do { + suspend s + if not isNullDeriving(s) then fail + } + fail +end + +procedure exposedRight(p) + local s + case type(p) of { +"Symbol": p:=[p] +"Production": p:=p.rhs + } + every s := p[*p to 1 by -1] do { + suspend s + if not isNullDeriving(s) then fail + } + fail +end + +# +# Compute Accessible Sets +# + +procedure buildInitialAccessibleSets() +local p, r, s + +s:=table() +every s[!nonterminals] := set() +every p := !!productions do { + every r := !p.rhs do { + insert(s[p.lhs],r) + } +} +return s +end + +procedure findAccessibleSets() +local s +s := buildInitialAccessibleSets() +transitiveClosure(s) +return s +end + +procedure findAccessibleSymbols() + local st,a + a := findAccessibleSets() + st := a[startSymbol] + insert(st,startSymbol) + insert(st,eoiSymbol) + return st +end + +procedure checkAccessibility() + local s,st + st := findAccessibleSymbols() + every s := !(nonterminals|terminals|actions) do { + if not member(st,s) then + error(s.name, + " cannot appear in a sentential form") + } + return +end + +# +# Compute First Sets +# + +procedure initFirstSets() +local p, r + +first := table() +every first[!nonterminals] := set() + +every p := !!productions do { + every r := exposedLeft(p) do { + insert(first[p.lhs],r) + } +} +return +end + +procedure findFirstSets() +initFirstSets() +transitiveClosure(first) +return +end + +# +# Compute last sets +# +procedure initLastSets() +local p, r + +last:=table() +every last[!nonterminals] := set() + +every p := !!productions do { + every r := exposedRight(p) do { + insert(last[p.lhs],r) + } +} +return +end + +procedure findLastSets() +initLastSets() +transitiveClosure(last) +return +end + +procedure checkLnRRecursive() + local n + every n:= !nonterminals do { + if member(first[n],n) & member(last[n],n) then { + error(n.name," is both left and right recursive,", + " the grammar is ambiguous") + } + } + return +end + +procedure findFollowSets() +local n, p, rhs, x, y, i, j + +follow := table() + +every n := !nonterminals do follow[n] := set() + +every p := !productions[!nonterminals] & + rhs := p.rhs & *rhs>1 + do { + every x := rhs[i:=1 to *rhs-1] & isNonterminal(x) do { + every y := rhs[j:=i+1 to *rhs] do { + every + insert( + follow[x|isNonterminal(!last[x])], + isTerminal(y|!\first[y]) + ) + if not isNullDeriving(y) then break #back to "every x" loop + } + } +} +every insert( + follow[isNonterminal(startSymbol|!last[startSymbol])], + eoiSymbol + ) +return +end + diff --git a/ipl/packs/tcll1/if_ll1.grm b/ipl/packs/tcll1/if_ll1.grm new file mode 100644 index 0000000..50a0679 --- /dev/null +++ b/ipl/packs/tcll1/if_ll1.grm @@ -0,0 +1,6 @@ +# if-ll1 +# still not really LL(1), but as close as we can get +start = statement . +statement = if e then statement else_option + | i "=" e. +else_option = [ else statement ]. diff --git a/ipl/packs/tcll1/if_nll1.grm b/ipl/packs/tcll1/if_nll1.grm new file mode 100644 index 0000000..0e74101 --- /dev/null +++ b/ipl/packs/tcll1/if_nll1.grm @@ -0,0 +1,8 @@ +# if-nll1 +# not LL(1) +start = statement . +statement = if e then statement + | if e then statement else statement + | i "=" e. + + diff --git a/ipl/packs/tcll1/ll1.icn b/ipl/packs/tcll1/ll1.icn new file mode 100644 index 0000000..65f97e9 --- /dev/null +++ b/ipl/packs/tcll1/ll1.icn @@ -0,0 +1,279 @@ + +link gramanal +link xcode + +global outFile + +global fiducials #set(Symbol) +global selectionSet #table:Production->Set(Symbol) + # set of symbols that choose this production + # if lhs is atop the stack + +# +# +# +procedure analyzeGrammar() + +findMinLeng() +checkMinLeng() +checkAccessibility() +findFirstSets() +findLastSets() +checkLnRRecursive() +findFollowSets() + +end + +procedure declareFiducial(s) +local t +/symbol[s] := Symbol(s) +t := symbol[s] +/t.kind := "Terminal" +if t.kind ~== "Terminal" then { + error(t.kind," ",s," being declared a fiducial") + fail +} +insert(fiducials,t) +return +end + +procedure findSelectionSets() +local p,r,s,t +every p:=!!productions do { + s:= set() + every r := exposedLeft(p) do { + if isNonterminal(r) then { + s ++:= first[r] + } else if isTerminal(r) then { + insert(s,r) + } + } + if p.minLeng=0 then s ++:= follow[p.lhs] + every t := !s & not isTerminal(t) do delete(s,t) + selectionSet[p] := s +} +return +end + +procedure ll1(outFileName) +local t,g + +analyzeGrammar() +findSelectionSets() + +testLL1() + +if errorCount>0 then fail + +outFile := open(outFileName,"w") | + {error( "unable to open output file ",outFileName) + return} + +t:=genLL1() +#g:=encode(t) +#write(outFile,g) +xencode(t,outFile) +# +close(outFile) +return + +end + +procedure testLL1() + +local n, plist, p1, p2, px, py, m, i, s + +#check for left recursion + +every n := !nonterminals do + if member(first[n],n) then + error(n.name," is left recursive, the grammar is not LL(1)") + +#check for overlapping selection sets + +every n := !nonterminals do { + plist := productions[n] + m := *plist + every p1 := plist[i:=1 to m-1] & + p2 := plist[i+1 to m] do { + if p1.minLeng = p2.minLeng = 0 then { + error("productions\n1.\t", + productionToString(p1),"\n2.\t", + productionToString(p2), + "\nboth derive the empty string" ) + } else if *(s:=selectionSet[p1]**selectionSet[p2]) > 0 then { + if (p1.minLeng = 0) | (p2.minLeng = 0) then { + px:=p1; py:=p2; if px.minLeng=0 then px:=:py + warning("overlapping selection sets for\n\t", + productionToString(px), + "\nand empty-deriving production\n\t", + productionToString(py) ) + } else { + error("overlapping selection sets for\n1.\t", + productionToString(p1),"\n2.\t", + productionToString(p2) ) + } + showSymbolSet(" overlap: ",s) + } + } +} +return +end + +procedure genLL1() +local mapSymbol, + rhsList, + mapRHS, + emptyRHS, + sel, + deflt, + firstFiduc, + fiducList, + actionList, + termList, + minLengRHS +local s,p,r,L,n,m,mr,ml,ms,nullrhs,t,i +# build encapsulated symbols, [ name ], so that all references +# to the symbol can share the same string +mapSymbol := table() +every s := !symbol do { + mapSymbol[s] := [s.name] +} +# map productions into right hand side lists with encapsulated symbols +emptyRHS:=list() +mapRHS := table() +every p := !!productions do { + L:=list() + every s:= !p.rhs do put(L,mapSymbol[s]) + mapRHS[p] := if *L = 0 then emptyRHS else L +} +#make a list of all right hand sides +# the list will be used after input to remove the symbols +# from their encapsulating lists +rhsList:=[] +every L:=!mapRHS do put(rhsList,L) + +#create selection and default tables +sel:=table() +deflt:=table() +every n:=!nonterminals do { + + # Build a list of productions for the nonterminal sorted by + # cardinality of selection set. Reserve a production with an + # empty-string-deriving RHS for special treatment. Put the + # productions into the sel table, but reserve the empty-deriving + # RHS or, if none, then the RHS with the largest selection set to + # be the default. If there is an overlap in selection sets between + # a non-empty-deriving and the empty-deriving RHS, then this will + # give precedence to the non-empty-deriving RHS, as is required to + # solve the "dangling else problem." + + nullrhs:=&null + t:=table() #map productions into cardinality of selection set + every p:=!productions[n] do + if p.minLeng=0 + then nullrhs:=p + else t[p] := *selectionSet[p] + L:=sort(t,2) + put(L,[\nullrhs,*selectionSet[nullrhs]]) + if *L = 1 then { + deflt[mapSymbol[n]] := mapRHS[L[1][1]] + } else { + /sel[mapSymbol[n]] := table() + # if there is an empty-deriving RHS then put all other + # RHS's into sel table--the empty-deriving one will be + # the default. Or, if the largest selection set + # for any RHS is small enough, then put all RHS's into + # selection table. Otherwise, reserve the RHS with the + # largest selection set to be the default. + m := if /nullrhs & L[*L][2] < 5 then *L else *L-1 + every i := 1 to m & + p := L[i][1] & + mr := mapRHS[p] & + ml := mapSymbol[p.lhs] & + ms := mapSymbol[!selectionSet[p]] do { + sel[ml][ms] := mr + } + # If not included already, handle the last. + if m~=*L then deflt[mapSymbol[n]]:=mapRHS[L[*L][1]] + } +} + +termList := list() +every s:=!terminals do put(termList,mapSymbol[s]) + +actionList := list() +every put(actionList,mapSymbol[!actions]) + +fiducList := list() +insert(fiducials,eoiSymbol) +every put(fiducList,mapSymbol[!fiducials]) + +firstFiduc := table() +every n:=!nonterminals & *(s:=first[n]**fiducials)>0 do { + firstFiduc[mapSymbol[n]] := list() + every put(firstFiduc[mapSymbol[n]], + mapSymbol[!s]) +} + +minLengRHS := table() +every n := !nonterminals do { + p := productions[n][1] + every r := !productions[n] & + p.minLeng > r.minLeng do p:=r + minLengRHS[mapSymbol[n]] := mapRHS[p] +} + +return [ + rhsList, + sel, + deflt, + termList, + actionList, + fiducList, + firstFiduc, + minLengRHS, + mapSymbol[startSymbol], + mapSymbol[eoiSymbol] + ] +end + + +####################################################################### +# +# printing the grammar +# +procedure printGrammar() +local n,p,st,s +write("start symbol:\t",startSymbol.name) +write("EOI symbol:\t",eoiSymbol.name) +write() +showSymbolSet("terminal symbols: ",terminals) + +write() +showSymbolSet("fiducial symbols: ",fiducials) + +write() +showSymbolSet("action symbols: ",actions) + +write() +write("nonterminal symbols:") +st := set() +every insert(st,(!nonterminals).name) +st := sort(st) +every n := !st do { + s := symbol[n] + write(" ",n,":") + showSymbolSet(" first set: ",first[s]) + showSymbolSet(" follow set: ",follow[s]) + write() +} + +write("productions:") +every p := !productions[symbol[!st]] do { + writeIndented(productionToString(p)) + showSymbolSet(" : ",selectionSet[p]) +} +return +end + diff --git a/ipl/packs/tcll1/ls_ll1.grm b/ipl/packs/tcll1/ls_ll1.grm new file mode 100644 index 0000000..2c4fef8 --- /dev/null +++ b/ipl/packs/tcll1/ls_ll1.grm @@ -0,0 +1,23 @@ +# ls-ll1 +# LL(1) +start = labeled_statement . + +#labeled_statement = label statement . +#label = i ":" label | . +#statement = i "=" e. + +#labeled_statement = i ":" label statement . +#labeled_statement = statement . +#label = i ":" label | . +#statement = i "=" e. + +#labeled_statement = i ":" label statement . +#labeled_statement = i "=" e . +#label = i ":" label | . +#statement = i "=" e. + +labeled_statement = i labeled_statement_tail . +labeled_statement_tail = "=" e . +labeled_statement_tail = ":" labeled_statement . + + diff --git a/ipl/packs/tcll1/ls_nll1.grm b/ipl/packs/tcll1/ls_nll1.grm new file mode 100644 index 0000000..e8ad77f --- /dev/null +++ b/ipl/packs/tcll1/ls_nll1.grm @@ -0,0 +1,8 @@ +# ls-nll1 +# not LL(1) +start = labeled_statement . +labeled_statement = label statement . +label = { i ":" }. +statement = i "=" e. + + diff --git a/ipl/packs/tcll1/parsell1.icn b/ipl/packs/tcll1/parsell1.icn new file mode 100644 index 0000000..665118d --- /dev/null +++ b/ipl/packs/tcll1/parsell1.icn @@ -0,0 +1,71 @@ +# parse using tables produced by tcLL1 +# (written by Dr. Thomas W. Christopher) +# +record Token(type,body,line,column) + +link readll1 + +procedure parseLL1(ll1) +local predictionStack +local x,y,z,top,cur,errLine,errColumn + predictionStack:=[ll1.start,ll1.eoi] + cur := &null +repeat { + if not(top := pop(predictionStack)) then return + while member(ll1.actions,top) do { + outAction(top) + if not(top := pop(predictionStack)) then return + } + /cur := scan() + if top == cur.type then { + outToken(cur) + cur:=&null + if top == ll1.eoi then break + } else if x:=\ll1.sel[top] & y:=\x[cur.type] then { + every z:=y[*y to 1 by -1] do push(predictionStack,z) + } else if y:=\ll1.deflt[top] then { + every z:=y[*y to 1 by -1] do push(predictionStack,z) + } else { + #panic mode error recovery + reportParseError(cur) + errLine:=cur.line + errColumn:=cur.column + push(predictionStack,top) + repeat { + while not member(ll1.fiducials,cur.type) & + cur.type~==ll1.eoi do { + #write("scanning past ",cur.body) + cur := scan() + } + if x:=!predictionStack & + (x==cur.type) | + member(\ll1.firstFiducials[x], cur.type) + then break + else cur := scan() + } + repeat { + top := pop(predictionStack) | + stop("system error in panic mode") + #write("pruning stack ",top) + if top==cur.type then { + push(predictionStack,top) + break + } + if member(ll1.actions,top) then { + outAction(top) + } else if member(ll1.terminals,top) then { + outError(top,errLine,errColumn) + } else if member(\ll1.firstFiducials[top],cur.type) + then { + push(predictionStack,top) + break + } else { + predictionStack := ll1.minLengRHS[top] ||| + predictionStack + } + } + } +} +return +end + diff --git a/ipl/packs/tcll1/readll1.icn b/ipl/packs/tcll1/readll1.icn new file mode 100644 index 0000000..b1f42b0 --- /dev/null +++ b/ipl/packs/tcll1/readll1.icn @@ -0,0 +1,140 @@ +# Read in parse tables produced by TCLL1 +# (written by Thomas W. Christopher) +# +link xcode #xcode is provided by the Icon Programming Library +invocable all + +record LL1(sel,deflt, + terminals,actions, + fiducials,firstFiducials, + minLengRHS, + start,eoi) + +procedure readLL1(filename) +local g,s,f +f:=open(filename) | fail +s:=xdecode(f) | fail +g:=unpackLL1(s) +close(f) +return g +end + +procedure unpackLL1(h) +local startSymbol, + eoiSymbol, + rhsList, + selIn, + defltIn, + termList, + actionList, + fiducList, + firstFiduc, + minLengRhs + +local r,i,n,t,s, + actionSet,terminalSet, + defaultTable,selTable, + fiducialSet,firstFiducials, + minLengRHS + +# the following must be in the same order they were listed in +# return statement of genLL1() in module "ll1.icn". With the +# exception of rhsList, they are in the same order as in record +# LL1. + +rhsList := get(h) +selIn := get(h) +defltIn := get(h) +termList:= get(h) +actionList:=get(h) +fiducList:=get(h) +firstFiduc:=get(h) +minLengRhs:=get(h) +startSymbol := get(h)[1] +eoiSymbol := get(h)[1] + +every r:= !rhsList & i := 1 to *r do r[i]:=r[i][1] + +actionSet:=set() +every insert(actionSet,(!actionList)[1]) +terminalSet:=set() +every insert(terminalSet,(!termList)[1]) +defaultTable:=table() +every n:=key(defltIn) do defaultTable[n[1]]:=defltIn[n] +selTable:=table() +every n:=key(selIn) do { + /selTable[n[1]] := t := table() + every s:= key(selIn[n]) do { + t[s[1]] := selIn[n][s] + } +} +fiducialSet:=set() +every insert(fiducialSet,(!fiducList)[1]) +firstFiducials:=table() +every n:=key(firstFiduc) & + s:=firstFiduc[n] do { + firstFiducials[n[1]]:=set() + every insert(firstFiducials[n[1]],(!s)[1]) +} +minLengRHS:=table() +every n:=key(minLengRhs) do + minLengRHS[n[1]]:=minLengRhs[n] + +return LL1(selTable,defaultTable, + terminalSet,actionSet, + fiducialSet,firstFiducials, + minLengRHS, + startSymbol,eoiSymbol) + +end + +procedure showStructure(h, indent) +local t,i +/indent:="" +i := indent||" " +case type(h) of { +"string": write(indent,"\"",h,"\"") +"list": {write(indent,"[") + every showStructure(!h,i) + write(indent,"]") + } +"table":{write(indent,"table") + t := sort(h,3) + while showStructure(get(t),i) do { + write(indent,"->") + showStructure(get(t),i) + write(indent,"---") + } + write(indent,"end table") + } +"set": {write(indent,"{") + every showStructure(!h,i) + write(indent,"}") + } +} +return +end + +procedure showLL1(g) +write("start symbol") +showStructure( g.start) +write("eoi symbol") +showStructure( g.eoi) +write("action set") +showStructure( g.actions) +write("terminal set") +showStructure( g.terminals) +write("default table") +showStructure( g.deflt) +write("selection table") +showStructure( g.sel) +write("fiducial set") +showStructure( g.fiducials) +write("first fiducials") +showStructure( g.firstFiducials) +write("minimum length RHSs") +showStructure( g.minLengRHS) +return +end + + diff --git a/ipl/packs/tcll1/rptperr.icn b/ipl/packs/tcll1/rptperr.icn new file mode 100644 index 0000000..316388b --- /dev/null +++ b/ipl/packs/tcll1/rptperr.icn @@ -0,0 +1,12 @@ +# +# this is a minimal version of the error reporting procedure +# needed by the parser +# + +procedure reportParseError(t) +write(&errout,"error: unexpected input ",t.body, + " at line ",t.line," column ",t.column) +return +end + + diff --git a/ipl/packs/tcll1/scangram.icn b/ipl/packs/tcll1/scangram.icn new file mode 100644 index 0000000..540d758 --- /dev/null +++ b/ipl/packs/tcll1/scangram.icn @@ -0,0 +1,85 @@ +# Scanner for the input language used by TCLL1, +# an LL(1) parser generator). +# (written by Dr. Thomas W. Christopher) +# +global inputFile +global inputLine,inputLineNumber,inputColumn,eoiToken +global tokenTypes + +procedure initScanner(filename) +inputFile := open(filename,"r") | fail +return +end + +procedure scan() +local t,c,b +static whiteSpace,initIdChars,idChars +initial { + /inputFile:=&input + inputLineNumber:=0 + inputColumn:=1 + inputLine:="" + eoiToken:=&null + whiteSpace:=&ascii[1:34] #control ++ blank + initIdChars := &letters ++ '_' + idChars := &letters ++ &digits ++ '_' + tokenTypes := table() + t := [ ".","DOT", + ":","COLON", + "=","EQ", + "|","BAR", + "(","LPAR", + ")","RPAR", + "[","LBRACK", + "]","RBRACK", + "{","LBRACE", + "}","RBRACE", + "!","BANG"] + while tokenTypes[get(t)] := get(t) +} +if \eoiToken then return eoiToken +repeat inputLine ? { + tab(inputColumn) + tab(many(whiteSpace)) + c := &pos + if any(initIdChars) then { + t := Token("ID",tab(many(idChars)), + inputLineNumber,c) + inputColumn := &pos + return t + } else + if b := tab(any('.:=()[]{}|!')) then { + inputColumn := &pos + return Token(tokenTypes[b],b,inputLineNumber,c) + } else + if ="#" | pos(0) then { + inputColumn := 1 + inputLineNumber +:= 1 + if not (inputLine := read(inputFile)) then { + eoiToken := Token("EOI","EOI", + inputLineNumber,1) + return eoiToken + } + } else + if ="\"" then { + if t := Token("ID",tab(find("\"")), + inputLineNumber,c) then { + move(1) + } else { + write("unterminated quote at ", + inputLineNumber," ",c) + t:=Token("ID",tab(many(~whiteSpace)), + inputLineNumber,c) + } + inputColumn := &pos + return t + } else + { + write("unexpected character: ",move(1), + " at ",inputLineNumber," ",c) + inputColumn := &pos + } +} +end + + diff --git a/ipl/packs/tcll1/semgram.icn b/ipl/packs/tcll1/semgram.icn new file mode 100644 index 0000000..e07c21b --- /dev/null +++ b/ipl/packs/tcll1/semgram.icn @@ -0,0 +1,126 @@ +# Semantics routines called while parsing the input +# grammar to TCLL1. +# (written by Thomas W. Christopher) + +procedure FirstAlt() +push(semanticsStack,[pop(semanticsStack)]) +return +end + +procedure NextAlt() +local r +r:=pop(semanticsStack) +pop(semanticsStack) # | +put(semanticsStack[1],r) +return +end + +procedure DeclAction() +pop(semanticsStack) # ! +declareAction(semanticsStack[1].body) +return +end + +#procedure edit_rhs(rhs) +#local s +#r:=[] +#every s:=!rhs do put(r,s.body) +#return +#end + +global lhsymb + +procedure DeclProduction() +local i,a,r +pop(semanticsStack) # . +a:=pop(semanticsStack) +pop(semanticsStack) # = +i:=pop(semanticsStack) +every r := !a do declareProduction(i,r) +return +end + + +procedure Group() +local a,lp,lhs,r +pop(semanticsStack) +a:=pop(semanticsStack) +lp:=pop(semanticsStack) + +lhs:=lhsymb||"_"||lp.line||"_"||lp.column +every r := !a do declareProduction(lhs,r) +push(semanticsStack,Token("ID",lhs,lp.line,lp.column)) +return +end + +procedure Option() +local a,lp,lhs,r +pop(semanticsStack) +a:=pop(semanticsStack) +lp:=pop(semanticsStack) + +lhs:=lhsymb||"_"||lp.line||"_"||lp.column +every r := !a do declareProduction(lhs,r) +declareProduction(lhs,[]) +push(semanticsStack,Token("ID",lhs,lp.line,lp.column)) +return +end + +procedure Repeat() +local a,lp,lhs,r +pop(semanticsStack) +a:=pop(semanticsStack) +lp:=pop(semanticsStack) + +lhs:=lhsymb||"_"||lp.line||"_"||lp.column +every r := !a do declareProduction(lhs,r|||[lhs]) +declareProduction(lhs,[]) +push(semanticsStack,Token("ID",lhs,lp.line,lp.column)) +return +end + +procedure StartRHS() +push(semanticsStack,[]) +return +end + +procedure ExtendRHS() +local s +s:=pop(semanticsStack).body +put(semanticsStack[1],s) +return +end + +procedure DeclLHS() +lhsymb:=pop(semanticsStack).body +push(semanticsStack,lhsymb) +return +end + +procedure DeclSymbols() +local l,r,s +pop(semanticsStack) # . +r := pop(semanticsStack) +pop(semanticsStack) # : +l := pop(semanticsStack) +map(l,&ucase,&lcase) ? + if ="s" then { + if not (="tart"&pos(0)) then + warning(l,"--\"start\" assumed") + declareStartSymbol(r[1]) + } else if ="e" then { + if not (="oi"&pos(0)) then + warning(l,"--\"EOI\" assumed") + declareEOI(r[1]) + } else if ="f" then { + if not (="iducial") then + warning(l,"--\"fiducials\" assumed") + every declareFiducial(!r) + } else if ="a" then { + if not (="ction") then + warning(l,"--\"actions\" assumed") + every declareAction(!r) + } else error(l,"--unknown declaration") +return +end + diff --git a/ipl/packs/tcll1/semout.icn b/ipl/packs/tcll1/semout.icn new file mode 100644 index 0000000..759e7da --- /dev/null +++ b/ipl/packs/tcll1/semout.icn @@ -0,0 +1,25 @@ +# Routines to test grammars passed through the TCLL1 +# parser generator. +# Link this with parseLL1 and it will write out the tokens +# and action symbols recognized by the parser. +# (written by Dr. Thomas W. Christopher) +# +procedure outToken(tok) +write(tok.type," ",tok.line," ",tok.column," ",tok.body) +return +end + +procedure outAction(a) +write(a) +return +end + +procedure outError(t) +write("ERROR: ",t) +return +end + +procedure initSemantics() +return +end + diff --git a/ipl/packs/tcll1/semstk.icn b/ipl/packs/tcll1/semstk.icn new file mode 100644 index 0000000..1197d8f --- /dev/null +++ b/ipl/packs/tcll1/semstk.icn @@ -0,0 +1,56 @@ +# Semantics stack manipulation routines to be called by +# parseLL1(...), the parser for the TCLL1 LL(1) parser +# generator. +# (written by Thomas W. Christopher) +# + +invocable all +global semanticsStack + +record ErrorToken(type,body,line,column) + +procedure initSemanticsStack() + semanticsStack:=[] +return +end + + +procedure outToken(tok) + push(semanticsStack,tok) +return +end + +procedure outAction(a) +a() +return +end + +procedure outError(t,l,c) +push(semanticsStack,ErrorToken(t,t,\l|0,\c|0)) +return +end + +procedure isError(v) + return type(v)=="ErrorToken" +end + +procedure popSem(n) +local V +V:=[] +every 1 to n do push(V,pop(semanticsStack)) +return V +end + +procedure pushSem(s) +push(semanticsStack,s) +return +end + +procedure anyError(V) +local v +if v:=!V & type(v)=="ErrorToken" then { + return v +} +fail +end + diff --git a/ipl/packs/tcll1/tcll1.grm b/ipl/packs/tcll1/tcll1.grm new file mode 100644 index 0000000..6ee31a1 --- /dev/null +++ b/ipl/packs/tcll1/tcll1.grm @@ -0,0 +1,14 @@ +# Grammar for tlcll1 parser generator +start = grammar. +grammar = { declaration }. +declaration = ID DeclLHS! ( COLON rhs DOT DeclSymbols! | + EQ alts DOT DeclProduction!). +rhs = StartRHS! {elem ExtendRHS!}. +alts = rhs FirstAlt! {BAR rhs NextAlt!}. +elem = ID bangOpt | + LPAR alts RPAR Group! | + LBRACE alts RBRACE Repeat! | + LBRACK alts RBRACK Option! . +bangOpt = [BANG DeclAction!]. +fiducials : DOT. + diff --git a/ipl/packs/tcll1/tcll1.icn b/ipl/packs/tcll1/tcll1.icn new file mode 100644 index 0000000..9541383 --- /dev/null +++ b/ipl/packs/tcll1/tcll1.icn @@ -0,0 +1,92 @@ +# TCLL1 -- an LL(1) parser generator +# Main program. +# (written by Dr. Thomas W. Christopher) +# + +link readll1,parsell1,scangram,semgram,semstk,gramanal,ll1 + +procedure main(L) +local filename,baseFilename,flags,filenameParts,gf + +flags := "" +if L[1][1]=="-" then { + flags := L[1] + filename := L[2] +} else { + filename:=L[1] +} +if /filename then + stop("usage: [iconx] tcll1 [flags] filename.grm") + +filenameParts:=fileSuffix(filename) +baseFilename:=filenameParts[1] +if filename==(baseFilename||".ll1") then + stop("would write output over input") +initScanner( filename | + (/filenameParts[2] & baseFilename||".grm")) | + stop("unable to open input: ",filename) + +initGrammar() +initSemanticsStack() + +gf:=findFileOnPATH("tcll1.ll1") | + stop("unable to find parser's grammar file: tcll1.ll1") +parseLL1(readLL1(gf)) | + stop("unable to read parser's grammar file: tcll1.ll1") + +finishDeclarations() +ll1(baseFilename||".ll1") +if find("p",flags) then printGrammar() +write(errorCount," error",(errorCount~=1&"s")|"", + " and ",warningCount," warning",(warningCount~=1&"s")|"") + +end + +# From: filename.icn in Icon Program Library +# Author: Robert J. Alexander, 5 Dec. 89 +# Modified: Thomas Christopher, 12 Oct. 94 + +procedure fileSuffix(s,separator) + local i + /separator := "." + i := *s + 1 + every i := find(separator,s) + return [s[1:i],s[(*s >= i) + 1:0] | &null] +end + +procedure findFileOnPATH(s) #adapted from DOPEN.ICN + local file, paths, path, filename + + if file := open(s) then { # look in current directory + close(file) + return s + } + + paths := getenv("PATH") | fail + + paths := map(paths,"\\;","/ ") #convert DOS to UNIX-style + s := "/" || s # platform-specific + + paths ? { + while path := tab(upto(' ') | 0) do { + if file := open(filename:=path || s) then { + close(file) + return filename + } + tab(many(' ')) | break + } + } + + fail +end + +# +# Error reporting required by parseLL1(): +# +procedure reportParseError(t) +error("unexpected input ",t.body, + " at line ",t.line," column ",t.column) +return +end + + diff --git a/ipl/packs/tcll1/tcll1.ll1 b/ipl/packs/tcll1/tcll1.ll1 new file mode 100644 index 0000000..6f348c7 --- /dev/null +++ b/ipl/packs/tcll1/tcll1.ll1 @@ -0,0 +1,297 @@ +L +N10 +L +N20 +L +N4 +L +N1 +"COLON" +L +7 +"rhs" +L +7 +"DOT" +L +7 +"DeclSymbols" +L +N3 +10 +L +7 +"FirstAlt" +L +7 +"alts_7_22" +L +N2 +L +7 +"BANG" +L +7 +"DeclAction" +L +22 +L +7 +"declaration" +L +7 +"grammar_3_12" +L +22 +L +7 +"StartRHS" +L +7 +"rhs_6_17" +L +16 +L +7 +"ID" +L +7 +"DeclLHS" +L +7 +"declaration_4_27" +L +5 +L +7 +"LPAR" +L +7 +"alts" +L +7 +"RPAR" +L +7 +"Group" +L +7 +L +7 +"bangOpt_12_11" +L +7 +31 +L +N0 +L +7 +L +7 +"grammar" +59 +L +5 +L +7 +"LBRACK" +48 +L +7 +"RBRACK" +L +7 +"Option" +L +5 +L +7 +"EQ" +48 +12 +L +7 +"DeclProduction" +L +22 +39 +L +7 +"bangOpt" +59 +59 +L +5 +L +7 +"BAR" +10 +L +7 +"NextAlt" +20 +L +16 +L +7 +"elem" +L +7 +"ExtendRHS" +36 +L +5 +L +7 +"LBRACE" +48 +L +7 +"RBRACE" +L +7 +"Repeat" +T +N6 + +43 +T +22 + +71 +70 +8 +6 +20 +T +7 + +79 +78 +84 +T +5 + +46 +45 +64 +63 +39 +75 +89 +88 +31 +T +7 + +39 +28 +36 +T +5 + +46 +83 +64 +83 +39 +83 +89 +83 +55 +T +7 + +24 +23 +T +1 + +20 +59 +61 +57 +29 +38 +L +7 +"start" +60 +10 +33 +48 +17 +31 +59 +36 +59 +55 +59 +76 +54 +L +N13 +71 +8 +79 +91 +24 +39 +46 +12 +66 +L +7 +"EOI" +89 +64 +50 +L +N11 +68 +26 +14 +18 +93 +86 +41 +52 +73 +34 +81 +L +22 +12 +108 +T +58 + +T +N12 + +43 +6 +20 +59 +61 +57 +84 +75 +29 +38 +104 +60 +10 +33 +48 +17 +31 +59 +36 +59 +55 +59 +76 +54 +104 +108 diff --git a/ipl/packs/tcll1/tcll1.pdf b/ipl/packs/tcll1/tcll1.pdf Binary files differnew file mode 100644 index 0000000..bfaeb51 --- /dev/null +++ b/ipl/packs/tcll1/tcll1.pdf diff --git a/ipl/packs/tcll1/xcode.icn b/ipl/packs/tcll1/xcode.icn new file mode 100644 index 0000000..c8def5f --- /dev/null +++ b/ipl/packs/tcll1/xcode.icn @@ -0,0 +1,421 @@ +############################################################################ +# +# File: xcode.icn +# +# Subject: Procedures to save and restore Icon data +# +# Author: Bob Alexander +# +# Date: January 1, 1996 +# +############################################################################ +# +# Contributor: Ralph E. Griswold +# +############################################################################ +# +# Description +# ----------- +# +# These procedures provide a way of storing Icon values in files +# and retrieving them. The procedure xencode(x,f) stores x in file f +# such that it can be converted back to x by xdecode(f). These +# procedures handle several kinds of values, including structures of +# arbitrary complexity and even loops. The following sequence will +# output x and recreate it as y: +# +# f := open("xstore","w") +# xencode(x,f) +# close(f) +# f := open("xstore") +# y := xdecode(f) +# close(f) +# +# For "scalar" types -- null, integer, real, cset, and string, the +# above sequence will result in the relationship +# +# x === y +# +# For structured types -- list, set, table, and record types -- +# y is, for course, not identical to x, but it has the same "shape" and +# its elements bear the same relation to the original as if they were +# encoded and decoded individually. +# +# Files, co-expressions, and windows cannot generally be restored in any +# way that makes much sense. These objects are restored as empty lists so +# that (1) they will be unique objects and (2) will likely generate +# run-time errors if they are (probably erroneously) used in +# computation. However, the special files &input, &output, and &errout are +# restored. +# +# Not much can be done with functions and procedures, except to preserve +# type and identification. +# +# The encoding of strings and csets handles all characters in a way +# that it is safe to write the encoding to a file and read it back. +# +# xdecode() fails if given a file that is not in xcode format or it +# the encoded file contains a record for which there is no declaration +# in the program in which the decoding is done. Of course, if a record +# is declared differently in the encoding and decoding programs, the +# decoding may be bogus. +# +# xencoden() and xdecoden() perform the same operations, except +# xencoden() and xdecoden() take the name of a file, not a file. +# +############################################################################ +# +# Complete calling sequences +# -------------------------- +# +# xencode(x, f, p) # returns f +# +# where +# +# x is the object to encode +# +# f is the file to write (default &output) +# +# p is a procedure that writes a line on f using the +# same interface as write() (the first parameter is +# always a the value passed as "file") (default: write) +# +# +# xencode(f, p) # returns the restored object +# +# where +# +# f is the file to read (default &input) +# +# p is a procedure that reads a line from f using the +# same interface as read() (the parameter is +# always a the value passed as "file") (default: read) +# +# +# The "p" parameter is not normally used for storage in text files, but +# it provides the flexibility to store the data in other ways, such as +# a string in memory. If "p" is provided, then "f" can be any +# arbitrary data object -- it need not be a file. +# +# For example, to "write" x to an Icon string: +# +# record StringFile(s) +# +# procedure main() +# ... +# encodeString := xencode(x,StringFile(""),WriteString).s +# ... +# end +# +# procedure WriteString(f,s[]) +# every f.s ||:= !s +# f.s ||:= "\n" +# return +# end +# +############################################################################ +# +# Notes on the encoding +# --------------------- +# +# Values are encoded as a sequence of one or more lines written to +# a plain text file. The first or only line of a value begins with a +# single character that unambiguously indicates its type. The +# remainder of the line, for some types, contains additional value +# information. Then, for some types, additional lines follow +# consisting of additional object encodings that further specify the +# object. The null value is a special case consisting of an empty +# line. +# +# Each object other than &null is assigned an integer tag as it is +# encoded. The tag is not, however, written to the output file. On +# input, tags are assigned in the same order as objects are decoded, so +# each restored object is associated with the same integer tag as it +# was when being written. In encoding, any recurrence of an object is +# represented by the original object's tag. Tag references are +# represented as integers, and are easily recognized since no object's +# representation begins with a digit. +# +# Where a structure contains elements, the encodings of the +# elements follow the structure's specification on following lines. +# Note that the form of the encoding contains the information needed to +# separate consecutive elements. +# +# Here are some examples of values and their encodings: +# +# x encode(x) +# ------------------------------------------------------- +# +# 1 N1 +# 2.0 N2.0 +# &null +# "\377" "\377" +# '\376\377' '\376\377' +# procedure main p +# "main" +# co-expression #1 (0) C +# [] L +# N0 +# set() "S" +# N0 +# table("a") T +# N0 +# "a" +# ["hi","there"] L +# N2 +# "hi" +# "there" +# +# A loop is illustrated by +# +# L2 := [] +# put(L2,L2) +# +# for which +# +# x encode(x) +# ------------------------------------------------------- +# +# L2 L +# N1 +# 2 +# +# The "2" on the third line is a tag referring to the list L2. The tag +# ordering specifies that an object is tagged *after* its describing +# objects, thus the list L2 has the tag 2 (the integer 1 has tag 1). +# +# Of course, you don't have to know all this to use xencode and +# xdecode. +# +############################################################################ +# +# Links: escape +# +############################################################################ +# +# See also: object.icn, codeobj.icn +# +############################################################################ + +invocable all + +link escape + +record xcode_rec(file,ioProc,done,nextTag) + +procedure xencode(x,file,writeProc) #: write structure to file + + /file := &output + return xencode_1( + xcode_rec( + file, + (\writeProc | write) \ 1, + table(), + 0), + x) +end + +procedure xencode_1(data,x) + local tp,wr,f,im + wr := data.ioProc + f := data.file + # + # Special case for &null. + # + if /x then { + wr(f) + return f + } + # + # If this object has already been output, just write its tag. + # + if tp := \data.done[\x] then { + wr(f,tp) + return f + } + # + # Check to see if it's a "distinguished" that is represented by + # a keyword (special files and csets). If so, just use the keyword + # in the output. + # + im := image(x) + if match("integer(", im) then im := string(x) + else if match("&",im) then { + wr(f,im) + data.done[x] := data.nextTag +:= 1 + return f + } + # + # Determine the type and handle accordingly. + # + tp := case type(x) of { + "cset" | "string": "" + "file" | "window": "f" + "integer" | "real": "N" + "co-expression": "C" + "procedure": "p" + "external": "E" + "list": "L" + "set": "S" + "table": "T" + default: "R" + } + case tp of { + # + # String, cset, or numeric outputs its string followed by its + # image. + # + "" | "N": wr(f,tp,im) + # + # Procedure writes "p" followed (on subsequent line) by its name + # as a string object. + # + "p": { + wr(f,tp) + im ? { + while tab(find(" ") + 1) + xencode_1(data,tab(0)) + } + } + # + # Co-expression, file, or external just outputs its letter. + # + !"CEf": wr(f,tp) + # + # Structured type outputs its letter followed (on subsequent + # lines) by additional data. A record writes its type as a + # string object; other type writes its size as an integer object. + # Structure elements follow on subsequent lines (alternating keys + # and values for tables). + # + default: { + wr(f,tp) + case tp of { + !"LST": { + im ? { + tab(find("(") + 1) + xencode_1(data,integer(tab(-1))) + } + if tp == "T" then xencode_1(data,x[[]]) + } + default: xencode_1(data,type(x)) + } + # + # Create the tag. It's important that the tag is assigned + # *after* other other objects that describe this object (e.g. + # the length of a list) are output (and tagged), but *before* + # the structure elements; otherwise decoding would be + # difficult. + # + data.done[x] := data.nextTag +:= 1 + # + # Output the elements of the structure. + # + every xencode_1(data, + !case tp of {"S": sort(x); "T": sort(x,3); default: x}) + } + } + # + # Tag the object if it's not already tagged. + # + /data.done[x] := data.nextTag +:= 1 + return f +end + +procedure xdecode(file,readProc) #: read structure from file + + /file := &input + + return xdecode_1( + xcode_rec( + file, + (\readProc | read) \ 1, + [])) +end + +# This procedure fails if it encounters bad data + +procedure xdecode_1(data) + local x,tp,sz, i + data.ioProc(data.file) ? { + if any(&digits) then { + # + # It's a tag -- return its value from the object table. + # + return data.done[tab(0)] + } + if tp := move(1) then { + x := case tp of { + "N": numeric(tab(0)) + "\"": escape(tab(-1)) + "'": cset(escape(tab(-1))) + "p": proc(xdecode_1(data)) | fail + "L": list(xdecode_1(data)) | fail + "S": {sz := xdecode_1(data) | fail; set()} + "T": {sz := xdecode_1(data) | fail; table(xdecode_1(data)) | fail} + "R": proc(xdecode_1(data))() | fail + "&": case tab(0) of { + # + # Special csets. + # + "cset": &cset + "ascii": &ascii + "digits": &digits + "letters": &letters + "lcase": &lcase + "ucase": &ucase + # + # Special files. + # + "input": &input + "output": &output + "errout": &errout + default: [] # so it won't crash if new keywords arise + } + "f" | "C": [] # unique object for things that can't + # be restored. + default: fail + } + put(data.done,x) + case tp of { + !"LR": every i := 1 to *x do + x[i] := xdecode_1(data) | fail + "T": every 1 to sz do + insert(x,xdecode_1(data),xdecode_1(data)) | fail + "S": every 1 to sz do + insert(x,xdecode_1(data)) | fail + } + return x + } + else return + } + +end + +procedure xencoden(x, name, opt) + local output + + /opt := "w" + + output := open(name, opt) | stop("*** xencoden(): cannot open ", name) + xencode(x, output) + close(output) + + return + +end + +procedure xdecoden(name) + local input, x + + input := open(name) | stop("*** xdecoden(): cannot open ", name) + if x := xdecode(input) then { + close(input) + return x + } + else { + close(input) + fail + } + +end |