.FILL .REFNO TRITA-CS-8405 .DOCNAME Transforming LPL0-Programs using LPL0. .ce 1 .TITLE Abstract .QS A transformer for logic programs, written in LPL0, a PROLOG-like language with some additional functional syntax and fewer "imperative" predicates than what is the usual case with PROLOG, has been produced at the Computer Systems and Architecture Laboratory (CSALAB). The transformer operates on programs written in LPL0 and by adding backends of different kind it is able to produce code for different virtual machines that are developed in the laboratory ([Ha,Sa] and [Ci]) as well as source code in purely clausal form for some different dialects of PROLOG. It could be viewed as a tool and an experiment in side-effect free logic programming for a practical task. By implementing the transformer in a logic programming language we reach a higher degree of flexibility and modifiability of the code than is the case with an earlier program written in C using LEX and YACC. The cost paid for this is a slower execution speed using the current system. A number of tools for the parsing of text that is available in the C library, if you use that language, were developed in LPL0. Since LPL0 supports neither the imperative assert/retract style of logic programming nor the 'call' primitive, the code is free from the "liberal semantics" that can cause a lot of trouble when programming in PROLOG. The code can therefore be said to be closer to what could be executed in a system for 'pure' logic programming than otherwise might be the case. The 'cut' primitive has to be used, however, in order to handle negation and in some cases to conserve memory space by expressing determinism as well as to guarantee termination. The input is handled in a side-effect free manner using the notion of a 'lazy' input in LPL0. The transformer is relatively easy to port to other PROLOG versions. The code does not depend on the UNIX environment. This report describes the transformations from concrete to abstract syntax and the ways in which the program is being optimized by this transformer. The question of how to use the code for different purposes by adding specialized backend predicates is discussed. .QE .FF .TITLE Transforming and compiling, optimization and partial evaluation. .br - a discussion about the use of terms. In logic programming compiling has the same purpose as in other programming systems: To make programs run faster by transforming the program to an operationally equivalent representation using the static interdependencies known at compile time to produce a more or less specialized representation. This representation is then executed by some "machine" to deduce the solutions to the given problem. The traditional notion of compiling is not really adequate but is used here in absence of a better alternative. The reason for this is that the virtual machine has very high level instructions which are much more semantically powerful than the instructions of a traditional computer. This simplifies the compiling with the penalty of slower execution speed. Normally the term compiling is used when the output is a code that is closer to actual machine code. Program transformation on the other hand is a term used when the output of the transformer is expressed in the same formalism as the input. In both cases techniques of various strength for optimizing the code can be used. The applied techniques range between a more or less direct mapping between program representations in different formalisms to advanced techniques like partial evaluation [Ka] based on knowledge of the expected use of the program stated in the form of annotations or otherwise deduced from the computational context, or program derivations where proof procedures from symbolic logic are used in order to deduce specialized instances of general programs [Han]. .TITLE Goals of this project. The problem addressed in this programming project is not mainly the transformation techniques as such but rather the construction of a framework wherein techniques for program transformation and compiling can be easily tested using our syntax for FOL. This proved itself to be also a non-trivial programming task which has been valuable in testing the existing LPL0-compiler and interpreter finding bugs that do not occur in simple test-examples. While designing the code generality, modularity and modifiability of the code have been prioritized before 'brilliant' tricks to achieve maximum performance and code density. A densely packed tricky code tends to reduce readability, but of course the unnecessarily wordy and less general formulations that might be easier to express might also reduce readability. I tried to make a sensible balance between generality and naturality of the code. In retrospect I think that the code should have been oriented more towards more general and less specialized formulations. The transformer consists of a parser accepting programs stated in a first order formalism and transforming them into PROLOG-terms, also called translation from concrete to abstract syntax. These PROLOG terms are used for different static checks and optimizations. Code is produced based on this optimized form of the program and a readable output is produced for later use. Since the statements accepted by the parser are general first order formulae it can be used for other purposes than only as a front end to a code-generator for LPL0. LPL0 can be seen as a PROLOG system with functions and but without metalevel predicates. The programming style is of course dependent on this deliberate limitation in favor of clearer semantics. The abstract syntax is a clear description of the datastructures used to represent the clauses in the transformer. It can be viewed as a declaration of the type of the input and output of various optimizing predicates performing transformations on the clauses to reach executable and/or more efficient forms with an equivalent meaning. By applying different versions of the predicate 'printcode' on the terms of the abstract syntax representing the program, different output can be obtained. The following has been done until now: .IP 1) A code-generator for symbolic machine code to the LPL0-interpreter produces a linkable file representing the LPL0-program. .IP 2) A code-generator for symbolic machine code to the simulator for the or-parallel tokenmachine produces code for this simulator. .IP 3) A version producing source code in LPL0 syntax is useful to see the effect of the applied transforms. .IP 4) A version producing MU-PROLOG syntax allows executable MU-PROLOG-code to be produced. .IP 5) A slight modification produces output in cPROLOG-form. .IP 6) A version produces output using s-expressions to represent clauses, thereby generating input to LISP-based interpreters. .IP 7) An interpreter for first order logic programs (GEPR) written by Dan Sahlin and Seif Haridi uses the above mentioned parser. .LP The executable representation of the program produced by the code generators, which of course differs with the different machine specifications is called L-code in the following text. The concrete syntax of an LPL0-program is transformed by the transformer into L-code through a few transformations. The classical phases of compiling are here recognized in the different transformations described below: The Lexical Analyzer, The Grammatical Analyzer, The Optimizer and The Code Generator. These phases take the form of different deterministic predicates (functions) that each one from a specified input produces one particular output. The structure of the data that may occur on the interfaces between these modules is specified in terms of Abstract Syntaxes in the sense of VDM [Bjoe]. The transformation rules associated with each form is described fully by the enclosed program. .TITLE Syntax - why bother ? Some argue that the use of s-expressions is the radical method by which the need of a particular syntax for first order statements becomes irrelevant. Some even argue that the functor-expressions used in PROLOG do not give any additional functionality to a PROLOG-system. O'Keefe [O'K] has critizised this view in several articles among them the usenet article mentioned in the reference list. Efficient PROLOG-interpreters and compilers embedded in a LISP-environment like LM-PROLOG [CaKa], often make use of other datastructures than pure s-expressions to improve efficiency. As to the first argument concerning the convenience of a given syntax it is clear that the use of s-expressions is convenient in a LISP-environment, where all tools are oriented towards representing programs and data in this form. In an environment like UNIX it is more a matter of taste. Clearly we think that the traditional syntaxes for first order logic that you find in the literature of symbolic logic are easier to read than raw lisp style s-expressions. In our syntax the notion of functions can be used as a form of annotation to mark deterministic and directed relations. Of course the use of such a syntax gives some extra complication in parsing the language, but that does not need to be solved more than once. The notion of the abstract syntax has to be present in all compilers and transformers to clarify the transformation relations and to enable error checking. The question of what is the right syntax for PROLOG is not settled, and probably never will be, and as has been pointed out in the recent PROLOG digest discussion about syntax and portability problems, the major reason for these lies not in superficial syntactic variants but in subtly varying semantics of different PROLOG-systems. So, even though the amount of effort put into parsing in this work may imply something else, we do consider the exact nature of the syntax to be a secondary issue. By choosing a more readable syntax you simply have to work harder on lexical issues. .TITLE Phase 1: The lexical analyzer. The lexical analyzer transforms the program text which is represented as a list of characters to a list of tokens. This saves space and enables faster handling of the structure in the parsing phase. In particular the annoying effect of backtracking within syntactically atomic units, which has to be explicitly avoided if the representation in the form of a flat character list is kept does not occur if a lexical analyzing phase is included. Redundant syntactic features are represented in a unique form in the output from this phase. To make the lexical analyzer a deterministic predicate, i.e. to ensure that a failure in the later phase cannot be avoided by backtracking in the lexical analyzer, (this is important for performance reasons, especially in the handling of syntactical errors), certain restrictions must be made on the allowed syntactic entities. The limitations are similar to those used in a recursive descent analyzer. More specifically the decision about what is a lexically significant symbol must not be dependent on the meaning of the context in which it occurs. The input form of the program is a list of ascii characters. .NOFILL .TITLE Source code domain for LPL (Input to phase 1 - lexical analyzer). .NOPROP prog :: line+ eof line :: lpltoken+ blank* lf eof :: ascii(-1) lf :: ascii(10) blank :: ascii(32) lpltoken :: blank* lplsym lplsym = "." | and | or | not | "[" | "]" | tail | "(" | ")" | "," | "+" | "-" | "*" | "/" | "^" | mod | "<" | ">" | "=" | "/=" | "<=" | ">=" | if | onlyif | iff | exist | forall | schema | constident | varident | false false = "false" and = "and" | "&" or = "or" | ";" not = "not" tail = "|" | ",.." mod = "mod" if = "if" | "<-" onlyif = "onlyif" | "->" iff = "iff" | "<->" exist :: "E:" forall :: "A:" constident = bigletter nondelimiter* | quote char* quote varident :: smalletter nondelimiter* | "_" nondelimiter = numeral | letter | "_" char = quote quote | x (s.t. ascii(x) & x/=eof & x/=lf & x/=quote) quote = "'" numeral = digit+ | "#" asciichar asciichar = x s.t. ascii(x) & x/=eof & x/=lf letter = bigletter | smalletter bigletter = x (s.t. ascii(x) & x>="A" & x<="Z") smalletter = x (s.t. ascii(x) & x>="a" & x<="z") digit = x (s.t. ascii(x) & x>="0" & x<="9") .PROP .FILL The lexical analyzer produces a simplified and more memoryefficient representation of the program wherein reserved tokens have been identified. Integers, constant names and variable names are recognized and tagged by the lexical analyzer so that no ambiguities are introduced. .NOFILL .TITLE Lexical domain for LPL. (output from lexical analyzer/input to parser) .NOPROP prog = token+ token = '.' | ',' | '&' | 'OR' | 'NOT' | 'Exist' | 'All' | '[' | ']' | '|' | ':' | '(' | ')' | '+' | '-' | '*' | '/' | '^' | 'MOD' | '<' | '>' | '=' | '/=' | '<=' | '>=' | '<->' | '<-' | '->' | Int(x) | Constid(x) | Varid(x) | '_' | 'FALSE' .FILL .PROP As you can see from these grammars the purpose of the lexical phase is to simplify the work in the actual parsing of the statements. The code for this phase is found in the appendix. .TITLE Phase 2: The grammatical analyzer -- the parsing phase. The grammatical analyzer takes the list of tokens produced by the lexical analyzer as input and produces an abstract tree, describing the program, if it conforms to the concrete syntax, otherwise it fails. The allowed statements are represented as parts of the token list according to the grammar stated below. Also statements which are logically correct but which are not executable by the current L-machine can be parsed in this phase. Only tokenlists that cannot be understood as statements of first order predicate logic are considered erroneous. Priorities and associativities of logic connectives and arithmetic operators are resolved. The arithmetic expressions occurring as terms in the source code are transformed to the same representation as that for nested function invocations and the comparison expressions are transformed into atomic predicates. .NOFILL .TITLE Concrete syntax for LPL (general logic statement format). .NOPROP prog ::= statement | statement prog statement ::= formula '.' formula ::= false | cut | atomic | '(' formula ')' | not formula | goalform | quantform | schema atomic ::= PREDID '(' termlist ')' | term cmpoper term schema ::= SCHID '(' varlist ')' '(' varlist ')' goalform ::= formula connective formula quantform ::= '(' qvarlist ')' formula qvarlist ::= qvars | qvars qvarlist qvars ::= 'Exist' varlist | 'All' varlist termlist ::= term | term ',' termlist cterm ::= var | integer | dstruct | function term ::= aritexpr dstruct ::= DSID '(' termlist ')' | list | CONSTID list ::= '[' listelems ']' | '[' ']' listelems ::= term | term ',' listelems | term restoflist restoflist ::= '|' term function ::= FUNCID '(' termlist ')' varlist ::= var | var ',' varlist var ::= VARID | '_' aritexpr ::= '(' aritexpr ')' | cterm | aritexpr aritoper aritexpr | unary cterm connective ::= '&' | 'OR' | '<-' | '->' | '<->' cmpoper ::= '<' | '<=' | '=' | '/=' | '>=' | '>' aritoper ::= '+' | '-' | '*' | '/' | '^' | 'MOD' unary ::= '+' | '-' false ::= 'FALSE' cut ::= '/' not ::= 'NOT' .PROP .FILL This grammar describes how a syntactically correct logic program is expressed. The grammar allows general FOL formulae of which only a subset are executable in PROLOG (or LPL0). .TITLE Schemas and quantifiers. The formulae can contain quantifiers ('A:x' meaning "for all x", 'E:x' meaning "there exists an x") and schemas. The notion of a schema is that of a formula where some predicates are denoted by variables. These forms are allowed formulae which give the possibility to express a generalized logic form which is applied for different predicates. Schemas can be used to express in first order logic certain statements that would otherwise demand higher order. Statements containing schemas can be transformed in the global transformation phase into their corresponding instances, i.e. clausal statements without schemas. This covers many cases where the ordinary PROLOG construction is the 'higher order' (and semantically unclear) notion of meta-calls. In these cases the schema represents a nice shorthand notation. .BIND .NOFILL Ex. The schema definition: applies_to_a_list(p)(l) <- l=[] or l=[h|t] & p(h) & applies_to_a_list(p)(t). similar to the DEC10-PROLOG notation: applies_to_a_list(P,L) :- L=[]; L=[H|T], P(H), applies_to_a_list(P,L). .FILL .NOBIND has the advantage that the distinction between predicate-variables and ordinary variables is not muddled as is the case in PROLOG. The transformer could hereby more easily check properties of the stated program. This possibility is not elaborated in the current version. Quantifiers as well as the nested use of other connectives than \&'&' and \&'or' are used in the GEPR-interpreter since this FOL-interpreter can make sensible use of them. The other codegenerators consider them to be errors. .NOFILL .bp .TITLE Abstract syntax for LPL (internal representation for a logic program). .NOPROP Prog = (RName -> Rdef) U (SchName -> SchDef) Rdef :: Rname Funcpred BRdef FRdef BRdef = Formula* FRdef = Formula* SchDef :: ArgsNo RDef Formula = Atomic | GoalForm | QuantForm | Schema Schema :: SchName RName+ Term* Atomic :: RName Term* Funcpred GoalForm :: Formula Connective Formula QuantForm :: Qvar+ Formula Qvar :: AllVar | ExistVar Term = Var | Dstruct | Function Dstruct :: DSname Term* Function :: Fname Term* AllVar :: Var+ ExistVar :: Var+ Var :: VarIdent Typeinfo RName :: RelIdent Typeinfo DSname :: DstructIdent Typeinfo Fname :: FunctionIdent Typeinfo SchName :: SchIdent Typeinfo Funcpred = Func | Pred Typeinfo = System | User | Special ArgsNo = Integer .PROP .FILL The Abstract Syntax above contains all the necessary information that constitutes a logic program. Also here the allowed formulae are of a more general form than those that can be directly executed. \&'U\&' is the union operation. .br \&'X -> Y\&' denotes a map, i.e. a set of objects \&'X\&' and their associated objects \&'Y\&'. .br \&'X*\&' denotes a list of 0 or more objects of type \&'X\&'. .br \&'X+\&' denotes a list of 1 or more objects of type \&'X\&'. .br \&'|\&' denotes alternatives. .br \&'::\&' denotes a tagged structure. .br \&'=\&' denotes an untagged structure, i.e. the name of the production is not visible in the structure. The code of the parser is found in the appendix. .BIND .TITLE Phase 3: The transformer. This phase traverses the abstract tree generated by the parser and creates a different one. E.g. function calls are unfolded and transformed to predicate form, redundant equalities are removed, unnecessary variables are extracted and new necessary variables are introduced. The output abstract tree of this phase conforms to the abstract syntax defined above. The use of the same abstract tree for input and output in the optimizing predicates enables 'short-circuiting' around any one of the optimizing predicates. This is an important characteristic of the transformer when it comes to questions of modularity and experimenting with the transformer. Different optimizing predicates can be easily inserted without the need for a redesign of internal interfaces. The transforming clauses are conveniently formulated as functions. I will discuss them one by one so that the structure is clear to anyone wishing to alter the definitions. The function 'transform' translates a clause to a semantically equivalent representation. .NOFILL transform(s)=andor(removeeqs(extracteqs(funcstopreds(s1a)))) <- fefuns(funchtopredh(s),[])=[s1,_] & funcsinhead(s1,s1a). .FILL Here the functional syntax for deterministic predicates shows its convenience. Definitions of this type can be read as equational clauses with preconditions in and/or form. When executing a clause in this form, the system first tries to satisfy the preconditions. If that is successful the functional expression to the right of the '=' sign is executed from the inside out. Backtracking may occur, but in analogy with the mathematical notion of a function only \fIone \fRresult is expected. Therefore a function will not always backtrack after a result has been computed even though the subsequent computation of the clause in which it was called fails. .NOFILL Ex: The function definition \fBf(x)\fR is accepted by the system. p(x) <- f(15)=x & x=15. f(x)=x+1. f(x)=x. But since a function is expected to deliver only one value for each \fBx\fR it fails to find any solution for the predicate \fBp(x)\fR. .FILL The function transform translates all clauses to a relational form which can be seen for the example above as output by the system in lpl-syntax: .NOFILL p(x)<- f(15,x) & x=15. f(x,rESULT)<- x+1=rESULT & /. f(x,x)<- /. .FILL Using the standard execution mechanism for PROLOG (with '=' understood as 'is' for arithmetic expressions as in our system) and '/' meaning 'cut' it is clear that there is no solution to be found for \fBp(x)\fR. Another possible interpretation of the functional syntax is that it should only be considered as syntactic sugar for relations. In that case no 'cut' should be inserted and a solution for \fBp(x)\fR should be found. Since that understanding of a function contradicts the traditional mathematical notion we ruled that possibility out. To see the convenience of the functional syntax consider the predicate \&'transform' above. In a relational notation it looks like this: .NOFILL transform(s,sysV6)<- funchtopredh(s,sysV1) & fefuns(sysV1,[],sysV2) & sysV2=[s1|[_|[]]] & funcsinhead(s1,s1a) & funcstopreds(s1a,sysV3) & extracteqs(sysV3,sysV4) & removeeqs(sysV4,sysV5) & andor(sysV5,sysV6) & /. .FILL This syntax enforces the use of several variables whose sole purpose are to transfer values from one clause to another, and is normally not considered particularly elegant. It gives a clear picture of what goes on in the evaluation of the function \&'transform' above considering the left to right evaluation order, though. More accurately the transformer performs these steps when applied to an abstract tree: .IP 1) \&'funchtopredh' transforms a function definition to predicate form. E.g. the clause \&'f(x)=g(x)+3 <- p(x)' is transformed into \&'f(x,result) <- p(x) & result=g(x)+3'. .IP 2) \&'fefuns' unfolds the nested function calls. E.g. a clause like 'p(f(g(x))' is transformed into \&'v1=g(x) & v2=f(v1) & p(v2)'. .IP 3) \&'funcsinhead' transfers the function calls occuring in the head to be evaluated first in the body. E.g. the clause 'p(f(x),x) <- b(x)' is translated into \&'p(v1,x) <- v1=f(x) & b(x)'. This is declaratively defendable since function calls in the head can be considered as restrictions on arguments to the predicate describing functional relations between them. .IP 4) \&'funcstopreds' converts function calls to goal form. E.g. clauses like 'v1=f(x)' are translated into 'f(x,v1)'. .IP 5) \&'extracteqs' replaces variables that are statically equal so that all unnecessary variables (and thereby unifications) are removed from the clause. E.g. 'p(1,y) & p(2,z) & y=z' is transformed into \&'p(1,y) & p(2,y) & y=y'. This can be understood as a (very) limited form of partial evaluation using only local static knowledge within the clause. .IP 6) \&'removeeqs' replaces calls like 'x=x' with 'true' which is later ignored by the code generating predicates. .IP 7) \&'andor' normalizes the and/or tree to a right-aligned form in order to simplify the formulation of the codegenerating rewriting rules. .LP Another nice property of the transformation is that common functional subexpressions are automatically evaluated only once, using the sideeffect- free semantics of a pure PROLOG. This is possible since lpl does not allow assert/retract style predicates, thereby guaranteeing that the set of clauses is unchanged during the program execution. An example that shows most of what the transformation function does is this: .NOFILL f(g(h(x)),h(x),x)=f(s(r(x),r(r(x)),r(r(x)))) <- p(h(x),g(r(y)),s(y)) & y=h(r(r(x))). .sp 1 is transformed into .sp 1 f(sysV2,sysV1,x,rESULT)<- h(x,sysV1) & g(sysV1,sysV2) & r(y,sysV3) & g(sysV3,sysV4) & s(y,sysV5) & p(sysV1,sysV4,sysV5) & r(x,sysV6) & r(sysV6,sysV7) & h(sysV7,y) & s(sysV6,sysV7,sysV7,sysV9) & f(sysV9,rESULT) & /. .FILL You can see that the function calls in the head are first evaluated, then the preconditions in the body, and thereafter the result is calculated. In the case where Mu-PROLOG code is generated this evaluation order can be altered dynamically by using the 'wait'-semantics for annotated variables. The function definitions are currently not sorted as in the original compiler but they are considered to be deterministic predicates so a cut is inserted at the end of each clause defining a function. The code for the transforming predicates is found in the appendix. .TITLE Further possibilities regarding transformation. Reordering of functional clauses (and changing the order of goals within them) as well as other global transformations were not included here due to efficiency reasons. Storing the whole program as a term gave severe execution penalties due to deficiencies of the current interpreter for LPL0. With an interpreter whose memory management is designed for use in a large virtual memory this (and other similar techniques) could be practically exploited. A partial evaluation of the statements could be made in order to detect possible optimizations due to creating specialized code for the different possible input patterns. The possibilities of optimizing the unification process and the matching phase of the execution should also be explored. Annotations describing the intended use of variables, perhaps combined with optional type-declarations can be used to give the compiler additional information. Any program transformation algorithms, that can be expressed as a rewrite rule in the same way done here, can be easily inserted. .TITLE Phase 4a: The code generator for LPL0. The instructions of the L-machine and the state-space of the machine can be described using abstract trees and semantic actions associated with them as in the formal software specification method of VDM [Bjoe]. Representing the set of legal programs as an abstract tree is handy in a logic programming environment. This abstract tree can therefore be seen as the target code of the transformer in some sense. This phase transforms the output from phase 3 into an L-machine program in a fairly straightforward manner. A backend predicate can then easily print out this representation on filestorage for later execution. The transformer is able to replace the existing compiler for LPL0 in aspects regarding functionality but not efficiency. The code produced by this codegenerator is executable using the current assembler/linker/interpreter for LPL0-programs. To produce another necessary file containing linking information needed for separate compilation another LPL0-program operating on the output of this predicate is used. Tail recursion optimization, used to drastically reduce the amount of needed heap space for the interpreter when frames for variables and control of the execution may be reused, and detection of system predicates, for which special code shall be generated, is performed by traversing the output of this phase by another predicate before the output takes place and generating the instruction 'LASTCALL' whereever appropriate. This gives a call sequence that does not use stackspace unnecessarily. The code of the code-generator is found in the appendix. .TITLE Phase 4b: The codegenerator for the or-parallel simulator. As as alternative to the codegenerator described under 4a above a slightly modified version was produced. This version produces a file of code in a format defined in [Ci]. Another LPL0-program applied to files of that type produces a binary image directly used by the simulator for the or-parallel token-machine [Hau]. .TITLE Other backends. As was mentioned above a few different backends were written in order to print out the abstract tree representing a program in different PROLOG syntaxes. Since one of the goals of this project was to produce practically used code in LPL0, they are added in the appendix. Using these versions the compiler becomes a transformer. .TITLE Conclusions, possible directions of development and some self critizism. One can see a few obvious advantages of this code compared to the previous compiler written in C using YACC and LEX: This code is easier to understand, and thereby to modify without causing disastrous effects. Since LPL0 allows no imperative predicates operating on the global state (somewhat comparable to selfmodifying code), the code is modular. Of course, the semantics of a predicate affects the behaviour of those other predicates that use it, but by using a side-effect free programming style without metalevel predicates several sources of difficult errors when altering the code are avoided. The price paid for this is that explicit parameter passing must be used were it could otherwise have been avoided. This is, I think, not entirely negative for the reasons stated above. A more important negative aspect of this programming style is that it is significantly slower than the earlier version written in C. This could to some extent be blamed upon the fact that the code is interpreted by a virtual machine, a method which gives severe execution penalties also for other languages. But with a better interpreter (or even a compiler in Warren's style) this code would execute much faster. Both indexing and compiled unification, which all the interpreters used here lack, would certainly give drastic improvements in speed. Applying the code onto itself for test-purposes resulted in an execution time on our VAX-750 running Berkeley UNIX 4.2 around seven hours of user time, while the c-coded version performs the same task in a matter of 15 minutes. Much of this overhead seems to be due to the unfavourable behaviour of the current interpreter in a virtual memory environment and to the decreasing priority given to long-running processes under UNIX 4.2. Some improvement to these discouraging figures by just changing the strategy of the transformer can be obtained in a few different ways: .IP 1) Reducing the generality of the parser by specializing it for simple Horn Clause program, which is adequate for PROLOG-style execution semantics. .IP 2) Decreasing the number of passes in the optimizing phases to one by rewriting the optimizing predicates. .IP 3) Decreasing the number of passes in the code-generating phase to one by detecting system predicates and perform tail recursion optimization directly instead of in a second phase. .LP All of these optimizations seem to contradict the expressed urge to prioritize generality before execution speed. I believe that a better interpreter/compiler is necessary to achieve better performance. For instance this program could be altered fairly easily to produce better code once the methods of compiling are specified. Important areas seen today that are not covered by the current interpreter for LPL0 that will demand changes in the machine specification are for instance: .IP a) Indexing as implemented in the Dec10 PROLOG compiler. This means a more efficient reduction of the search space during run-time due to static data-dependencies. It is essential in order to speed up the execution of logic programs and it also makes a more efficient use of the memory during run-time. .IP b) Specialized compiling of the equality generator (unification) as proposed for instance by Joergen Fischer Nilsson [Fi2]. This means roughly that specialized versions of the code are produced to cover different possible instantiation patterns. A classification of the data is done at compile time to enable calls to different versions of the code from different parts of the program where in some cases the equality-generator which currently is called at every matching is reduced to a few simple tests or simple "assignments" (or "bindings" if you like). The introduction of a polymorphic type concept in the language is closely related to this matter. .LP Issues a and b are somewhat related and especially the suggestions made by Fischer Nilsson seems to mean a significant improvement to the execution mechanism of PROLOG-like languages. Further investigations are necessary. .IP c) Compilation into machine code for an ordinary computer architecture e.g. M68000 or a closely coupled system of such processors could be an interesting area of research even though the ideal architecture for executing logic languages is hardly that of M68000. .IP d) Using the transformer together with a backend written in logic that creates microcode for some suitable architecture would be an interesting and probably valuable undertaking. .IP e) Compiling code for the more complete logic language LPL described by Seif Haridi in his thesis [Ha] and implemented in a prototype form by Haridi and Sahlin [HaSa2] will require a different target machine and interpreter to enable combined execution of forward and backward proofs. .IP f) It would be reasonable to incorporate the code of this transformer into an interactive environment for logic programming like that of Dec-10 PROLOG [Wa] or MU-PROLOG. Thereby the turn-around time for program development could be improved. .LP The work done by Warren and others on efficient compiling of PROLOG represents a very significant effort in making Logic Programming languages practically usable tools. A lot can be learned from these pioneering efforts and it seems valuable to research into how these efficient compiling techniques can be used for PROLOG-variants with a more flexible execution semantics like MU-PROLOG [Na] or Concurrent PROLOG [Sha]. .FF .NOFILL .BIND .TITLE References: [Bjoe] The VDM principles of software specification & program design. .br .DK Dines Bj|rner .br .US (Dept. of Computer Science, Techn. Univ. of Denmark, Lyngby) [CaKa] LM-PROLOG User's Manual. Mats Carlsson & Ken M. Kahn UPMAIL Uppsala University Box 2059 S-750 02 Uppsala, Sweden [CiHa1] Formal models for or-parallel execution of logic programs. Seif Haridi & Andrzej Ciepielewski (CSALAB TTDS/KTH Stockholm Nov 1982) [CiHa2] An or-parallel token machine. Seif Haridi & Andrzej Ciepielewski (CSALAB TTDS/KTH Stockholm May 1983) [CiHa3] Control of activities in the or-parallel token machine. Seif Haridi & Andrzej Ciepielewski (CSALAB TTDS/KTH Stockholm May 1983) [Fi] The specification and implementation of a PROLOG system. .br .DK J|rgen Fischer Nilsson .br .US (Technical Report, The Danish Datamatics Centre 1981) [Fi2] On the compilation of PROLOG. .br .DK J|rgen Fischer Nilsson .br .US (Technical Note, The Danish Datamatics Centre 1982) [Ha] Logic programming based on a Natural Deduction system. Seif Haridi (Thesis Report TRITA-CS-8104 TTDS/KTH 1981) [HaSa] An abstract machine for LPL0. Seif Haridi & Dan Sahlin (CSALAB TTDS/KTH Stockholm 1982) [HaSa2] Evaluation of logic programs based on Natural Deduction. Corrected Draft Seif Haridi & Dan Sahlin (CSALAB TTDS/KTH Stockholm June 1983) [HaSa3] KPROLOG - A new PROLOG interpreter. Seif Haridi & Dan Sahlin (Internal, CSALAB/INFOLOGICS Stockholm June 1984) [Han] A formal development of programs. .br .SW ]ke Hansson .br .US (Thesis, University of Stockholm 1980-01-25) [HanTa] A natural programming calculus. .br .SW ]ke Hansson & Sten-]ke T{rnlund .br .US (6th Int. Joint Conference on Artificial Intelligence, Tokyo, 20-24 August 1979) [Hau] A simulator for the or-parallel token machine. Bogdan Hausmann (CSALAB report, forthcoming) [Ka] Partial evaluation techniques for PROLOG. Kenneth M. Kahn UPMAIL (AI Magazine spring 1984) [Na] An introduction to MU-PROLOG. Lee Naish Technical Report 82/2 Department of Computer Science University of Melbourne [O'K] "Usenet-posting concerning prolog-syntax." Richard O'Keefe Dept. of Artificial Intelligence, Edinburgh Univ. Message-ID: <1810@sri-arpa.UUCP> [Sha] A subset of concurrent PROLOG and its interpreter. Ehud Shapiro ICOT Technical Report TR-003, February 1983 & Weizmann Institute Technical Report CS83-12, Aug.-83. [Wa] Implementing PROLOG, parts 1 & 2. David Warren (Dept. of AI, Edinburgh University. 1977) [Wa2] Logic programming and compiler writing. David Warren (Software Practice and Experience Vol 10, 97-125 1980) .FF .NOBIND .FILL .PROP .TITLE Appendix 1: Description of datastructures occuring in the LPL0-interpreter. .TITLE The sequential L-Machine for the PROLOG subset language LPL0 [HaSa]. The L-machine is here described using an abstract tree. The state transitions occurring during execution of an instruction could be viewed as functions taking an L-machine-state as input and returning another L-machine-state as result. The program storage is visible through the map of labels to names which enables the easy construction of code that can be executed by the existing assembler/linker/virtual machine. A detailed description of the machine is found in [HaSa]. .NOFILL .NOPROP L-Machine-State :: Registers PredMap PredToProve Registers = Ps SuccExit FailExit TeFr CurActFr CalActFr CurBtFr CalVars TailRecFl RestoreSt SeqNum GlFrSeqNum PredToProve :: Name ArgsList Ps :: Label SuccExit :: Label FailExit :: Label CurActFr :: ActFr CalActFr :: ActFr CurBtFr :: BtFr CalVars :: Data TailRecFl :: Bool SeqNum :: Integer GlFrSeqNum :: Integer RestoreSt :: RestoreElem* RestoreElem = (LVarFr | GVarFr) Offset .PROP .sp 1 .TITLE The domain of L-machine programs represented as an abstract tree. .FILL The programs that are executable by the L-machine are the well-formed members of the set PredMap. This set represents the knowledge base (or code sequences) plus one well formed top level predicate, the deduction of the proof of which is the purpose of the computation. The implied next instruction is either implicit in the instruction semantics /End, Return, Fail/ or explicit in the Cont field. The instruction LCALL and some other specialized instructions are not present in this description. .NOFILL .NOPROP PredMap :: Name -> Predicate Predicate :: Arity PredFunc Codespec Dataspec Codespec = Label -> Instr Dataspec = Label -> Data Instr = Call | LastCall | Enter | TFrame | LFrame | GFrame | Egen | EnterBody | End | Return | Fail | Cut | FirstChoice | Choice | LastChoice | Arithmetic CallI :: Op ArgsList Call :: CallI Cont LastCall :: CallI Enter :: Cont Egen :: ArgsList Cont EnterBody :: Cont End :: NIL Return :: NIL Fail :: NIL FirstChoice :: Op Cont Choice :: Op Cont LastChoice :: Op TFrame :: Size Cont LFrame :: Size Cont GFrame :: Size Cont Arithmetic = Uminus | Plus | Minus | Times | Div | Mod | Pow Uminus :: Arg Arg Cont Plus :: Arg Arg Arg Cont Minus :: Arg Arg Arg Cont Times :: Arg Arg Arg Cont Div :: Arg Arg Arg Cont Mod :: Arg Arg Arg Cont Pow :: Arg Arg Arg Cont Data = Constant | Datastructure | Var | Integer Datastructure = (DSTRUCT | FDSTRUCT) Name Size ArgsList Constant = CONST Name | FCONST Name Integer = INT Int | FINT Int Var = VVar | TVar | LVar | GVar VVar :: [Offset] TVar :: Offset LVar :: Offset GVar :: Offset ArgsList :: ArgsNo Arg* Size = NatInt ArgsNo = NatInt Arg = Label Cont = Label Op = Name PredFunc = P | F Name = Alpha+ Label = NatInt Offset = NatInt Arity = NatInt NatInt = < The set of natural numbers = { 0, 1, 2, 3 ... } > Int = < The set of all integers = { 0, -1, 1, -2, 2 ... } > .PROP .sp 1 .TITLE The objects allocated dynamically during the execution. .NOPROP ActFr :: SeqNum ContAf:ActFr Cont LVarFr GVarFr GVarFr :: GlSeqNum ConstructedTerm+ LVarFr :: SeqNum ConstructedTerm+ TeFr :: ConstructedTerm+ ConstructedTerm = Constant Name | Integer Int | DataStructure [GVarFr] | TVar TeFr | LVar LVarFr | GVar GVarFr | UNBOUND UNDEF | DataStructure ActFr GlSeqNum = NatInt SeqNum = NatInt BtFr :: SeqNum PrevBtFr:BtFr Cont FailExit CalVars (CurAf:ActFr | <>) (CalAf:ActFr | <>) (BtGlFrame:GlVarFrame | <>) ResetList:ResetElem* ResetElem :: (LVarFr | GVarFr) Offset .PROP .FILL The semantic functions of the instructions for the sequential machine are described in [HaSa]. A different approach is used in a more recent interpreter specified by Haridi and Sahlin [HaSa3]. .NOFILL .NOBIND .FF .TITLE Appendix 2: Scanner, parser, transformer, utilities and toplevel for all versions. .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/lexscanpars/abstract.lpl ============================================================================ .R /* Name: Syntax.lpl .SW Author: Thomas Sj|land .US Purpose: the predicate printabstract is an inverse parser/scanner for LPL0. Use: it can be used for debugging output. */ /* Prints the abstract tree with indentations. */ prettyabstract(s,n,d) <- nl() & wrblks(n) & (s=Goalform(c,f1,f2) & / & write('Goalform(') & write(c) & write(',') & prettyabstract(f1,n+d,d) & prettyabstract(f2,n+d,d) & write(')') or write(s)). /* Prints the abstract tree as close to source code as possible. */ printabstract([]). printabstract([h|t]) <- printabstract(h) & (t/=[] & write(',') or t=[]) & printabstract(t). printabstract(Prog(rdefs,schdefs)) <- nl() & write('Program:') & nl() & write('Relation Definitions:') & nl() & printabstract(Relations(rdefs)) & write('Schema Definitions.') & nl() & printabstract(Schemas(schdefs)). printabstract(Relations([])). printabstract(Relations([[rname,brdef,frdef]|t])) <- nl() & write('Relation:') & writeln(rname) & writeln('Backward definitions:') & printabstract(brdef) & nl() & writeln('Forward Definitions:') & printabstract(frdef) & nl() & (t/=[] & printabstract(Relations(t)) or t=[] & nl()). printabstract(Schemas([])). printabstract(Schemas([[schname,brdef,frdef]|t])) <- nl() & write('Schema:') & writeln(schname) & writeln('Backward definitions:') & printabstract(brdef) & nl() & writeln('Forward Definitions:') & printabstract(frdef) & nl() & (t/=[] & printabstract(Schemas(t)) or t=[] & nl()). printabstract(Assert(varnames,terms)) <- write(' Assertion: ') & write('Vars:') & printabstract(varnames) & write('Terms:') & printabstract(terms) & nl(). printabstract(Limp(varnames,terms,formula)) <- write(' Limp: ') & write('Vars:') & printabstract(varnames) & write('Terms:') & printabstract(terms) & nl() & write('Body:') & printabstract(formula) & nl(). printabstract(Rimp(varnames,terms,formula)) <- write(' Rimp: ') & write('Vars:') & printabstract(varnames) & write('Terms:') & printabstract(terms) & nl() & write('Body:') & printabstract(formula) & nl(). printabstract(Atomic(relname,terms,funcpred)) <- /* write(funcpred) & write(':') & */ printabstract(relname) & write('(') & printabstract(terms) & write(')'). printabstract(Goalform(connective,formula1,formula2)) <- write('(') & printabstract(formula1) & write(' ') & write(connective) & write(' ') & printabstract(formula2) & write(')'). printabstract(All(varnames,formula)) <- write('(A:') & printabstract(varnames) & write(')') & printabstract(formula). printabstract(Exist(varnames,formula)) <- write('(E:') & printabstract(varnames) & write(')') & printabstract(formula). printabstract(Schema(schname,relnames,terms,funcpred)) <- /* write(funcpred) & write(':') & */ printabstract(schname) & write('(') & printabstract(relnames) & write(')(') & printabstract(terms) & write(')'). printabstract(Var(varname)) <- printabstract(varname). printabstract(Dstruct(dstructname,terms)) <- printabstract(dstructname) & ( terms=[] or write('(') & printabstract(terms) & write(')')). printabstract(Function(funcname,terms)) <- printabstract(funcname) & write('(') & printabstract(terms) & write(')'). printabstract(Constant(constname)) <- printabstract(constname). printabstract(Int(number)) <- printabstract(number). printabstract(Name(ident,typeinfo)) <- typeinfo=System & write('$') & printabstract(ident) or typeinfo=Void & write('_#'(ident)) or typeinfo=Special & write('#') & printabstract(ident) or typeinfo=User & printabstract(ident). printabstract(Predid(i)) <- write(i). printabstract(Varid(i)) <- write(i). printabstract(Constid(i)) <- write(i). printabstract(Funcid(i)) <- write(i). printabstract(Schid(i)) <- write(i). printabstract(CUT) <- write(CUT). printabstract('false') <- write('false'). printabstract(TRUE) <- write(TRUE). printabstract(NIL) <- write('[]'). printabstract('.') <- write('.'). printabstract('=') <- write('='). printabstract('/=') <- write('/='). printabstract('_') <- write('_'). printabstract(x) <- write('{') & write(x) & write('}'). .FF .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/lexscanpars/lextools.lpl ============================================================================ .R /* Tools for constructing lexical analyser in logic. */ true(). length([_|t])=1+length(t). length([])=0. writeln(x) <- write(x) & nl(). wrlist([f|t]) <- put(f) & wrlist(t). wrlist([]). writelist([f|t]) <- nl() & put(#') & write(f) & put(#') & writelist(t). writelist([]). wrblks(n) <- n>0 & put(32) & wrblks(n-1). wrblks(0). tab(0). tab(i) <- i>0 & put(9) & tab(i-1). wrdifflist(l,r) <- wrlist(difflist(l,r)). difflist(l,l)=[]. difflist([h|t],r)=[h|difflist(t,r)]. diffwriteln(l,r) <- writeln(difflist(l,r)). ascii(LF)=10. ascii(CR)=13. ascii(BLANK)=32. ascii(TAB)=9. isdigit(s) <- s>=#0 & s<=#9. isnondigit(s) <- s<#0 or s>#9. isuppercase(s) <- s>=#A & s<=#Z. isnonuppercase(s) <- s<#A or s>#Z. islowercase(s) <- s>=#a & s<=#z. isnonlowercase(s) <- s<#a or s>#z. /* Identifies integer. */ isinteger([h|t1],[h|t3],t2) <- isdigit(h) & isnumber(t1,t3,t2). isnumber([h|t1],[],[h|t1]) <- isnondigit(h). isnumber([h|t1],[h|t3],t2) <- isdigit(h) & isnumber(t1,t3,t2). /* Utility routines. */ isnonletter(x) <- isnonuppercase(x) & isnonlowercase(x). delimiter(x) <- isnondigit(x) & isnonletter(x) & x/=#_ & x/=#:. not_delimiter(x) <- delimiter(x) & / & false. not_delimiter(_). next_delimiter([a|r],[],[a|r]) <- delimiter(a). next_delimiter([a|r1],[a|r3],r2) <- a/=#: & not_delimiter(a) & next_delimiter(r1,r3,r2). next_delimiter([#:|r],[#:],r). /* ------------------------------------------------------------------ */ /* Definitions needed for higher order functions. */ relation(Rlist1(p),x) <- list1(p,x) & /. /* Definitions of map operations. */ map([p1,p2],y,z) <- list(p1,y) & list(p2,z) & uniquel(y) & length(y)=m & length(z)=m. map_access([[hx|tx],[hy|ty]],e,v) <- ((e=hx & v=hy) or map_access([tx,ty],e,v)). update(l1,l2,l3,l4,e,v) <- l1=[] & l2=[] & l3=[e] & l4=[v] or l1=[h1|t1] & l2=[h2|t2] & ( h1=e & l3=l1 & l4=[v|t2] or h1/=e & l3=[h1|t3] & l4=[h2|t4] & update(t1,t2,t3,t4,e,v)). map_update([l1,l2],[l3,l4],e,v) <- update(l1,l2,l3,l4,e,v). uniquel([h|t]) <- not_member(h,t) & uniquel(t). uniquel([]). list(_,[]). list(p,[h|t]) <- relation(p,h) & list(p,t). list1(p,[h|t]) <- relation(p,h) & list(p,t). not_member(_,[]) <- /. not_member(x,[h|t]) <- x/=h & not_member(x,t). member(x,[x|_]). member(x,[_|t]) <- member(x,t). a_list([]) <- /. a_list([_|t]) <- a_list(t). not_a_list(l) <- a_list(l) & / & false. not_a_list(_). append([],y,y). append([x|y],z,[x|p]) <- append(y,z,p). fappend(x,y)=z <- append(x,y,z). rev([],y,y). rev([x1|x],y,w) <- rev(x,[x1|y],w). reverse(x,z) <- rev(x,[],z). freverse(l)=l1 <- reverse(l,l1). lastelement([x])=x <- /. lastelement([_|t])=lastelement(t). flatten([])=[]. flatten([x|y])=z <- flatten(y)=t & (a_list(x) & / & flatten(x)=s & append(s,t,z) or not_a_list(x) & append([x],t,z)). /* unique_list(l) returns a list where each element occurs only once. */ unique_list([])=[]. unique_list([h|t])=[h|unique_list(t)] <- not_member(h,t). unique_list([h|t])=unique_list(t) <- member(h,t). /* unique_flat_list(l) returns a unique flat list. */ unique_flat_list(l)=unique_list(flatten(l)). letter(x) <- (x>=#A & x<=#Z or x>=#a & x<=#z). /* Conversion between positive integers and lists of ascii-characters. */ itoa(i)=freverse(itoa0(i)) <- i>=0. itoa0(i)=[ i mod 10 + 48 | itoa0(i/10) ] <- i>=10. itoa0(i)=[ i + 48 ] <- i<10. atoi(l)=atoi0(l,0) <- l=[_|_]. atoi0([],i)=i. atoi0([h|t],i)=atoi0(t,h-48+i*10) <- isdigit(h). index(i,[_|t],n) <- i>1 & index(i-1,t,n). index(1,[n|_],n). insert(e,l)=l0 <- member(e,l) & l0=l & / or l0=[e|l]. prlist([h|t]) <- (letter(h) & put(h) & / or put(#\) & put(h)) & prlist(t). prlist([]). .FF .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/lexscanpars/parser.lpl ============================================================================ .R /* Parser for General Logic Statements. TS 83 09 07 */ is_statement(x,y,s) <- is_formula(x,z,s,5) & is_dot(z,y). is_dot(['.'|r],r). is_formula(x,y,f,n) <- n>0 & is_formula(x,u,f1,n-1) & (is_connective(u,v,c,n,_) & is_formula(v,y,f2,n) & f=Goalform(c,f1,f2) or f1=f & y=u). is_formula(x,y,f,0) <- is_false(x,y,f) & / or is_cut(x,y,f) & / or is_atomic(x,y,f) /* NB! No CUT here ! */ or is_lpar(x,z) & is_formula(z,u,f,5) & is_rpar(u,y) & / or is_not(x,z) & is_formula(z,y,f1,0) & f=Goalform('->',f1,Atomic('false',[],Pred)) & / or is_quantform(x,y,f) & / or is_schema(x,y,f) or is_otherwise(x,y,f). is_atomic(x,y,Atomic(r,tl,Pred)) <- is_predid(x,z,r) & is_lpar(z,u) & is_termlist(u,v,tl) & is_rpar(v,y) or is_term(x,z,t1) & is_cmpoper(z,u,r) & is_term(u,y,t2) & tl=[t1,t2]. is_quantform(x,y,Allform(avars,f)) <- is_avarlist(x,z,avars) & is_formula(z,y,f,0). is_quantform(x,y,Existform(evars,f)) <- is_evarlist(x,z,evars) & is_formula(z,y,f,0). is_avarlist(x,y,al) <- is_avars(x,z,fq) & (is_avarlist(z,y,rq) or z=y & rq=[]) & al=flatten([fq|rq]). is_avars(x,y,vl) <- is_all(x,z) & is_varlist(z,y,vl). is_evarlist(x,y,el) <- is_evars(x,z,fq) & (is_evarlist(z,y,rq) or z=y & rq=[]) & el=flatten([fq|rq]). is_evars(x,y,vl) <- is_exist(x,z) & is_varlist(z,y,vl). is_schema(x,y,Schema(id,pvars,vars,Pred)) <- is_schid(x,z,id) & is_lpar(z,u) & is_varlist(u,v,pvars) & is_rpar(v,w) & is_lpar(w,q) & is_termlist(q,r,vars) & is_rpar(r,y). is_termlist(x,x,[]). is_termlist(x,y,[ft|tl]) <- is_term(x,z,ft) & (is_comma(z,u) & is_termlist(u,y,tl) or z=y & tl=[]). is_cterm(x,y,t) <- is_var(x,y,t) or is_int(x,y,t) or is_dstruct(x,y,t) or is_function(x,y,t). is_term(x,y,t) <- is_aritexpr(x,y,t1,4) & t=aritfunc(t1). is_dstruct(x,y,d) <- is_dsid(x,z,dname) & is_lpar(z,u) & is_termlist(u,v,tl) & is_rpar(v,y) & d=Dstruct(dname,tl) or is_list(x,y,d) or is_constid(x,y,dname) & d=Dstruct(dname,[]) or is_dlist(x,y,d). is_dlist(x,y,Dstruct(Name(Constid(DLIST),System),[first,last])) <- is_ldldel(x,z) & is_term(z,u,first) & is_comma(u,v) & is_term(v,w,last) & is_rdldel(w,y). is_list(x,y,l) <- is_lldel(x,z) & is_listcont(z,v,l) & is_rldel(v,y). is_listcont(x,y,l) <- is_listelem(x,z,e) & (is_comma(z,v) & is_listcont(v,y,r) or is_tailsym(z,v) & is_listelem(v,y,r) or z=y & r=Dstruct(NIL,[])) & l=Dstruct('.',[e,r]) or x=y & l=Dstruct(NIL,[]). is_listelem(x,y,e) <- is_term(x,y,e). is_function(x,y,Function(fid,tl)) <- is_funcid(x,z,fid) & is_lpar(z,u) & (is_termlist(u,v,tl) or u=v & tl=[]) & is_rpar(v,y). is_varlist(x,y,vl) <- is_var(x,z,fv) & (is_comma(z,u) & is_varlist(u,y,rv) or z=y & rv=[]) & vl=flatten([fv|rv]). is_var(x,y,Var(v)) <- is_void(x,y,v) or is_varid(x,y,v). is_aritexpr(x,y,ae,n) <- n>0 & is_aritexpr(x,u,ae1,n-1) & (is_aritoper(u,v,o,n,_) & is_aritexpr(v,y,ae2,n) & ae=Ae(o,ae1,ae2) or ae=ae1 & y=u). is_aritexpr(x,y,ae,0) <- is_lpar(x,z) & is_aritexpr(z,u,ae1,4) & is_rpar(u,y) & ae=Sae(ae1) & / or is_cterm(x,y,ae) /* No CUT here ! */ or is_unary(x,z,u) & is_cterm(z,y,ae1) & (ae1=Int(i) & (u='-' & ae=Int(-i) or u='+' & ae=ae1) or ae1/=Int(_) & ae=Ae(u,Int(0),ae1)). is_connective(['&'|r],r,'&',1,R). is_connective([','|r],r,'&',1,R). is_connective([Varid('and')|r],r,'&',1,R). is_connective(['or'|r],r,'or',2,R). is_connective(['<-'|r],r,'<-',3,R). is_connective(['->'|r],r,'->',4,R). is_connective(['<->'|r],r,'<->',5,R). is_cmpoper([o|r],r,o) <- o='<' or o='<=' or o='=' or o='/=' or o='>=' or o='>'. is_aritoper(['+'|r],r,'+',4,L). is_aritoper(['-'|r],r,'-',3,L). is_aritoper(['*'|r],r,'*',2,L). is_aritoper(['/'|r],r,'/',2,L). is_aritoper(['mod'|r],r,'mod',2,L). is_aritoper(['^'|r],r,'^',1,R). is_unary(['+'|r],r,'+'). is_unary(['-'|r],r,'-'). /* is_unary(['+'|r],r,'U+'). is_unary(['-'|r],r,'U-'). */ /* Transform Tree into Leftassociative form. */ aritfunc(x)=x <- x/=Ae(_,_,_) & x/=Sae(_). aritfunc(Sae(x))=aritfunc(x). aritfunc(Ae(o,l,r))=Function(o,[aritfunc(l),aritfunc(r)]) <- raop(o) or laop(o) & pri(o)/=pri(root(r)). aritfunc(Ae(o1,l1,Ae(o2,l2,r2)))=aritfunc(Ae(o2,Ae(o1,l1,l2),r2)) <- laop(o1) & laop(o2) & pri(o1)=pri(o2). raop(o) <- is_aritoper(_,_,o,_,R). laop(o) <- is_aritoper(_,_,o,_,L). pri(o)=n <- is_aritoper(_,_,o,n,_). pri(Leaf)=0. root(Ae(o,_,_))=o. root(x)=Leaf <- x/=Ae(_,_,_). is_otherwise([Otherwise|r],r,Atomic(Name(Otherwise,System),[],Pred)). is_false(['false'|r],r,Atomic(Name('false',System),[],Pred)). is_cut(['/'|r],r,Atomic(Name(CUT,System),[],Pred)). is_not(['not'|r],r). is_void(['_'|r],r,Name(Varid(_),Void)). is_exist(['E:'|r],r). is_all(['A:'|r],r). is_predid([Varid(i)|r],r,Name(Predid(i),User)). is_schid([Varid(i)|r],r,Name(Schid(i),User)). is_varid([i|r],r,Name(i,User)) <- i=Varid(_). is_funcid([Varid(i)|r],r,Name(Funcid(i),User)). is_constid([i|r],r,Name(i,User)) <- i=Constid(_). is_dsid([i|r],r,Name(i,User)) <- i=Constid(_). is_int([i|r],r,i) <- i=Int(_). is_lpar(['('|r],r). is_rpar([')'|r],r). is_lldel(['['|r],r). is_lldel(['('|r],r). is_rldel([']'|r],r). is_rldel([')'|r],r). is_ldldel(['<'|r],r). is_rdldel(['>'|r],r). is_comma([','|r],r). is_tailsym(['|'|r],r). .FF .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/lexscanpars/scanner.lpl ============================================================================ .R /* Translate characterlist to tokenlist for one statement. 83 09 01 */ token_list([c|r1],r,t) <- (c=ascii(BLANK) or c=ascii(LF) or c=ascii(TAB)) & / & token_list(r1,r,t). token_list([#/,#*|r1],r,t) <- after_eoc(r1,r2) & / & token_list(r2,r,t). token_list([#"|r],r1,['['|t]) <- / & char_list(r,r1,t1) & (t1=[','|t] & / or t1=t). token_list([#.|r],r,['.']) <- /. /* This token marks the end of a stream of characters. It can be used to switch between an input mode and a top level mode in an interpreter. */ token_list([#@|r],r,[]) <- /. /* EOF */ token_list([],[],[]). token_list([x],[],[]) <- -1=x. token_list(l,r,[ft|rt]) <- (token(l,rl,ft) & / & token_list(rl,r,rt) or nl() & write(' Not a token:'(l)) & wrlist(l)). after_eoc([#*,#/|r],r). after_eoc([_|r],r1) <- after_eoc(r,r1). char_list([#"|r],r1,[']'|t]) <- token_list(r,r1,t). char_list([x|r],r1,t) <- x/=#" & t=[',',Int(x)|t1] & char_list(r,r1,t1). token(l,r,t) <- varident(l,r,id) & (not_reserved(id) & name(t1,[#$|id]) & atom(t1) & t=Varid(t1) or reserved(id,t)). token(l,r,t) <- constident(l,r,id) & (not_reserved(id) & name(t1,[#$|id]) & atom(t1) & t=Constid(t1) or reserved(id,t)). token([#'|r1],r,t) <- next_blip(r1,id,r) & name(t1,[#$|id]) & atom(t1) & t=Constid(t1). token(l,r,Int(t1)) <- isinteger(l,id,r) & name(t1,id). token([#(|r],r,'('). token([#)|r],r,')'). token([#,|r],r,',') <- r=[a|_] & a/=#.. token([#<,#-,#>|r],r,'<->'). token([#<,#-|r],r,'<-') <- r=[a|_] & a/=#>. token([#-,#>|r],r,'->'). token([#&|r],r,'&'). token([#;|r],r,'or'). token([#[|r],r,'['). token([#]|r],r,']'). token([#||r],r,'|'). token([#,,#.,#.|r],r,'|'). token([#_|r],r,'_'). token([#+|r],r,'+'). token([#-|r],r,'-') <- r=[a|_] & a/=#>. token([#*|r],r,'*'). token([#/|r],r,'/') <- r=[a|_] & a/=#=. token([#^|r],r,'^'). token([#<|r],r,'<') <- r=[a|_] & a/=#- & a/=#=. token([#>|r],r,'>') <- r=[a|_] & a/=#=. token([#=|r],r,'='). token([#/,#=|r],r,'/='). token([#<,#=|r],r,'<='). token([#>,#=|r],r,'>='). token([##,x|r],r,Int(x)). not_reserved(id) <- reserved(id,_) & / & false. not_reserved(_). reserved("otherwise",Otherwise). reserved("not",'not'). reserved("false",'false'). reserved("A:",'A:'). reserved("E:",'E:'). reserved("and",'&'). reserved("or",'or'). reserved("if",'<-'). reserved("onlyif",'->'). reserved("iff",'<->'). reserved("mod",'mod'). constident([a|r1],r2,[a|id]) <- isuppercase(a) & next_delimiter(r1,id,r2). varident([a|r1],r2,id) <- islowercase(a) & next_delimiter(r1,id1,r2) & id=[a|id1]. next_blip(l,[],[b|r]) <- l=[#',b|r] & b/=#'. next_blip([#',#'|r1],[#'|r3],r2) <- next_blip(r1,r3,r2). next_blip([a|r1],[a|r3],r2) <- a/=#' & next_blip(r1,r3,r2). /* ------------------------------------------------------------------ */ /* Wellformedness-tests to check scanner and parser. */ wf_tokenlist([h|t]) <- wf_token(h) & / & wf_tokenlist(t). wf_tokenlist([]). wf_statement(_). wf_code(_). wf_token('.'). wf_token(','). wf_token('&'). wf_token('or'). wf_token('not'). wf_token('E:'). wf_token('A:'). wf_token('['). wf_token(']'). wf_token('|'). wf_token(':'). wf_token('('). wf_token(')'). wf_token('+'). wf_token('-'). wf_token('*'). wf_token('/'). wf_token('^'). wf_token('mod'). wf_token('<'). wf_token('>'). wf_token('='). wf_token('/='). wf_token('<='). wf_token('>='). wf_token('<->'). wf_token('<-'). wf_token('->'). wf_token(Int(x)) <- integer(x). wf_token(Constid(x)) <- atom(x). wf_token(Varid(x)) <- atom(x). wf_token('_'). wf_token('false'). wf_token(x) <- write(x) & writeln(' is not a token,') & name(x,n) & writeln(Ascii(n)) & false. .FF .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/lexscanpars/toplevel.lpl ============================================================================ .R /* toplevel.lpl desc: toplevel for logic parser/transformer/codegenerator .SW author: Thomas Sj|land, CSALAB .US */ prog() <- char_infile([],0)=l & (true() or writeln('parsprog failed') & debug(5)) & parsprog(l,_) & /. parsprog(l,Prog(rdefs,schdefs)) <- parsall(l,[],[],rdefs,schdefs,_). parsall(l,rdefsin,schdefsin,rdefsout,schdefsout,previous) <- parspred(l,r,f,n,type) & / & ( type=Reldef & n=previous & / & deftabupdate(rdefsin,rdefstmp,n,f) & parsall(r,rdefstmp,schdefsin,rdefsout,schdefsout,n) or type=Reldef & n/=previous & / & printcode(rdefsin,previous) & deftabupdate([],rdefstmp,n,f) & parsall(r,rdefstmp,schdefsin,rdefsout,schdefsout,n) or type=Schdef & / & deftabupdate(schdefsin,schdefstmp,n,f) & parsall(r,rdefsin,schdefstmp,rdefsout,schdefsout,n) or type=EOF & / & printcode(rdefsin,previous) & rdefsout=[] & schdefsout=schdefsin & / or type=ERROR & / & writeln(' -------- Parsing error'(previous,n)) & printcode(rdefsin,previous) & parsall(r,[],schdefsin,rdefsout,schdefsout,n) ). deftabupdate([h0|t0],[h1|t1],n,f) <- h0=[n,brdefs,frdefs] & / & ( (f=Limp(_,_,_) or f=Assert(_,_)) & / & insert(f,brdefs)=brdefs0 & frdefs=frdefs0 or f=Rimp(_,_,_) & insert(f,frdefs)=frdefs0 & brdefs=brdefs0 ) & t1=t0 & h1=[n,brdefs0,frdefs0] or h1=h0 & deftabupdate(t0,t1,n,f). deftabupdate([],[[n,bdefs,fdefs]],n,f) <- (f=Limp(_,_,_) or f=Assert(_,_)) & / & bdefs=[f] & fdefs=[] or f=Rimp(_,_,_) & fdefs=[f] & bdefs=[]. parspred(l,r,f,n,type) <- scan(l,r,tokens) & / & (tokens/=[] & (true() or writeln('parse failed.') & debug(4)) & parse(tokens,s) & / & (enumvoidvars(s,0,_) or writeln('enumvoidvars failed.') & false) & (s0=transform(s) or writeln('transform failed.') & false) & (vars=extractvars(s0,[]) or writeln('extractvars failed.') & false) & (s0=Atomic(n,tl,_) & f=Assert(vars,tl) or (ifsym='<-' or ifsym='<->' or ifsym=Varid('if') or ifsym=Varid('iff') ) & s0=Goalform(ifsym,Atomic(n,tl,_),body) & f=Limp(vars,tl,body)) & type=Reldef or tokens=[] & type=EOF) & / or type=ERROR. /* Extracts the variable from a formula. */ extractvars(Atomic(_,tl,_),p)=extractvars(tl,p). extractvars(Goalform(_,f1,f2),p)=extractvars(f2,extractvars(f1,p)). extractvars([],p)=p. extractvars([x|t],p)=extractvars(t,p0) <- x=Dstruct(_,tl) & p0=extractvars(tl,p) & / or x=Var(_) & / & (member(x,p) & p0=p & / or p0=[x|p]) & / or p=p0. scan(l,r,tl) <- token_list(l,r,tl) & / or write('The statement contained an illegal token.'). parse(l,s) <- is_statement(l,[],s) & / or wf_tokenlist(l) & writeln('The syntax of this statement is illegal:') & nl() & writelist(l) & false. enumvoidvars(f,n,m) <- (f=Atomic(_,x,_) or f=Schema(_,_,x,_) or f=All(_,x) or f=Exist(_,x) or f=Dstruct(_,x) or f=Function(_,x)) & / & enumvoidvars(x,n,m) or f=Goalform(_,f0,f1) & / & enumvoidvars(f0,n,n0) & enumvoidvars(f1,n0,m) or (f=Constant(_) or f=Int(_) or f=[]) & m=n & / or f=Var(Name(Varid(nm),type)) & (type/=Void & m=n or type=Void & name(nm,[#$,#s,#y,#s,#V|itoa(n)]) & m=n+1) & / or f=[h|t] & enumvoidvars(h,n,n0) & enumvoidvars(t,n0,m). .FF .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/lexscanpars/transform.lpl ============================================================================ .R /* transform.lpl .SW Author: Thomas Sj|land, .US Purpose: contains various LPL0-clauses to be used in the translation into normal form and the optimizing phase of the LPL0-compiler. */ /* Transform a formula to a normal and optimized form. */ transform(s)=andor(removeeqs(extracteqs(funcstopreds(s1a)))) <- fefuns(funchtopredh(s),[])=[s1,_] & funcsinhead(s1,s1a). /* transform(s)=s5 <- funchtopredh(s)=s0 & writeln(' Function definitions converted to predicate form:') & printabstract(s0) & writeln('.') & / & fefuns(s0,[])=[s1,_] & writeln(' Nested function calls unfolded:') & printabstract(s1) & writeln('.') & / & funcsinhead(s1,s1a) & / & writeln(' Functions in head transferred to body:') & printabstract(s1a) & writeln('.') & / & funcstopreds(s1a)=s2 & writeln(' Function calls converted to predicate form:') & printabstract(s2) & writeln('.') & / & s3=extracteqs(s2) & writeln(' Equal variables replaced:') & printabstract(s3) & writeln('.') & / & writeln('Redundant equalities removed:') & s4=removeeqs(s3) & printabstract(s4) & writeln('.') & / & s5=andor(s4) & writeln('Andored:') & printabstract(s5) & writeln('.') & /. */ /* Translate the map from variables to functions to a formula. */ mapformula([],f)=f. mapformula([h|t],f)=Goalform('&',Atomic('=',h,Pred),mapformula(t,f)). /* Extract nested functions from a Formula and store them in a map. */ /* Type: termlist tl, ntl; map(varname,function) map, nmap */ fefuns(Atomic(n,tl,fp),map)= [mapformula(freverse(difflist(nmap,map)),Atomic(n,ntl,fp)),nmap] <- efuns(tl,map,[ntl,nmap]). fefuns(Goalform(c,f1,f2),map)=[Goalform(c,nf1,nf2),nmap] <- fefuns(f1,map)=[nf1,map0] & fefuns(f2,map0)=[nf2,nmap]. fefuns(All(vl,f),map)=[All(vl,nf),nmap] <- fefuns(f,map)=[nf,nmap]. fefuns(Exist(vl,f),map)=[Exist(vl,nf),nmap] <- fefuns(f,map)=[nf,nmap]. fefuns(Schema(n,rnl,tl,fp),map)= [mapformula(difflist(nmap,map),Schema(n,rnl,ntl,fp)),nmap] <- efuns(tl,map,[ntl,nmap]). /* Extract functions from a termlist. */ /* Type: termlist tl, ntl ; map(varname,function) map,nmap */ efuns([h|t],map,[[h|nt],nmap]) <- (h=Var(_) or h=Constant(_) or h=Int(_)) & / & efuns(t,map,[nt,nmap]). efuns([Dstruct(n,dtl)|t],map,[[Dstruct(n,dtl1)|nt],nmap]) <- efuns(dtl,map,[dtl1,map0]) & efuns(t,map0,[nt,nmap]). efuns([Function(n,ftl)|t],map,[[nm|nt],nmap]) <- efuns(ftl,map,[ftl1,map0]) & funmapupdate(map0,Function(n,ftl1),[nm,map1]) & efuns(t,map1,[nt,nmap]). efuns([],map,[[],map]). funmapupdate(map,fun,[nam,map0]) <- member([fun,nam],map) & map0=map or nam=uniquename(map) & map0=[[fun,nam]|map]. uniquename(map)=Var(Name(Varid(highestsysvarno(map,0)+1),System)). highestsysvarno([],a)=a. highestsysvarno([[_,nam]|t],a)=v <- nam=Var(Name(Varid(i),System)) & (i>a & v=i or v=a) & / or v=highestsysvarno(t,a). /* funchtopredh converts a function definition to predicate form. */ funchtopredh(Goalform(ifsym,Atomic('=',[Function(f,tl),r],_),b)) =Goalform(ifsym,Atomic(f,fappend(tl,[Var(Name(Varid(RESULT),System))]),Func), Goalform('&',b, Goalform('&',Atomic('=',[Var(Name(Varid(RESULT),System)),r],Pred), Atomic(Name(CUT,System),[],Pred)))) <- ifsym='<-' or ifsym='<->'. funchtopredh(Atomic('=',[Function(f,tl),r],_)) =Goalform('<-',Atomic(f,fappend(tl,[Var(Name(Varid(RESULT),System))]),Func), Goalform('&',Atomic('=',[Var(Name(Varid(RESULT),System)),r],Pred), Atomic(Name(CUT,System),[],Pred))). funchtopredh(x)=x <- otherwise. funcsinhead(Goalform(ifsym,h,b), Goalform(ifsym,nh,Goalform('&',fh,b))) <- (ifsym='<-' or ifsym='<->') & extracthead(h,[nh,fh]). funcsinhead(f,Goalform(ifsym,nh,fh)) <- (ifsym='<-' or ifsym='<->') & f=Goalform('&',_,_) & extracthead(f,[nh,fh]). funcsinhead(x,x) <- (ifsym='<-' or ifsym='<->') & x=Goalform(ifsym,Atomic(_,_,_),_) or x=Atomic(_,_,_). extracthead(Goalform('&',l,r),[h,fh]) <- r=Atomic(_,_,_) & h=r & fh=l or r=Goalform('&',_,_) & fh=Goalform('&',l,r0) & extracthead(r,[h,r0]). /* extracthead(x,_) <- write('extracthead failed on:') & prettyabstract(x,0,2) & false. */ /* funcstopreds converts equalities representing functional calls to predicate calls in a formula. */ funcstopreds(Atomic('=',[Function(f,tl),r],_))=Atomic(f,fappend(tl,[r]),Func). funcstopreds(Atomic('=',[r,Function(f,tl)],_))=Atomic(f,fappend(tl,[r]),Func) <- r/=Function(_,_). funcstopreds(Goalform(c,f1,f2))=Goalform(c,funcstopreds(f1),funcstopreds(f2)). funcstopreds(All(vs,f))=All(vs,funcstopreds(f)). funcstopreds(Exist(vs,f))=Exist(vs,funcstopreds(f)). funcstopreds(f)=f <- otherwise. /* clause -> clause */ extracteqs(f0)=f <- collecteqs(f0,[],m) & replaceeqs(f0,fixvarmap(m))=f. /* map -> map */ fixvarmap([])=[]. fixvarmap([[v0,v1]|t])=[h|fixvarmap(t)] <- v0=Var(Name(_,User)) & h=[v0,v1] & / or v1=Var(Name(_,User)) & h=[v1,v0] & / or h=[v0,v1]. /* clause -> map */ collecteqs(Atomic('=',[t1,t2],_),map0,map1) <- t1=Var(v1) & t2=Var(v2) & v1/=v2 & not_member([t1,t2],map0) & not_member([t2,t1],map0) & map1=[[t1,t2]|map0] & /. collecteqs(Goalform(c,f00,f01),map0,map1) <- c/='or' & collecteqs(f00,map0,mapt) & collecteqs(f01,mapt,map1). collecteqs(_,map,map). /* clause map -> clause */ replaceeqs(Atomic(n,tl,fp),m)=Atomic(n,tl1,fp) <- treplaceeqs(tl,m)=tl1. replaceeqs(Schema(sn,rn,tl,fp),m)=Schema(sn,rn,tl1,fp) <- treplaceeqs(tl,m)=tl1. replaceeqs(Goalform(c,f00,f01),m)=Goalform(c,f10,f11) <- c/='or' & replaceeqs(f00,m)=f10 & replaceeqs(f01,m)=f11. replaceeqs(Goalform('or',f00,f01),m)=Goalform('or',f10,f11) <- f10=replaceeqs(f00,m) & f11=replaceeqs(f01,m). replaceeqs(f,_)=f <- otherwise. /* terms map -> terms */ treplaceeqs([],_)=[]. treplaceeqs([h|t],m)=[h1|treplaceeqs(t,m)] <- h=Var(_) & (member([h1,h],m) & / or h1=h) or h=Dstruct(n,tl) & h1=Dstruct(n,treplaceeqs(tl,m)) or h=Function(n,tl) & h1=Function(n,treplaceeqs(tl,m)) or h=Constant(_) & h1=h or h=Int(_) & h1=h. /* formula -> formula */ removeeqs(Atomic('=',[x,x],_))=Atomic(Name(TRUE,System),[],Pred). removeeqs(Goalform('&',f0,f1))=f2 <- removeeqs(f0)=rf0 & removeeqs(f1)=rf1 & (rf0=Atomic(Name(TRUE,System),[],Pred) & f2=rf1 & / or rf1=Atomic(Name(TRUE,System),[],Pred) & f2=rf0 & / or f2=Goalform('&',rf0,rf1)). removeeqs(Goalform(c,f0,f1))=Goalform(c,removeeqs(f0),removeeqs(f1)) <- c/='&'. removeeqs(x)=x <- otherwise. /* andor converts an andor tree to the right adjusted form. */ /* formula -> formula */ andor(x)=x <- x=Atomic(_,_,_). andor(Goalform(c,Goalform(c,f1,f2),f3))= andor(Goalform(c,f1,Goalform(c,f2,f3))) <- (c='&' or c='or'). andor(Goalform(c,f1,f2))=Goalform(c,andor(f1),andor(f2)) <- f1/=Goalform(c,_,_) & (c='&' or c='or'). andor(Goalform(c,f1,f2))=Goalform(c,andor(f1),andor(f2)) <- c/='&' & c/='or'. .FF .TITLE Appendix 3: codegenerator for LPL0. .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/src/display.lpl ============================================================================ .R /* display.lpl routines for printing out the code produced by the LPL0-compiler in ASCII-format. */ displaycode([h|t]) <- display(h) & / & displaycode(t). displaycode([]) <- nl(). displaycode(others) <- writeln(others). display(Name(Predid(n),_)) <- write('#') & wrname(n) & write(': '). display(Name(Funcid(n),_)) <- write('#') & wrname(n) & write(': '). display(RELDEF(n)) <- write('RELDEF ') & writeln(n). display(FUNCDEF(n,a)) <- write('FUNCDEF ') & write(n) & write(' ') & writeln(a). display(FIRSTCHOICE([_,l])) <- write('FIRSTCHOICE ') & write('#') & writeln(l). display(CHOICE([_,l])) <- write('CHOICE ') & write('#') & writeln(l). display(LASTCHOICE([_,l])) <- write('LASTCHOICE ') & write('#') & writeln(l). display(Lbl([_,l])) <- write('#') & write(l) & write(': '). display(GFRAME(n)) <- write('GFRAME ') & writeln(n). display(EGEN(l,t)) <- write('EGEN ') & write(l) & wrlbls(t). display(Cut([_,c])) <- write(CUT) & write(' #') & writeln(c). display(CALL(Lbl([_,l]),p,n,t)) <- write('CALL ') & write('#') & write(l) & write(',') & wrname(p) & write(',') & write(n) & wrlbls(t). display(LCALL(p,n,t)) <- write('LCALL ') & wrname(p) & write(',') & write(n) & wrlbls(t). display(LASTCALL(p,n,t)) <- write('LASTCALL ') & wrname(p) & write(',') & write(n) & wrlbls(t). display(SPECIAL(i,Lbl([_,l]),n,t)) <- write(i) & write(' #') & write(l) & write(',') & write(n) & wrlbls(t). display(TRACE(n)) <- write('TRACE ') & wrname(n) & nl(). display(GVAR(i,_)) <- write('GVAR ') & writeln(i). display(Dstruct('.',t)) <- write(DSTRUCT) & write(' #') & put(#\) & write('#list ') & write(',') & lt=length(t) & write(lt+1) & write(',') & write(lt) & wrlbls(t). display(Dstruct(NIL,[])) <- writeln('CONST #Nil'). display(Int(n)) <- write('INT ') & writeln(n). display(Dstruct(Name(Constid(n),_),t)) <- t/=[] & write(DSTRUCT) & write(' #') & wrname(n) & write(',') & lt=length(t) & write(lt+1) & write(',') & write(lt) & wrlbls(t). display(Dstruct(Name(Constid(n),_),[])) <- write('CONST ') & write('#') & wrname(n) & nl(). display(other) <- writeln(other). wrname(Name(Predid(n),_)) <- write('#') & wrname(n). wrname(Name(Funcid(n),_)) <- write('#') & wrname(n). wrname(n) <- name(n,[#$|l]) & prlist(l) & / or write('Strange name:'(n)). wrlbls([Lbl([_,h])|t]) <- write(',#') & write(h) & wrlbls(t). wrlbls([]) <- nl(). .FF .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/src/mkcode.lpl ============================================================================ .R /* mkcode.lpl .SW Author: Thomas Sj|land .US Transforms a formula into the abstract code for LPL0 according to [HaSa]. */ makecode([])=[]. makecode([[n,brdefs,frdefs]|t])=[hcode|makecode(t)] <- (frdefs=[] & / or writeln(' Cannot compile forward definitions.')) & (brdefs=[f] & ar=arity(f) & (n=Name(Predid(_),_) & predtype=RELDEF(ar) & / or n=Name(Funcid(_),_) & /* predtype=FUNCDEF(ar-1,1) */ predtype=RELDEF(ar)) & hcode0=flatten([n,predtype,mkcode(f,ar,n)]) & / or freverse(brdefs)=[f|r] & l=lastelement(r) & m=difflist(r,[l]) & ar=arity(f) & mkchoices(m,mc,mcodes,ar,n) & hcode0=flatten([n,RELDEF(ar), FIRSTCHOICE(l1), mc, LASTCHOICE(l2), Lbl(l1),mkcode(f,ar,n), mcodes, Lbl(l2),mkcode(l,ar,n)]) ) & (true() or writeln('enumtermlist1 failed'(hcode0)) & false) & enumtermlist(hcode0,1,1) & / & optimize(hcode0,hcode0,hcode) & /. mkchoices([],[],[],_,_). mkchoices([h|t],[CHOICE(l1)|t0],[Lbl(l1),hc|t1],ar,n) <- mkcode(h,ar,n)=hc & mkchoices(t,t0,t1,ar,n). arity(Assert(_,tl))=length(tl). arity(Limp(_,tl,_))=length(tl). arity(x)=wrerr(x) <- otherwise. wrerr(x)=ERROR <- writeln('ArityError:'(x)). mkcode(f,arity,n)=[ucode,udata] <- data0=extractterms(f,[]) & data1=unnestterms(data0,data0) & data=enumvars(data1,0) & (f=Assert(vars,tl) & body=[RETURN] or f=Limp(vars,tl,b) & form(b,cont,bc,data0) & (bc=[] & body=[RETURN] or bc/=[] & body=[ENTERBODY,bc,T(Lbl(cont),[END])]) ) & (arity=length(tl) & / or writeln('Wrong arity in formula'(arity,f)) & / & false) & unwind(body,ubody) & unwind(data,udata) & ucode=[ENTER, framecode(length(vars)), egencode(labels(tl,data0)), TRACE(n), ubody]. framecode(0)=[]. framecode(i)=GFRAME(i) <- i>0. unwind([],[]). unwind([T(l,c)|t],[l|r]) <- unwind([c|t],r). unwind([h|t],[r0|r1]) <- unwind(h,r0) & unwind(t,r1). unwind(x,x) <- x/=T(_,_) & x/=[_|_]. egencode([])=[]. egencode(lbls)=[EGEN(length(lbls),lbls)] <- lbls/=[]. /* Extracts the terms from a formula and creates a list of T(label,term). */ extractterms(Assert(_,tl),p)=extractterms(tl,p). extractterms(Atomic(_,tl,_),p)=extractterms(tl,p). extractterms(Limp(_,tl,b),p)=extractterms(b,extractterms(tl,p)). extractterms(Goalform(_,f1,f2),p)=extractterms(f2,extractterms(f1,p)). extractterms([],p)=p. extractterms([x|t],p)=extractterms(t,p0) <- x0=T(Lbl(_),x) & ((x=Var(_) or x=Int(_) or x=Constant(_)) & p1=p & / or x=Dstruct(_,tl) & p1=extractterms(tl,p)) & (member(x0,p1) & p0=p1 & / or p0=[x0|p1]). printcode(p,pname) <- /* & write('=== Code for the predicate ') & wrname(pname) & nl() & */ kod=flatten(makecode(p)) & / & (enumtermlist(kod,1,2) & / or writeln('enumtermlist failed'(kod)) & false) & displaycode(kod). /* Enumerate a termlist L. */ enumtermlist([Lbl(l)|t],n,i) <- / & index(i,l,n) & enumtermlist(t,n+1,i). enumtermlist([RELDEF(_)|t],_,i) <- / & enumtermlist(t,1,i). enumtermlist([FUNCDEF(_,_)|t],_,i) <- / & enumtermlist(t,1,i). enumtermlist([h|t],n,i) <- h/=Lbl(_) & h/=RELDEF(_) & h/=FUNCDEF(_,_) & / & enumtermlist(t,n,i). enumtermlist([],_,_) <- /. enumtermlist([h|t],n,i) <- nl() & write(Enumtermlistfailed(h,n,i)) & nl() & / & enumtermlist(t,n,i). /* Extract the variables from a list of terms T(label,term) and enumerate the variables. */ enumvars([],_)=[]. enumvars([h|t],n)=r <- h=T(l,Var(v)) & r=[T(l,GVAR(n,Var(v)))|enumvars(t,n+1)] & / or r=[h|enumvars(t,n)]. no_of_vars([T(_,GVAR(_,_))|t])=no_of_vars(t)+1. no_of_vars([T(_,term)|t])=no_of_vars(t) <- term/=GVAR(_,_). no_of_vars([])=0. unnestterms([],_)=[]. unnestterms([T(l,h)|t],terms)=[T(l,h0)|unnestterms(t,terms)] <- (h=Var(_) or h=Int(_) or h=Constant(_)) & h0=h & / or h=Dstruct(n,tl) & h0=Dstruct(n,lbls) & labels(tl,terms)=lbls & lbls/=ERROR. /* Return a list of lables addressing the objects of a list in a term list. */ labels([],_)=[]. labels([h|t],terms)=r <- member(T(l,h),terms) & r=[l|labels(t,terms)] & / or write(MissingTerm(h)) & r=ERROR. /* form(Goalform('or',l,r),cont,[FIRSTCHOICE(c), ch, T(Lbl(c),h), t], data) <- form(l,cont,[h|t],data) & choices(r,cont,ch,data). */ form(Goalform('or',l,r),cont,[FIRSTCHOICE(cl), LASTCHOICE(cr), T(Lbl(cl),hl), tl, T(Lbl(cr),hr), tr], data) <- form(l,cont,[hl|tl],data) & form(r,cont,[hr|tr],data). form(Goalform('&',l,r),cont,[c,T(Lbl(rl),h),t],data) <- form(l,rl,c,data) & form(r,cont,[h|t],data). form(Atomic(n,tl,_),cont,code,data) <- n/=Name('false',_) & n/=Name(CUT,_) & n/=Name(TRUE,_) & n/=Name(Otherwise,_) & code=[CALL(Lbl(cont),n,length(tl),labels(tl,data))]. form(Atomic(Name(Otherwise,_),[],_),_,[],_). form(Atomic(Name(TRUE,_),[],_),_,[],_). form(Atomic(Name('false',_),[],_),_,[FAIL],_). form(Atomic(Name(CUT,_),[],_),l,[Cut(l)],_). /* choices(Goalform('or',l,r),cont,code,data) <- form(l,cont,[h|t],data) & code=[CHOICE(c), ch, T(Lbl(c),h),t] & choices(r,cont,ch,data). choices(r,cont,rest,data) <- r/=Goalform('or',_,_) & rest=[LASTCHOICE(r0), T(Lbl(r0),h),t] & form(r,cont,[h|t],data). */ .FF .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/src/optimize.lpl ============================================================================ .R /* Purpose: contains the predicate 'optimize' with its subpredicates which optimizes the code generated by 'mkcode', more specifically: 1) replaces calls to system predicates by special instructions. 2) performs tail rcursion optimization when possible by replacing the last instruction executed in the predicate by a LASTCALL instruction (if it is a CALL). .SW Author: Thomas Sj|land, CSALAB .US */ optimize([CALL(x,p,n,tl)|t],l,[s|r]) <- syspred(x,p,n,tl,s) & / & optimize(t,l,r). optimize([CALL(x,p,n,tl)|t],l,[LASTCALL(p,n,tl)|r]) <- next_is_end(x,l) & / & optimize(t,l,r). optimize([x|t],l,[x|r]) <- optimize(t,l,r). optimize([],_,[]). next_is_end(x,[x,END|_]) <- /. next_is_end(x,[_|t]) <- next_is_end(x,t). syspred(x,Name(Predid('$write'),_),n,t,SPECIAL(WRITE,x,n,t)). syspred(x,Name(Predid('$nl'),_),n,t,SPECIAL(NL,x,n,t)). syspred(x,Name(Predid('$put'),_),n,t,SPECIAL(PUT,x,n,t)). syspred(x,Name(Predid('$get'),_),n,t,SPECIAL(GET,x,n,t)). syspred(x,Name(Predid('$name'),_),n,t,SPECIAL(NAME,x,n,t)). syspred(x,Name(Predid('$atom'),_),n,t,SPECIAL(ATOM,x,n,t)). syspred(x,Name(Predid('$atomic'),_),n,t,SPECIAL(ATOMIC,x,n,t)). syspred(x,Name(Predid('$integer'),_),n,t,SPECIAL(INTEGER,x,n,t)). syspred(x,Name(Predid('$debug'),_),n,t,SPECIAL(DEBUG,x,n,t)). syspred(x,Name(Funcid('$char_infile'),_),n,t,SPECIAL(CHAR_INFILE,x,n,t)). syspred(x,'+',n,t,SPECIAL(PLUS,x,n,t)). syspred(x,'-',n,t,SPECIAL(MINUS,x,n,t)). syspred(x,'U+',n,t,SPECIAL(UPLUS,x,n,t)). syspred(x,'U-',n,t,SPECIAL(UMINUS,x,n,t)). syspred(x,'*',n,t,SPECIAL(TIMES,x,n,t)). syspred(x,'/',n,t,SPECIAL(DIV,x,n,t)). syspred(x,'mod',n,t,SPECIAL(MOD,x,n,t)). syspred(x,'^',n,t,SPECIAL(POWER,x,n,t)). syspred(x,'=',n,t,SPECIAL(EQUAL,x,n,t)). syspred(x,'/=',n,t,SPECIAL(NOTEQ,x,n,t)). syspred(x,'>',n,t,SPECIAL(GREATER,x,n,t)). syspred(x,'>=',n,t,SPECIAL(GE,x,n,t)). syspred(x,'<',n,t,SPECIAL(LESS,x,n,t)). syspred(x,'<=',n,t,SPECIAL(LE,x,n,t)). .FF .TITLE Appendix 4: codegenerator for the or-parallel tokenmachine simulator. .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/parmach/display.lpl ============================================================================ .R /* display.lpl routines for printing out the code produced by the LPL0-compiler in ASCII-format. */ displaycode([h|t]) <- display(h) & / & displaycode(t). displaycode([]) <- nl(). displaycode(others) <- writeln(others). display(Name(Predid(n),_)) <- write('#') & wrname(n) & write(': '). display(Name(Funcid(n),_)) <- write('#') & wrname(n) & write(': '). display(RELDEF(n)) <- write('RELDEF ') & writeln(n). display(FUNCDEF(n,a)) <- write('FUNCDEF ') & write(n) & write(' ') & writeln(a). display(FIRSTCHOICE([_,l])) <- write('FIRSTCHOICE ') & write('#') & writeln(l). display(CHOICE([_,l])) <- write('CHOICE ') & write('#') & writeln(l). display(LASTCHOICE([_,l])) <- write('LASTCHOICE ') & write('#') & writeln(l). display(PARCHOICE(n,l)) <- / & write('PARCHOICE ') & write(n) & wrlbls(l). display(Lbl([_,l])) <- write('#') & write(l) & write(': '). display(ENTERUNIFY(l,n,t)) <- write('ENTERUNIFY ') & write(l) & write(',') & write(n) & wrlbls(t). display(GFRAME(n)) <- write('GFRAME ') & writeln(n). display(EGEN(l,t)) <- write('EGEN ') & write(l) & wrlbls(t). display(Cut([_,c])) <- write(CUT) & write(' #') & writeln(c). display(CALL(Lbl([_,l]),p,n,t,type)) <- (type=' ' or type=LAST or type=FIRST or type=ONLY) & / & write(type) & write('CALL ') & (type=' ' & write('#') & write(l) & write(',') or type/=' ') & wrname(p) & write(',') & write(n) & wrlbls(t). display(RETURN) <- writeln(RETURN). display(DUPLICATE) <- writeln(DUPLICATE). display(SPECIAL(m,i,Lbl([_,l]),n,t)) <- write('SPECIAL ') & write(i) & write(',') & (m=' ' & write('NORMAL') & write(',#') & write(l) & / or (write(m) & (m=FIRST & write(',#') & write(l) & / or m/=FIRST & write(',#0')) ) ) & write(',') & write(n) & wrlbls(t) & ((m=ONLY & / or m=LAST) & write('#0: CONST #dummylabel') & nl() or true()). display(TRACE(n)) <- write('TRACE ') & wrname(n) & nl(). display(GVAR(i,nm)) <- write('GVAR ') & write(i) & write(' ') & display(nm) & nl(). display(Int(n)) <- write('INT ') & writeln(n). display(Var(v)) <- display(v). display(Name(n,typ)) <- /* display(typ) & write(':') & */ display(n). display(Varid(i)) <- write(i). display(Dstruct('.',t)) <- write(DSTRUCT) & write(' #List ') & write(',') & lt=length(t) & write(lt+1) & write(',') & write(lt) & wrlbls(t). display(Dstruct(NIL,[])) <- writeln('CONST #NIL'). display(Dstruct(Name(Constid(n),_),t)) <- t/=[] & write(DSTRUCT) & write(' #') & wrname(n) & write(',') & lt=length(t) & write(lt+1) & write(',') & write(lt) & wrlbls(t). display(Dstruct(Name(Constid(n),_),[])) <- write('CONST ') & write('#') & wrname(n) & nl(). display(other) <- write(other). wrname(Name(Predid(n),_)) <- write('#') & wrname(n). wrname(Name(Funcid(n),_)) <- write('#') & wrname(n). wrname(n) <- name(n,[#$|l]) & prlist(l) & / or write('Strange name:'(n)). wrlbls([Lbl([_,h])|t]) <- write(',#') & write(h) & wrlbls(t). wrlbls([]) <- nl(). .FF .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/parmach/mkcode0.lpl ============================================================================ .R /* mkcode.lpl .SW Author: Thomas Sj|land .US Transforms a Horn clause formula into the abstract code according to [Ci] for the parallel machine simulator. */ makecode([])=[]. makecode([[n,brdefs,frdefs]|t])=[hcode|makecode(t)] <- (frdefs=[] & / or writeln(' Cannot compile forward definitions.') & false) & (brdefs=[f] & ar=arity(f) & (n=Name(Predid(_),_) & predtype=RELDEF(ar) & / or n=Name(Funcid(_),_) & /* predtype=FUNCDEF(ar-1,1) */ predtype=RELDEF(ar)) & hcode0=flatten([n,predtype,mkcode(f,ar,n)]) & / or freverse(brdefs)=[f,_|_] & ar=arity(f) & mkchoices(brdefs,mc,mcodes,ar,n) & hcode1=flatten([n,RELDEF(ar), PARCHOICE(length(mc),mc), mcodes]) & unwind(hcode1,hcode0) ) & (true() or writeln('enumtermlist1 failed'(hcode0)) & false) & enumtermlist(hcode0,1,1) & / & optimize(hcode0,hcode0,hcode) & /. mkchoices([],[],[],_,_). mkchoices([h|t],[l1|t0],[T(l1,DUPLICATE),hc|t1],ar,n) <- mkcode(h,ar,n)=hc & mkchoices(t,t0,t1,ar,n). arity(Assert(_,tl))=length(tl). arity(Limp(_,tl,_))=length(tl). arity(x)=wrerr(x) <- otherwise. wrerr(x)=ERROR <- writeln('ArityError:'(x)). mkcode(f,arity,n)=[ucode,udata] <- data0=extractterms(f,[]) & data1=unnestterms(data0,data0) & data=enumvars(data1,0) & (f=Assert(vars,tl) & body=[RETURN] or f=Limp(vars,tl,b) & form(b,cont,bc,data0) & (bc=[] & body=[RETURN] or bc=[_|_] & body=[bc,T(Lbl(cont),[RETURN])]) ) & (arity=length(tl) & / or writeln('Wrong arity in formula'(arity,f)) & / & false) & unwind(body,ubody) & unwind(data,udata) & ulbls=labels(tl,data0) & ucode=[ENTERUNIFY(length(vars),length(ulbls),ulbls), ubody]. unwind([],[]). unwind([T(l,c)|t],[l|r]) <- unwind([c|t],r). unwind([h|t],[r0|r1]) <- unwind(h,r0) & unwind(t,r1). unwind(x,x) <- x/=T(_,_) & x/=[_|_]. /* Extracts the terms from a formula and creates a list of T(label,term). */ extractterms(Assert(_,tl),p)=extractterms(tl,p). extractterms(Atomic(_,tl,_),p)=extractterms(tl,p). extractterms(Limp(_,tl,b),p)=extractterms(b,extractterms(tl,p)). extractterms(Goalform(_,f1,f2),p)=extractterms(f2,extractterms(f1,p)). extractterms([],p)=p. extractterms([x|t],p)=extractterms(t,p0) <- x0=T(Lbl(_),x) & ((x=Var(_) or x=Int(_) or x=Constant(_)) & p1=p & / or x=Dstruct(_,tl) & p1=extractterms(tl,p)) & (member(x0,p1) & p0=p1 & / or p0=[x0|p1]). printcode(p,pname) <- (kod=flatten(makecode(p)) & / or writeln('Code could not be generated.') & false) & (enumtermlist(kod,1,2) & / or writeln('enumtermlist failed'(kod)) & false) & displaycode(kod). /* Enumerate a termlist L. */ enumtermlist([Lbl(l)|t],n,i) <- / & index(i,l,n) & enumtermlist(t,n+1,i). enumtermlist([RELDEF(_)|t],_,i) <- / & enumtermlist(t,1,i). enumtermlist([FUNCDEF(_,_)|t],_,i) <- / & enumtermlist(t,1,i). enumtermlist([h|t],n,i) <- h/=Lbl(_) & h/=RELDEF(_) & h/=FUNCDEF(_,_) & / & enumtermlist(t,n,i). enumtermlist([],_,_) <- /. enumtermlist([h|t],n,i) <- nl() & write(Enumtermlistfailed(h,n,i)) & nl() & / & enumtermlist(t,n,i). .FF .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/parmach/mkcode1.lpl ============================================================================ .R /* Extract the variables from a list of terms T(label,term) and enumerate the variables. */ enumvars([],_)=[]. enumvars([h|t],n)=r <- h=T(l,Var(v)) & r=[T(l,GVAR(n,Var(v)))|enumvars(t,n+1)] & / or r=[h|enumvars(t,n)]. no_of_vars([T(_,GVAR(_,_))|t])=no_of_vars(t)+1. no_of_vars([T(_,term)|t])=no_of_vars(t) <- term/=GVAR(_,_). no_of_vars([])=0. unnestterms([],_)=[]. unnestterms([T(l,h)|t],terms)=[T(l,h0)|unnestterms(t,terms)] <- (h=Var(_) or h=Int(_) or h=Constant(_)) & h0=h & / or h=Dstruct(n,tl) & h0=Dstruct(n,lbls) & labels(tl,terms)=lbls & lbls/=ERROR. /* Return a list of lables addressing the objects of a list in a term list. */ labels([],_)=[]. labels([h|t],terms)=r <- member(T(l,h),terms) & r=[l|labels(t,terms)] & / or write(MissingTerm(h)) & r=ERROR. /* not in orpar-language. form(Goalform('or',l,r),cont,[PARCHOICE(2,[Lbl(cl),Lbl(cr)]), T(Lbl(cl),DUPLICATE), lc, T(Lbl(cr),DUPLICATE), rc], data) <- form(l,cont,lc,data) & form(r,cont,rc,data). */ form(Goalform('&',l,r),cont,[c,T(Lbl(rl),h),t],data) <- form(l,rl,c,data) & form(r,cont,[h|t],data). form(Atomic(n,tl,_),cont,code,data) <- n/=Name('false',_) & n/=Name(CUT,_) & n/=Name(TRUE,_) & n/=Name(Otherwise,_) & code=[CALL(Lbl(cont),n,length(tl),labels(tl,data),_)]. form(Atomic(Name(Otherwise,_),[],_),_,[],_). form(Atomic(Name(TRUE,_),[],_),_,[],_). form(Atomic(Name('false',_),[],_),_,[FAIL],_). form(Atomic(Name(CUT,_),[],_),l,[],_). /* Cut is not yet included in orpar-language, read as true. */ .FF .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/parmach/mkobj.lpl ============================================================================ .R /* Converts plp-file into obj-file. */ p() <- f=[] & char_infile(f,0)=s & tokenpars(s,l0) & / /* & write('debuglevel:') & read(d) & debug(d) */ & tr(l0,r,1,[],[],names) & / & writeints(r) & write('-1') & nl() & writenames(names,1) & write('-1') & nl() & write('Disassembled:') & nl() & disasm(r,r0,1) & writefile(r0) & / . /* The instruction formats are: .NOPROP (Symbolic code) (Object code) (Size) INITCALL name n lbl* --> 1000 offset n offset* 3+n PARCHOICE n lbl+ --> 1001 n offset+ 2+n ENTERUNIFY l n lbl* --> 1002 l n offset* 3+n CALL cont name n lbl* --> 1003 cont offset n offset* 4+n FIRSTCALL name n lbl* --> 1004 offset n offset* 3+n ONLYCALL name n lbls* --> 1005 offset n offset* 3+n LASTCALL name n lbls* --> 1006 offset n offset* 3+n GVAR n m --> 1007 n m 3 DSTRUCT name f n lbl* --> 1008 i(name) n offset* 3+n CONST name --> 1009 i(name) 2 RETURN --> 1010 1 DUPLICATE --> 1011 1 INT n --> 1012 n 2 SPECIAL op mode cont n lbl* --> 1013 aop cmode cont n offset* 5+n op = { MINUS PLUS TIMES POWER DIV MOD EQUAL NOTEQ GREATER GE LESS LE } aop = { 1 2 3 4 5 6 7 8 9 10 11 12 } mode = { NORMAL FIRST ONLY LAST } cmode = { 1 2 3 4 } .PROP */ /* disasm comments a binary list. */ disasm([],[],_) <- /. disasm([1000,p,argsno|t],[[aoffs,INITCALL(p,argsno,args)]|r],aoffs) <- takeargs(argsno,t,args,t0) & / & disasm(t0,r,aoffs+3+argsno). disasm([1001,argsno|t],[[aoffs,PARCHOICE(argsno,args)]|r],aoffs) <- takeargs(argsno,t,args,t0) & / & disasm(t0,r,aoffs+2+argsno). disasm([1002,novars,argsno|t],[[aoffs,ENTERUNIFY(novars,argsno,args)]|r],aoffs) <- takeargs(argsno,t,args,t0) & / & disasm(t0,r,aoffs+3+argsno). disasm([1003,cont,p,argsno|t],[[aoffs,CALL(cont,p,argsno,args)]|r],aoffs) <- takeargs(argsno,t,args,t0) & / & disasm(t0,r,aoffs+4+argsno). disasm([1004,p,argsno|t],[[aoffs,FIRSTCALL(p,argsno,args)]|r],aoffs) <- takeargs(argsno,t,args,t0) & / & disasm(t0,r,aoffs+3+argsno). disasm([1005,p,argsno|t],[[aoffs,ONLYCALL(p,argsno,args)]|r],aoffs) <- takeargs(argsno,t,args,t0) & / & disasm(t0,r,aoffs+3+argsno). disasm([1006,p,argsno|t],[[aoffs,LASTCALL(p,argsno,args)]|r],aoffs) <- takeargs(argsno,t,args,t0) & / & disasm(t0,r,aoffs+3+argsno). disasm([1007,offs,m|t],[[aoffs,GVAR(offs,m)]|r],aoffs) <- / & disasm(t,r,aoffs+3). disasm([1008,i,argsno|t],[[aoffs,DSTRUCT(i,fields,argsno,args)]|r],aoffs) <- fields=argsno+1 & takeargs(argsno,t,args,t0) & / & disasm(t0,r,aoffs+3+argsno). disasm([1009,i|t],[[aoffs,CONST(i)]|r],aoffs) <- / & disasm(t,r,aoffs+2). disasm([1010|t],[[aoffs,RETURN]|r],aoffs) <- / & disasm(t,r,aoffs+1). disasm([1011|t],[[aoffs,DUPLICATE]|r],aoffs) <- / & disasm(t,r,aoffs+1). disasm([1012,n|t],[[aoffs,INT(n)]|r],aoffs) <- / & disasm(t,r,aoffs+2). disasm([1013,aop,cmode,cont,argsno|t],[[aoffs,SPECIAL(nop,nmode,cont,args)]|r],aoffs) <- opcode(op,aop-1013) & opmode(mode,cmode-1025) & name(nop,op) & name(nmode,mode) & takeargs(argsno,t,args,t0) & disasm(t0,r,aoffs+5+argsno). /* disasm([1013,aop,cmode,argsno|t],[[aoffs,SPECIAL(nop,nmode,' ',args)]|r],aoffs) <- opcode(op,aop-1013) & opmode(mode,cmode-1025) & mode/="NORMAL" & mode/="FIRST" & / & name(nop,op) & name(nmode,mode) & takeargs(argsno,t,args,t0) & disasm(t0,r,aoffs+4+argsno). */ disasm([_|t],[[aoffs,'?']|r],aoffs) <- disasm(t,r,aoffs). takeargs(0,t,[],t) <- /. takeargs(argsno,[h|t],[h|r],t0) <- argsno>0 & takeargs(argsno-1,t,r,t0). /* tr(syminstr,objectcode,absoffs,predentries,lblentries,names) */ tr([n,"RELDEF",_|t],o,aoffs,preds,_,names) <- / & append(n0,":",n) & tblinsert(E(n0,aoffs),preds,npreds) & tr(t,o,aoffs,npreds,[],names). tr([h|t],o,aoffs,preds,lbls,names) <- islabeltoken(h) & / & append(h0,":",h) & tblinsert(E(h0,aoffs),lbls,nlbls) & tr(t,o,aoffs,preds,nlbls,names). tr(l,o,aoffs,preds,lbls,names) <- l=[_|_] & instruction(l,rl,preds,npreds,lbls,nlbls,o,ro,sz,names) & / & tr(rl,ro,aoffs+sz,npreds,nlbls,names). tr([],[],a,p,l,names) <- /* write(Finished(Size(a),Preds(p),Lbls(l),Names(names))) & nl() & */ /. tr(l,o,aoffs,preds,lbls,names) <- write(FailedInTr(l,o,aoffs,preds,lbls,names)) & nl() & / & false. /* instruction([symbolic|r], r,preds,npreds,labels,nlabels,[code|t],t,size,names) */ /* INITCALL name n lbls* --> 1000 called nargs lbls */ instruction(["INITCALL",n|r],r0,preds,npreds,lbls,nlbls, [1000,aoffs,nargs|t],t0,sz,_) <- / & tblinsert(E(n,aoffs),preds,npreds) & expandargs(r,r0,lbls,nlbls,t,t0,nargs) & sz=3+nargs. /* PARCHOICE n lbls+ --> 1001 n l+ */ instruction(["PARCHOICE"|r],r0,p,p,lb,nlb,[1001,nargs|t],t0,sz,_) <- / & expandargs(r,r0,lb,nlb,t,t0,nargs) & sz=2+nargs. /* ENTERUNIFY l n t --> 1002 l n t* */ instruction(["ENTERUNIFY",v|r],r0,p,p,lbls,nlbls,[1002,vs,nargs|t],t0,sz,_) <- / & vs=noof(v) & expandargs(r,r0,lbls,nlbls,t,t0,nargs) & sz=3+nargs. /* CALL cont name n lbls* --> 1003 cont called n lbls */ instruction(["CALL",cont,n|r],r0,preds,npreds,lbls,nlbls, [1003,coffs,aoffs,nargs|t],t0,sz,_) <- / & tblinsert(E(n,aoffs),preds,npreds) & tblinsert(E(cont,coffs),lbls,lbls0) & expandargs(r,r0,lbls0,nlbls,t,t0,nargs) & sz=4+nargs. /* FIRSTCALL name n lbls* --> 1004 called nargs lbls */ instruction(["FIRSTCALL",n|r],r0,preds,npreds,lbls,nlbls, [1004,aoffs,nargs|t],t0,sz,_) <- / & tblinsert(E(n,aoffs),preds,npreds) & expandargs(r,r0,lbls,nlbls,t,t0,nargs) & sz=3+nargs. /* ONLYCALL name n lbls* --> 1005 called n args* */ instruction(["ONLYCALL",n|r],r0,preds,npreds,lbls,nlbls, [1005,aoffs,nargs|t],t0,sz,_) <- / & tblinsert(E(n,aoffs),preds,npreds) & expandargs(r,r0,lbls,nlbls,t,t0,nargs) & sz=3+nargs. /* LASTCALL name n lbls* --> 1006 called n lbls */ instruction(["LASTCALL",n|r],r0,preds,npreds,lbls,nlbls, [1006,aoffs,nargs|t],t0,sz,_) <- / & tblinsert(E(n,aoffs),preds,npreds) & expandargs(r,r0,lbls,nlbls,t,t0,nargs) & sz=3+nargs. /* GVAR n m --> 1007 n m */ instruction(["GVAR",n,nm|r],r,p,p,lb,lb,[1007,l,m|t],t,3,names) <- / & index(m,nm,names) & l=noof(n)+1. /* DSTRUCT n #f #a args.. -> 1008 sizeof(name) name #args args */ instruction(["DSTRUCT",n,_|r],r0,p,p,lbls,nlbls,[1008,l|t],t0,sz,names) <- / & index(l,n,names) & t=[nargs|t2] & expandargs(r,r0,lbls,nlbls,t2,t0,nargs) & sz=3+nargs. /* CONST n --> 1009 'number of n' */ instruction(["CONST",n|r],r,p,p,lb,lb,[1009,l|t],t,2,names) <- / & index(l,n,names). /* RETURN --> 1010 */ instruction(["RETURN"|r],r,p,p,lb,lb,[1010|t],t,1,_) <- /. /* DUPLICATE --> 1011 */ instruction(["DUPLICATE"|r],r,p,p,lb,lb,[1011|t],t,1,_) <- /. /* INT n --> 1012 n */ instruction(["INT",n|r],r,p,p,lb,lb,[1012,l|t],t,2,_) <- / & l=noof(n). /* SPECIAL op mode cont n lbls* --> 1013 aop cmode cont n offsets */ instruction(["SPECIAL",op,mode,cont|r],r0,preds,preds,lbls,nlbls, [1013,aop0,cmode0,coffs,nargs|t],t0,sz,_) <- (mode="NORMAL" & / or mode="FIRST" & / or cont="#0") & opcode(op,aop) & opmode(mode,cmode) & tblinsert(E(cont,coffs),lbls,lbls0) & expandargs(r,r0,lbls0,nlbls,t,t0,nargs) & aop0=aop+1013 & cmode0=cmode+1025 & sz=5+nargs. /* instruction(["SPECIAL",op,mode|r],r0,preds,preds,lbls,nlbls, [1013,aop0,cmode0,nargs|t],t0,sz,_) <- mode/="NORMAL" & mode/="FIRST" & / & opcode(op,aop) & opmode(mode,cmode) & expandargs(r,r0,lbls,nlbls,t,t0,nargs) & aop0=aop+1013 & cmode0=cmode+1025 & sz=4+nargs. */ /* Others unknown. */ instruction(l,r0,preds,preds,lbls,nlbls,[ERROR],t0,0,_) <- write('not an instruction:') & nl() & wrconvert(l). /* utilities */ expandargs([n|t],t0,lbls,nlbls,s,s0,nargs) <- nargs=noof(n) & getargs(nargs,t,t0,lbls,nlbls,s,s0). getargs(0,t,t,lbls,lbls,s,s). getargs(i,[h|t],t0,lbls,nlbls,[a|s],s0) <- i>0 & tblinsert(E(h,a),lbls,l0) & getargs(i-1,t,t0,l0,nlbls,s,s0). islabeltoken(h) <- notinteger(h) & islabel(h). isnametoken(h) <- notinteger(h) & isname(h). notinteger(h) <- isinteger(h) & / & false. notinteger(_). isinteger([h|t]) <- h>=#0 & h<=#9 & (t=[] or isinteger(t)) & /. islabel([##|t]) <- islabelno(t). islabelno([h|t]) <- h>=#0 & h<=#9 & / & islabelno(t). islabelno([#:]). isname([##|t]) <- isnametext(t). isnametext([#:]) <- /. isnametext([_|t]) <- isnametext(t). tblinsert(x,[],[x]) <- /. tblinsert(x,l,l) <- member(x,l) & /. tblinsert(x,l,[x|l]). /* Manage a table of unique entries as a list. i is the index in the list. */ index(1,x,[x|_]). index(i,x,[h|t]) <- /* x/=h & */ index(i0,x,t) & i=i0+1. expand([],l,l). expand([h|t],[h|t0],t1) <- expand(t,t0,t1). wrlist([h|t]) <- / & put(h) & wrlist(t). wrlist([]). wrconvert([h|t]) <- (wrlist(h) ; write(h)) & write(' ') & wrconvert(t). wrconvert([]). tokenpars([f|r],t) <- f<=32 & / & tokenpars(r,t). tokenpars(l,[h|t]) <- l=[f|_] & f>32 & / & token(l,r,h) & tokenpars(r,t). tokenpars([],[]). token([c|t],r,h) <- c>32 & / & untildelim(t,ct,r) & l=[c|ct] & (h=l & / or write(Namearg(h,l)) & false). untildelim([],[],[]) <- /. untildelim([h|t],[h|t0],r) <- h>32 & h/=#\ & h/=#, & / & untildelim(t,t0,r). untildelim([#\,h|t],[#\,h|t0],r) <- / & untildelim(t,t0,r). untildelim([h|t],[],t) <- h<=32 & / or h=#,. /* uniquelist([h|t],t0) <- member(h,t) & / & uniquelist(t,t0). uniquelist([h|t],[h|t0]) <- / & uniquelist(t,t0). uniquelist([],[]). */ member(x,[x|_]) <-/. member(x,[_|t])<- member(x,t). /* notmember(x,l) <- member(x,l) & / & false. notmember(_,_). */ length([_|t])=1+length(t). length([])=0. noof(lbl)=convert(reverse(r0)) <- islabeltoken(lbl) & lbl=[##|r] & append(r0,[#:],r). noof(lbl)=convert(reverse(lbl)) <- isinteger(lbl). noof([#-|lbl])= -noof(lbl). convert([])=0. convert([h|t])=(h-48)+10*convert(t). append([],x,x) <- /. append([h|t],x,[h|t0]) <- append(t,x,t0). reverse([])=[]. reverse([h|t])=l <- append(reverse(t),[h],l). writenumbered([],_) <- nl() & /. writenumbered([h|t],n) <- write(n) & write(' ') & write(h) & nl() & writenumbered(t,n+1). writenames([],_) <- /. writenames([h|t],n) <- write(n) & write(' ') & wrlist(h) & nl() & writenames(t,n+1). list([]) <- /. list([_|t]) <- list(t). writefile([]) <- nl(). writefile([h|t]) <- write(h) & nl() & writefile(t). /* writeints. */ writeints([]). writeints([h|t]) <- (integer(h) & / & write(h) & nl() or write('Unresolved reference:'(h)) & nl()) & writeints(t). opcode(o,c) <- index(c,o,["MINUS","PLUS","TIMES","POWER","DIV","MOD", "EQUAL","NOTEQ","GREATER","GE","LESS","LE"]). opmode(m,c) <- index(c,m,["NORMAL","FIRST","ONLY","LAST"]). .FF .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/parmach/optimize.lpl ============================================================================ .R /* optimize.lpl Purpose: contains the predicate 'optimize' with its subpredicates which optimizes the code generated by 'mkcode', more specifically: 1) replaces calls to system predicates by special instructions. 2) performs tail recursion optimization when possible by replacing the last instruction executed in the predicate by a LASTCALL instruction and inserts also FIRSTCALL and ONLYCALL where appropriate. .SW Author: Thomas Sj|land, CSALAB .US */ optimize(p,l,q) <- calloptimize(p,l,r) & specialoptimize(r,l,q). /* Replace special instructions. */ specialoptimize([CALL(x,p,n,tl,m)|t],l,[s|r]) <- syspred(x,p,n,tl,s,m) & / & specialoptimize(t,l,r). specialoptimize([h|t],l,[h|r]) <- / & specialoptimize(t,l,r). specialoptimize([],l,[]). /* Annotate CALL instructions with FIRST-,ONLY-,LAST- and ' '-. */ calloptimize([e,CALL(x,p,n,tl,_),x,RETURN|t],l,[e,CALL(x,p,n,tl,ONLY)|r]) <- e=ENTERUNIFY(_,_,_) & / & calloptimize(t,l,r). calloptimize([e,CALL(x,p,n,tl,_),x,END|t],l,[e,CALL(x,p,n,tl,ONLY)|r]) <- e=ENTERUNIFY(_,_,_) & / & calloptimize(t,l,r). calloptimize([e,CALL(x,p,n,tl,_),x,c|t],l,[e,CALL(x,p,n,tl,FIRST),x|r]) <- e=ENTERUNIFY(_,_,_) & c=CALL(_,_,_,_,_) & / & lastoptimize([c|t],l,r). calloptimize([x|t],l,[x|r]) <- calloptimize(t,l,r). calloptimize([],_,[]). lastoptimize([c,x,RETURN|t],l,[c|r]) <- c=CALL(x,_,_,_,LAST) & / & calloptimize(t,l,r). lastoptimize([c,x,END|t],l,[c|r]) <- c=CALL(x,_,_,_,LAST) & / & calloptimize(t,l,r). lastoptimize([c0,x|t],l,[c0,x|r]) <- c0=CALL(x,_,_,_,' ') & / & lastoptimize(t,l,r). lastoptimize(c,l,r) <- calloptimize(c,l,r). /* syspred(x,Name(Predid('$write'),_),n,t,SPECIAL(m,WRITE,x,n,t),m). syspred(x,Name(Predid('$nl'),_),n,t,SPECIAL(m,NL,x,n,t),m). syspred(x,Name(Predid('$put'),_),n,t,SPECIAL(m,PUT,x,n,t),m). syspred(x,Name(Predid('$get'),_),n,t,SPECIAL(m,GET,x,n,t),m). syspred(x,Name(Predid('$name'),_),n,t,SPECIAL(m,NAME,x,n,t),m). syspred(x,Name(Predid('$atom'),_),n,t,SPECIAL(m,ATOM,x,n,t),m). syspred(x,Name(Predid('$atomic'),_),n,t,SPECIAL(m,ATOMIC,x,n,t),m). syspred(x,Name(Predid('$integer'),_),n,t,SPECIAL(m,INTEGER,x,n,t),m). syspred(x,Name(Predid('$debug'),_),n,t,SPECIAL(m,DEBUG,x,n,t),m). syspred(x,Name(Funcid('$char_infile'),_),n,t,SPECIAL(m,CHAR_INFILE,x,n,t),m). */ syspred(x,'+',n,t,SPECIAL(m,PLUS,x,n,t),m). syspred(x,'-',n,t,SPECIAL(m,MINUS,x,n,t),m). /* syspred(x,'U+',n,t,SPECIAL(m,UPLUS,x,n,t),m). syspred(x,'U-',n,t,SPECIAL(m,UMINUS,x,n,t),m). */ syspred(x,'*',n,t,SPECIAL(m,TIMES,x,n,t),m). syspred(x,'/',n,t,SPECIAL(m,DIV,x,n,t),m). syspred(x,'mod',n,t,SPECIAL(m,MOD,x,n,t),m). syspred(x,'^',n,t,SPECIAL(m,POWER,x,n,t),m). syspred(x,'=',n,t,SPECIAL(m,EQUAL,x,n,t),m). syspred(x,'/=',n,t,SPECIAL(m,NOTEQ,x,n,t),m). syspred(x,'>',n,t,SPECIAL(m,GREATER,x,n,t),m). syspred(x,'>=',n,t,SPECIAL(m,GE,x,n,t),m). syspred(x,'<',n,t,SPECIAL(m,LESS,x,n,t),m). syspred(x,'<=',n,t,SPECIAL(m,LE,x,n,t),m). .FF .TITLE Appendix 5: backend producing LPL0 source syntax. .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/lpltrans/lpl.lpl ============================================================================ .R /* Prints the abstract tree in lpl-syntax. */ printcode(c,n) <- put(#/) & write('* Predicate: ') & write(n) & write(' *') & put(#/) & nl() & printlpl(tabs,Relations(c)) & /. notsysname(n) <- sysname(n) & / & false. notsysname(_). sysname(n) <- n=Name(_,System) or n='/=' or n='=' or n='TRUE' or n='CUT' or n='+' or n='-' or n='*' or n='/' or n='^' or n='mod' or n='U+' or n='U-' or n='>' or n='<' or n='<=' or n='>='. printlpl(tabs,[]). printlpl(tabs,[h|t]) <- printlpl(tabs,h) & (t/=[] & write(',') & printlpl(tabs,t) or t=[]). printlpl(tabs,Atomic(relname,terms,funcpred)) <- notsysname(relname) & printlpl(tabs,relname) & write('(') & printlpl(tabs,terms) & write(')'). printlpl(tabs,Atomic(relname,terms,funcpred)) <- ((relname='+' or relname='-' or relname='*' or relname='/') & rn=relname or relname='mod' & rn=' mod ') & terms=[t1,t2,r] & printlpl(tabs,t1) & printlpl(tabs,rn) & printlpl(tabs,t2) & write('=') & printlpl(tabs,r). printlpl(tabs,Atomic(relname,terms,funcpred)) <- (relname='=' or relname='/=' or relname='>' or relname='<' or relname='<=' or relname='>=') & terms=[t1,t2] & printlpl(tabs,t1) & printlpl(tabs,relname) & printlpl(tabs,t2). printlpl(tabs,Atomic('U-',terms,funcpred)) <- terms=[t,r] & write('-') & printlpl(tabs,t) & write('=') & printlpl(tabs,r). printlpl(tabs,Atomic('U+',terms,funcpred)) <- terms=[t,r] & printlpl(tabs,t) & write('=') & printlpl(tabs,r). printlpl(tabs,Atomic(relname,_,_)) <- (relname=TRUE or relname=Name('CUT',_) or relname=Name('false',_) ) & / & printlpl(tabs,relname). printlpl(tabs,Atomic(Name(Otherwise,_),_,_)) <- write('true()'). printlpl(tabs,Goalform('&',formula1,formula2)) <- printlpl(tabs,formula1) & nl() & tab(tabs) & write('& ') & printlpl(tabs,formula2). printlpl(tabs,Goalform(connective,formula1,formula2)) <- connective/='&' & tab(tabs) & write('(') & printlpl(tabs+1,formula1) & nl() & tab(tabs) & write(connective) & nl() & tab(tabs) & printlpl(tabs+1,formula2) & write(')'). printlpl(tabs,Var(varname)) <- printlpl(tabs,varname). printlpl(tabs,Dstruct(dstructname,terms)) <- dstructname/='.' & terms=[] & printlpl(tabs,dstructname). printlpl(tabs,Dstruct(dstructname,terms)) <- dstructname/='.' & terms=[_|_] & printlpl(tabs,dstructname) & write('(') & printlpl(tabs,terms) & write(')'). /* printlpl(tabs,x) <- x=Dstruct(_,_) & nl() & writeln(FAILURE(x)) & false. */ printlpl(tabs,Dstruct('.',[h,t])) <- t/=Dstruct('.',_) & write('[') & printlpl(tabs,h) & write('|') & printlpl(tabs,t) & write(']'). printlpl(tabs,Dstruct('.',[h,t])) <- write('[') & printlpl(tabs,h) & write('|') & printlpl(tabs,t) & write(']'). /* printlpl(tabs,Function(funcname,terms)) <- printlpl(tabs,funcname) & write('(') & printlpl(tabs,terms) & write(')'). */ printlpl(tabs,Constant(constname)) <- printlpl(tabs,constname). printlpl(tabs,Int(number)) <- printlpl(tabs,number). printlpl(tabs,Name(ident,typeinfo)) <- typeinfo=System /* & write('sysV') */ & printlpl(tabs,ident) or typeinfo=Void & write('_') or typeinfo=Special & write('#') & printlpl(tabs,ident) or typeinfo=User & printlpl(tabs,ident). printlpl(tabs,Predid(i)) <- writeid(tabs,i). printlpl(tabs,Varid(i)) <- integer(i) & write('sysV') & writeidc(tabs,i). printlpl(tabs,Varid(i)) <- writeidc(tabs,i). printlpl(tabs,Constid(i)) <- put(#') & writeid(tabs,i) & put(#'). printlpl(tabs,Funcid(i)) <- writeid(tabs,i). printlpl(tabs,'CUT') <- write('/'). printlpl(tabs,'false') <- write('false'). printlpl(tabs,TRUE) <- write('true()'). printlpl(tabs,NIL) <- write('[]'). printlpl(tabs,'.') <- write('.'). printlpl(tabs,'=') <- write('='). printlpl(tabs,'/=') <- write('/='). printlpl(tabs,'_') <- write('_'). printlpl(tabs,Relations([])). printlpl(tabs,Relations([[rname,brdef,frdef]|t])) <- printrelations(rname,freverse(brdef)) & printlpl(tabs,Relations(t)). printlpl(tabs,i) <- atomic(i) & write(i). printlpl(tabs,x) <- write('{') & write(x) & write('}'). printrelations(r,Assert(varnames,terms)) <- nl() & printlpl(0,Atomic(r,terms,_)) & write('.'). printrelations(r,Limp(varnames,terms,formula)) <- nl() & printlpl(0,Atomic(r,terms,_)) & write('<- ') & nl() & tab(1) & printlpl(1,formula) & write('.'). printrelations(r,[]) <- nl(). printrelations(r,[h|t]) <- printrelations(r,h) & printrelations(r,t). writeid(tabs,i) <- atom(i) & name(i,[#$|t]) & wrlist(t). writeid(tabs,i) <- printlpl(tabs,i). writeidc(tabs,i) <- atom(i) & (name(i,[#$,c|t]) & / or name(i,[c|t])) & (islowercase(c) & put(c) & / or isuppercase(c) & put(c+32) & / or put(c)) & wrlist(t). writeidc(tabs,i) <- printlpl(tabs,i). .FF .TITLE Appendix 6: backend producing MU-PROLOG source syntax. .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/mutrans/[a-z]*.lpl ============================================================================ .R cat: /home/alf/public_html/LPL/compiler/mutrans/[a-z]*.lpl: No such file or directory .FF .TITLE Appendix 7: backend producing s-expression source syntax. .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/sexptrans/sexpr.lpl ============================================================================ .R /* Prints the abstract tree as sexpr. */ printcode(c,n) <- printsexpr(Relations(c)) & /. printsexpr([]). printsexpr([h|t]) <- printsexpr(h) & (t/=[] & (t=[_|_] & write(' ') or t/=[_|_] & write('.')) or t=[]) & printsexpr(t). printsexpr(Atomic(relname,terms,funcpred)) <- write('(') & printsexpr(relname) & write(' ') & printsexpr(terms) & write(')'). printsexpr(Goalform('&',formula1,formula2)) <- printsexpr(formula1) & nl() & wrblks(5) & printsexpr(formula2). printsexpr(Goalform(connective,formula1,formula2)) <- connective/='&' & nl() & wrblks(5) & write('(') & write(connective) & write(' (') & printsexpr(formula1) & write(') ') & write('(') & printsexpr(formula2) & write('))'). printsexpr(Var(varname)) <- write('?') & printsexpr(varname). printsexpr(Dstruct(dstructname,terms)) <- ( terms=[] & printsexpr(dstructname) or write('(') & printsexpr(dstructname) & write(' ') & printsexpr(terms) & write(')')). printsexpr(Function(funcname,terms)) <- printsexpr(funcname) & write('(') & printsexpr(terms) & write(')'). printsexpr(Constant(constname)) <- printsexpr(constname). printsexpr(Int(number)) <- printsexpr(number). printsexpr(Name(ident,typeinfo)) <- typeinfo=System /* & write('@') */ & printsexpr(ident) or typeinfo=Void & write('_') or typeinfo=Special & write('#') & printsexpr(ident) or typeinfo=User & printsexpr(ident). printsexpr(Predid(i)) <- writeid(i). printsexpr(Varid(i)) <- writeid(i). printsexpr(Constid(i)) <- put(#") & writeid(i) & put(#"). printsexpr(Funcid(i)) <- writeid(i). printsexpr('CUT') <- write(CUT). printsexpr('false') <- write(FALSE). printsexpr(TRUE) <- write(TRUE). printsexpr(NIL) <- write('()'). printsexpr('.'). printsexpr('=') <- wrlist([#",#=,#"]). printsexpr('/=') <- wrlist([#",#/,#=,#"]). printsexpr('_') <- write('_'). printsexpr(Prog(rdefs,_)) <- printsexpr(Relations(rdefs)). printsexpr(Relations([])). printsexpr(Relations([[rname,brdef,frdef]|t])) <- reverse(brdef,brdef0) & printrelations(rname,brdef0) & (t/=[] & printsexpr(Relations(t)) or t=[] & nl()). printsexpr(i) <- atomic(i) & write(i). printsexpr(x) <- write('{') & write(x) & write('}'). printrelations(r,Assert(varnames,terms)) <- nl() & nl() & write('(') & printsexpr(Atomic(r,terms,_)) & write(')'). printrelations(r,Limp(varnames,terms,formula)) <- nl() & nl() & write('(') & printsexpr(Atomic(r,terms,_)) & nl() & wrblks(5) & printsexpr(formula) & write(')'). printrelations(r,[]). printrelations(r,[h|t]) <- printrelations(r,h) & nl() & printrelations(r,t). writeid(i) <- atom(i) & name(i,[#$|t]) & wrlist(t). writeid(i) <- printsexpr(i). .FF .TITLE Appendix 8: Generate linking information for the LPL0-assembler. .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/slplbl/fslplbl.lpl ============================================================================ .R /* Converts slp-file into lbl-file. */ /* p() <- write('Converter from slp to lbl, give file name>') & read(f) */ p() <- f='test' & char_infile(f,0)=s & tokenpars(s,l0) & / & pick(l0,r,l0) & uniquelist(r,r0) & writetokens(r0) & filesize(l0,sz) & write('FILESIZE ') & write(sz) & nl() & /. pick([CONST,n|t],[DEFCONST(n)|t0],l) <- / & pick(t,t0,l). pick([DSTRUCT,n,_,a|t],[DEFDSTRUCT(n,a)|t0],l) <- / & pick(t,t0,l). pick([n,RELDEF,a|t],[RELATION(n,a,start,nooflbls,lbls)|t0],l) <- / & findoffset(l,n,start) & findlabels(t,lbls,0) & lista(lbls) & nooflbls=length(lbls) & pick(t,t0,l). pick([n,FUNCDEF,a,_|t],[FUNCTION(n,a,start,nooflbls,lbls)|t0],l) <- / & findoffset(l,n,start) & findlabels(t,lbls,0) & lista(lbls) & nooflbls=length(lbls) & pick(t,t0,l). pick([_|t],t0,l) <- pick(t,t0,l). pick([],[],_). findoffset([RELDEF,_|t],n,r) <- / & findoffset(t,n,r). findoffset([FUNCDEF,_,_|t],n,r) <- / & findoffset(t,n,r). findoffset([n|_],n,0) <- /. findoffset([h|t],n,r) <- iswordtoken(h) & / & findoffset(t,n,r0) & r=1+r0. findoffset([_|t],n,r) <- findoffset(t,n,r). findlabels([RELDEF|_],_,_) <- /. findlabels([FUNCDEF|_],_,_) <- /. findlabels([h|t],l,n) <- iswordtoken(h) & / & findlabels(t,l,n+1). findlabels([h|t],l,n) <- isnotlabeltoken(h) & / & findlabels(t,l,n). findlabels([lbl|t],l,n) <- insert(l,noof(lbl),n) & findlabels(t,l,n) & lbl/=RELDEF & lbl/=FUNCDEF. findlabels([],_,_). filesize([RELDEF,_|t],r) <- / & filesize(t,r). filesize([FUNCDEF,_,_|t],r) <- / & filesize(t,r). filesize([h|t],r) <- iswordtoken(h) & / & filesize(t,r0) & r=1+r0. filesize([_|t],r) <- filesize(t,r). filesize([],0). iswordtoken(h) <- (islabeltoken(h) or isnametoken(h)) & / & false. iswordtoken(_). isnotlabeltoken(h) <- islabeltoken(h) & / & false. isnotlabeltoken(_). islabeltoken(h) <- notinteger(h) & name(h,n) & islabel(n). isnotnametoken(h) <- isnametoken(h) & / & false. isnotnametoken(_). isnametoken(h) <- notinteger(h) & name(h,n) & isname(n). notinteger(i) <- integer(i) & / & false. notinteger(_). islabel([##|t]) <- islabelno(t). islabelno([h|t]) <- h>=#0 & h<=#9 & islabelno(t). islabelno([#:]). isname([##|t]) <- isnametext(t). isnametext([#:]) <- /. isnametext([_|t]) <- isnametext(t). insert([v|_],1,v) <- /. insert([_|t],i,v) <- i>1 & insert(t,i-1,v). writetokens([DEFCONST(n)|t]) <- / & write('DEFCONST ') & write(n) & nl() & writetokens(t). writetokens([DEFDSTRUCT(n,a)|t]) <- / & write('DEFDSTRUCT ') & write(n) & write(',') & write(a) & nl() & writetokens(t). writetokens([RELATION(n,a,start,nooflbls,loffs)|t]) <- / & name(n,n0) & append(n1,[#:],n0) & name(n2,n1) & write('RELATION ') & write(n2) & write(',') & write(a) & write(',') & write(start) & write(',') & write(nooflbls) & write(',') & writelist(loffs) & nl() & writetokens(t). writetokens([FUNCTION(n,a,start,nooflbls,loffs)|t]) <- / & name(n,n0) & append(n1,[#:],n0) & name(n2,n1) & write('FUNCTION ') & write(n2) & write(',') & write(a) & write(',1,') & write(start) & write(',') & write(nooflbls) & write(',') & writelist(loffs) & nl() & writetokens(t). writetokens([h|t]) <- write(h) & nl() & / & writetokens(t). writetokens([]). writelist([x]) <- / & write(x). writelist([h|t]) <- t/=[] & write(h) & write(',') & writelist(t). writelist([]). tokenpars([f|r],t) <- f<=32 & / & tokenpars(r,t). tokenpars(l,[h|t]) <- l=[f|_] & f>32 & / & token(l,r,h) & tokenpars(r,t). tokenpars([],[]). token([c|t],r,h) <- c>32 & / & untildelim(t,ct,r) & l=[c|ct] & (name(h,l) & / or write(Namearg(h,l)) & false). untildelim([],[],[]) <- /. untildelim([h|t],[h|t0],r) <- h>32 & h/=#\ & h/=#, & / & untildelim(t,t0,r). untildelim([#\,h|t],[#\,h|t0],r) <- / & untildelim(t,t0,r). untildelim([h|t],[],t) <- h<=32 or h=#,. uniquelist([h|t],t0) <- member(h,t) & / & uniquelist(t,t0). uniquelist([h|t],[h|t0]) <- uniquelist(t,t0). uniquelist([],[]). member(x,[x|_]) <- /. member(x,[_|t])<- member(x,t). notmember(x,l) <- member(x,l) & / & false. notmember(_,_). length([_|t])=1+length(t). length([])=0. noof(lbl)=convert(reverse(r0)) <- islabeltoken(lbl) & name(lbl,[##|r]) & append(r0,[#:],r). convert([])=0. convert([h|t])=(h-48)+10*convert(t). append([],x,x). append([h|t],x,[h|t0]) <- append(t,x,t0). reverse([])=[]. reverse([h|t])=l <- append(reverse(t),[h],l). writenumbered([],_) <- nl(). writenumbered([h|t],n) <- write(n) & write(' ') & write(h) & nl() & writenumbered(t,n+1). lista([]) <- /. lista([_|t]) <- lista(t). .FF .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/slplbl/ftr.lpl ============================================================================ .R /* Converts slp-file into lbl-file. */ p() <- char_infile([],0)=s & tokenpars(s,l0) & / & pick(l0,r,l0,0,sz) & uniquelist(r,r0) & writetokens(r0) & write('FILESIZE ') & write(sz) & nl() & /. pick(["CONST",n|t],[DEFCONST(n)|t0],l,i,j) <- / & pick(t,t0,l,i+2,j). pick(["DSTRUCT",n,_,a|t],[DEFDSTRUCT(n,a)|t0],l,i,j) <- / & pick(t,t0,l,i+4,j). pick([n,"RELDEF",a|t],[RELATION(n,a,i,nooflbls,lbls)|t0],l,i,j) <- / & findlabels(t,lbls,0) & lista(lbls) & nooflbls=length(lbls) & pick(t,t0,l,i,j). pick([n,"FUNCDEF",a,b|t],[FUNCTION(n,a,b,i,nooflbls,lbls)|t0],l,i,j) <- / & findlabels(t,lbls,0) & lista(lbls) & nooflbls=length(lbls) & pick(t,t0,l,i,j). pick([h|t],t0,l,i,j) <- islabeltoken(h) & / & pick(t,t0,l,i,j). pick([h|t],t0,l,i,j) <- /* isnotlabeltoken(h) & */ / & pick(t,t0,l,i+1,j). pick([],[],_,i,i). findlabels(["RELDEF"|_],_,_) <- /. findlabels(["FUNCDEF"|_],_,_) <- /. findlabels([h|t],l,n) <- iswordtoken(h) & / & findlabels(t,l,n+1). findlabels([h|t],l,n) <- isnotlabeltoken(h) & / & findlabels(t,l,n). findlabels([lbl|t],l,n) <- lbl/="RELDEF" & lbl/="FUNCDEF" & insert(l,noof(lbl),n) & / & findlabels(t,l,n). findlabels([],_,_). filesize(["RELDEF",_|t],r) <- / & filesize(t,r). filesize(["FUNCDEF",_,_|t],r) <- / & filesize(t,r). filesize([h|t],r) <- iswordtoken(h) & / & filesize(t,r0) & r=1+r0. filesize([_|t],r) <- filesize(t,r). filesize([],0). iswordtoken(h) <- (islabeltoken(h) or isnametoken(h)) & / & false. iswordtoken(_). isnotlabeltoken(h) <- islabeltoken(h) & / & false. isnotlabeltoken(_). islabeltoken(h) <- notinteger(h) & islabel(h). isnotnametoken(h) <- isnametoken(h) & / & false. isnotnametoken(_). isnametoken(h) <- notinteger(h) & isname(h). notinteger(h) <- isinteger(h) & / & false. notinteger(_). isinteger([h|t]) <- h>=#0 & h<=#9 & (t=[] or isinteger(t)) & /. islabel([##|t]) <- islabelno(t). islabelno([h|t]) <- h>=#0 & h<=#9 & / & islabelno(t). islabelno([#:]). isname([##|t]) <- isnametext(t). isnametext([#:]) <- /. isnametext([_|t]) <- isnametext(t). insert([v|_],1,v) <- /. insert([_|t],i,v) <- i>1 & insert(t,i-1,v). writetokens([DEFCONST(n)|t]) <- / & write('DEFCONST ') & wrlist(n) & nl() & writetokens(t). writetokens([DEFDSTRUCT(n,a)|t]) <- / & write('DEFDSTRUCT ') & wrlist(n) & write(',') & wrlist(a) & nl() & writetokens(t). writetokens([RELATION(n,a,start,nooflbls,loffs)|t]) <- / & append(n1,[#:],n) & write('RELATION ') & wrlist(n1) & write(',') & wrlist(a) & write(',') & write(start) & write(',') & write(nooflbls) & write(',') & writelist(loffs) & nl() & writetokens(t). writetokens([FUNCTION(n,a,b,start,nooflbls,loffs)|t]) <- / & append(n1,[#:],n) & write('FUNCTION ') & wrlist(n1) & write(',') & wrlist(a) & write(',') & wrlist(b) & write(',') & write(start) & write(',') & write(nooflbls) & write(',') & writelist(loffs) & nl() & writetokens(t). writetokens([h|t]) <- write(h) & nl() & / & writetokens(t). writetokens([]). writelist([x]) <- / & write(x). writelist([h|t]) <- / & t/=[] & write(h) & write(',') & writelist(t). writelist([]). wrlist([h|t]) <- / & put(h) & wrlist(t). wrlist([]). tokenpars([f|r],t) <- f<=32 & / & tokenpars(r,t). tokenpars(l,[h|t]) <- l=[f|_] & f>32 & / & token(l,r,h) & tokenpars(r,t). tokenpars([],[]). token([c|t],r,h) <- c>32 & / & untildelim(t,ct,r) & l=[c|ct] & (h=l & / or write(Namearg(h,l)) & false). untildelim([],[],[]) <- /. untildelim([h|t],[h|t0],r) <- h>32 & h/=#\ & h/=#, & / & untildelim(t,t0,r). untildelim([#\,h|t],[#\,h|t0],r) <- / & untildelim(t,t0,r). untildelim([h|t],[],t) <- h<=32 & / or h=#,. uniquelist([h|t],t0) <- member(h,t) & / & uniquelist(t,t0). uniquelist([h|t],[h|t0]) <- / & uniquelist(t,t0). uniquelist([],[]). member(x,[x|_]) <- /. member(x,[_|t])<- member(x,t). notmember(x,l) <- member(x,l) & / & false. notmember(_,_). length([_|t])=1+length(t). length([])=0. noof(lbl)=convert(reverse(r0)) <- islabeltoken(lbl) & lbl=[##|r] & append(r0,[#:],r). convert([])=0. convert([h|t])=(h-48)+10*convert(t). append([],x,x) <- /. append([h|t],x,[h|t0]) <- append(t,x,t0). reverse([])=[]. reverse([h|t])=l <- append(reverse(t),[h],l). writenumbered([],_) <- nl() & /. writenumbered([h|t],n) <- write(n) & write(' ') & write(h) & nl() & writenumbered(t,n+1). lista([]) <- /. lista([_|t]) <- lista(t). .FF .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/slplbl/ftr0.lpl ============================================================================ .R /* Converts slp-file into lbl-file. */ p() <- char_infile([],0)=s & tokenpars(s,l0) & / & pick(l0,r,0,sz,0,_,0,_) & uniquelist(r,r0) & writetokens(r0) & write('FILESIZE ') & write(sz) & nl() & /. /* pick(listin,listout,absoffs,filesz,reloffs,lbls,accnooflbls,totnooflbls) */ pick(["CONST",n|t],[DEFCONST(n)|t0],aoffs,fz,roffs,lbls,nlsf,tnl) <- / & pick(t,t0,aoffs+2,fz,roffs+2,lbls,nlsf,tnl). pick(["DSTRUCT",n,_,a|t],[DEFDSTRUCT(n,a)|t0],aoffs,fz,roffs,lbls,nlsf,tnl) <- / & pick(t,t0,aoffs+4,fz,roffs+4,lbls,nlsf,tnl). pick([n,"RELDEF",a|t],[RELATION(n,a,aoffs,nooflbls,lbls)|t0], aoffs,fz,_,oldlbls,tnl,tnl) <- list(oldlbls) & / & pick(t,t0,aoffs,fz,0,lbls,0,nooflbls). pick([n,"FUNCDEF",a,b|t],[FUNCTION(n,a,b,aoffs,nooflbls,lbls)|t0], aoffs,fz,_,oldlbls,tnl,tnl) <- list(oldlbls) & / & pick(t,t0,aoffs,fz,0,lbls,0,nooflbls). pick([h|t],t0,aoffs,fz,roffs,lbls,nlsf,tnl) <- islabeltoken(h) & / & insert(lbls,noof(h),roffs) & pick(t,t0,aoffs,fz,roffs,lbls,nlsf+1,tnl). pick([_|t],t0,aoffs,fz,roffs,lbls,nlsf,tnl) <- / & pick(t,t0,aoffs+1,fz,roffs+1,lbls,nlsf,tnl). pick([],[],fz,fz,_,oldlbls,tnl,tnl) <- list(oldlbls). /* iswordtoken(h) <- (islabeltoken(h) or isnametoken(h)) & / & false. iswordtoken(_). isnotlabeltoken(h) <- islabeltoken(h) & / & false. isnotlabeltoken(_). */ islabeltoken(h) <- notinteger(h) & islabel(h). /* isnotnametoken(h) <- isnametoken(h) & / & false. isnotnametoken(_). */ isnametoken(h) <- notinteger(h) & isname(h). notinteger(h) <- isinteger(h) & / & false. notinteger(_). isinteger([h|t]) <- h>=#0 & h<=#9 & (t=[] or isinteger(t)) & /. islabel([##|t]) <- islabelno(t). islabelno([h|t]) <- h>=#0 & h<=#9 & / & islabelno(t). islabelno([#:]). isname([##|t]) <- isnametext(t). isnametext([#:]) <- /. isnametext([_|t]) <- isnametext(t). insert([v|_],1,v) <- /. insert([_|t],i,v) <- i>1 & insert(t,i-1,v) & /. insert(x,y,z) <- write(InsertFailed(x,y,z)) & false. writetokens([DEFCONST(n)|t]) <- / & write('DEFCONST ') & wrlist(n) & nl() & writetokens(t). writetokens([DEFDSTRUCT(n,a)|t]) <- / & write('DEFDSTRUCT ') & wrlist(n) & write(',') & wrlist(a) & nl() & writetokens(t). writetokens([RELATION(n,a,start,nooflbls,loffs)|t]) <- / & append(n1,[#:],n) & write('RELATION ') & wrlist(n1) & write(',') & wrlist(a) & write(',') & write(start) & write(',') & write(nooflbls) & write(',') & writelist(loffs) & nl() & writetokens(t). writetokens([FUNCTION(n,a,b,start,nooflbls,loffs)|t]) <- / & append(n1,[#:],n) & write('FUNCTION ') & wrlist(n1) & write(',') & wrlist(a) & write(',') & wrlist(b) & write(',') & write(start) & write(',') & write(nooflbls) & write(',') & writelist(loffs) & nl() & writetokens(t). writetokens([h|t]) <- write(h) & nl() & / & writetokens(t). writetokens([]). writelist([x]) <- / & write(x). writelist([h|t]) <- / & t/=[] & write(h) & write(',') & writelist(t). writelist([]). wrlist([h|t]) <- / & put(h) & wrlist(t). wrlist([]). tokenpars([f|r],t) <- f<=32 & / & tokenpars(r,t). tokenpars(l,[h|t]) <- l=[f|_] & f>32 & / & token(l,r,h) & tokenpars(r,t). tokenpars([],[]). token([c|t],r,h) <- c>32 & / & untildelim(t,ct,r) & l=[c|ct] & (h=l & / or write(Namearg(h,l)) & false). untildelim([],[],[]) <- /. untildelim([h|t],[h|t0],r) <- h>32 & h/=#\ & h/=#, & / & untildelim(t,t0,r). untildelim([#\,h|t],[#\,h|t0],r) <- / & untildelim(t,t0,r). untildelim([h|t],[],t) <- h<=32 & / or h=#,. uniquelist([h|t],t0) <- member(h,t) & / & uniquelist(t,t0). uniquelist([h|t],[h|t0]) <- / & uniquelist(t,t0). uniquelist([],[]). member(x,[x|_]) <- /. member(x,[_|t])<- member(x,t). notmember(x,l) <- member(x,l) & / & false. notmember(_,_). length([_|t])=1+length(t). length([])=0. noof(lbl)=convert(reverse(r0)) <- islabeltoken(lbl) & lbl=[##|r] & append(r0,[#:],r). convert([])=0. convert([h|t])=(h-48)+10*convert(t). append([],x,x) <- /. append([h|t],x,[h|t0]) <- append(t,x,t0). reverse([])=[]. reverse([h|t])=l <- append(reverse(t),[h],l). writenumbered([],_) <- nl() & /. writenumbered([h|t],n) <- write(n) & write(' ') & write(h) & nl() & writenumbered(t,n+1). list([]) <- /. list([_|t]) <- list(t). .FF .TITLE Appendix 9: Testing the parsing phase. .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/pars/debugtransform.lpl ============================================================================ .R /* transform.lpl Author: Thomas Sjoland, Purpose: contains various LPL0-clauses to be used in the translation into normal form and the optimizing phase of the LPL0-compiler. */ /* Transform a formula to a normal and optimized form. */ /* transform(s)=andor(removeeqs(extracteqs(funcstopreds(s1a)))) <- fefuns(funchtopredh(s),[])=[s1,_] & funcsinhead(s1,s1a). */ transform(s)=s5 <- funchtopredh(s)=s0 & writeln(' Function definitions converted to predicate form:') & printabstract(s0) & writeln('.') & / & fefuns(s0,[])=[s1,_] & writeln(' Nested function calls unfolded:') & printabstract(s1) & writeln('.') & / & funcsinhead(s1,s1a) & / & writeln(' Functions in head transferred to body:') & printabstract(s1a) & writeln('.') & / & funcstopreds(s1a)=s2 & writeln(' Function calls converted to predicate form:') & printabstract(s2) & writeln('.') & / & writeln(' Equal variables replaced:') & s3=extracteqs(s2) & printabstract(s3) & writeln('.') & / & writeln('Redundant equalities removed:') & s4=removeeqs(s3) & printabstract(s4) & writeln('.') & / & s5=andor(s4) & writeln('Andored:') & printabstract(s5) & writeln('.') & /. /* Translate the map from variables to functions to a formula. */ mapformula([],f)=f. mapformula([h|t],f)=Goalform('&',Atomic('=',h,Pred),mapformula(t,f)). /* Extract nested functions from a Formula and store them in a map. */ /* Type: termlist tl, ntl; map(varname,function) map, nmap */ fefuns(Atomic(n,tl,fp),map)= [mapformula(freverse(difflist(nmap,map)),Atomic(n,ntl,fp)),nmap] <- efuns(tl,map,[ntl,nmap]). fefuns(Goalform(c,f1,f2),map)=[Goalform(c,nf1,nf2),nmap] <- fefuns(f1,map)=[nf1,map0] & fefuns(f2,map0)=[nf2,nmap]. fefuns(All(vl,f),map)=[All(vl,nf),nmap] <- fefuns(f,map)=[nf,nmap]. fefuns(Exist(vl,f),map)=[Exist(vl,nf),nmap] <- fefuns(f,map)=[nf,nmap]. fefuns(Schema(n,rnl,tl,fp),map)= [mapformula(difflist(nmap,map),Schema(n,rnl,ntl,fp)),nmap] <- efuns(tl,map,[ntl,nmap]). /* Extract functions from a termlist. */ /* Type: termlist tl, ntl ; map(varname,function) map,nmap */ efuns([h|t],map,[[nh|nt],nmap]) <- (h=Var(_) or h=Constant(_) or h=Int(_)) & / & nh=h & efuns(t,map,[nt,nmap]). efuns([Dstruct(n,dtl)|t],map,[[Dstruct(n,dtl1)|nt],nmap]) <- efuns(dtl,map,[dtl1,map0]) & efuns(t,map0,[nt,nmap]). efuns([Function(n,ftl)|t],map,[[nm|nt],nmap]) <- efuns(ftl,map,[ftl1,map0]) & funmapupdate(map0,Function(n,ftl1),[nm,map1]) & efuns(t,map1,[nt,nmap]). efuns([],map,[[],map]). funmapupdate(map,fun,[nam,map0]) <- map=[_,_] & member([fun,nam],map) & map0=map or nam=uniquename(map) & map0=[[fun,nam]|map]. uniquename(map)=Var(Name(Varid(highestsysvarno(map,0)+1),System)). highestsysvarno([],a)=a. highestsysvarno([[_,nam]|t],a)=v <- nam=Var(Name(Varid(i),System)) & (i>a & v=i or v=a) & / or v=highestsysvarno(t,a). /* funchtopredh converts a function definition to predicate form. */ funchtopredh(Goalform(c,Atomic('=',[Function(f,tl),r],_),b)) =Goalform('<-',Atomic(f,fappend(tl,[Var(Name(Varid(RESULT),System))]),Func), Goalform('&',b, Goalform('&',Atomic('=',[Var(Name(Varid(RESULT),System)),r],Pred), Atomic(Name(CUT,System),[],Pred)))). funchtopredh(Atomic('=',[Function(f,tl),r],_)) =Goalform('<-',Atomic(f,fappend(tl,[Var(Name(Varid(RESULT),System))]),Func), Goalform('&',Atomic('=',[Var(Name(Varid(RESULT),System)),r],Pred), Atomic(Name(CUT,System),[],Pred))). funchtopredh(x)=x <- otherwise. funcsinhead(Goalform('<-',h,b), Goalform('<-',nh,Goalform('&',fh,b))) <- extracthead(h,[nh,fh]). funcsinhead(f,Goalform('<-',nh,fh)) <- f=Goalform('&',_,_) & extracthead(f,[nh,fh]). funcsinhead(x,x) <- x=Goalform('<-',Atomic(_,_,_),_) or x=Atomic(_,_,_). extracthead(Goalform('&',l,r),[h,fh]) <- l=Atomic(_,_,_) & h=l & fh=r or l=Goalform('&',_,_) & fh=Goalform('&',r0,r) & extracthead(l,[h,r0]). extracthead(x,_) <- write('extracthead failed on:') & prettyabstract(x,0,2) & false. /* funcstopreds converts equalities representing functional calls to predicate calls in a formula. */ funcstopreds(Atomic('=',[Function(f,tl),r],_))=Atomic(f,fappend(tl,[r]),Func). funcstopreds(Atomic('=',[r,Function(f,tl)],_))=Atomic(f,fappend(tl,[r]),Func) <- r/=Function(_,_). funcstopreds(Goalform(c,f1,f2))=Goalform(c,funcstopreds(f1),funcstopreds(f2)). funcstopreds(All(vs,f))=All(vs,funcstopreds(f)). funcstopreds(Exist(vs,f))=Exist(vs,funcstopreds(f)). funcstopreds(f)=f <- otherwise. extracteqs(f0)=f <- collecteqs(f0,[],m,ft) & fixvarmap(m)=m0 & replaceeqs(ft,m0)=f. fixvarmap([])=[]. fixvarmap([[v0,v1]|t])=[h|fixvarmap(t)] <- v0=Var(Name(_,User)) & h=[v0,v1] & / or h=[v1,v0]. collecteqs(f,map0,map1,f) <- f=Atomic('=',[t1,t2],_) & t1=Var(v1) & t2=Var(v2) & / & (v1/=v2 & not_member([t1,t2],map0) & not_member([t2,t1],map0) & map1=[[t1,t2]|map0] & / or map1=map0). collecteqs(Goalform(c,f00,f01),map0,map1,Goalform(c,f10,f11)) <- c/='or' & collecteqs(f00,map0,mapt,f10) & collecteqs(f01,mapt,map1,f11). collecteqs(Goalform('or',f00,f01),map,map,Goalform('or',f00,f01)). collecteqs(Atomic(n,tl,fp),map,map,Atomic(n,tl,fp)) <- (n/='=' or tl/=[Var(_),Var(_)]). replaceeqs(Atomic(n,tl,fp),m)=Atomic(n,tl1,fp) <- treplaceeqs(tl,m)=tl1. replaceeqs(Schema(sn,rn,tl,fp),m)=Schema(sn,rn,tl1,fp) <- treplaceeqs(tl,m)=tl1. replaceeqs(Goalform(c,f00,f01),m)=Goalform(c,f10,f11) <- c/='or' & replaceeqs(f00,m)=f10 & replaceeqs(f01,m)=f11. replaceeqs(Goalform('or',f00,f01),m)=Goalform('or',f10,f11) <- f10=replaceeqs(f00,m) & f11=replaceeqs(f01,m). replaceeqs(f,_)=f <- otherwise. treplaceeqs([],_)=[]. treplaceeqs([h|t],m)=[h1|treplaceeqs(t,m)] <- h=Var(_) & (member([h1,h],m) & / or h1=h) or h=Dstruct(n,tl) & h1=Dstruct(n,treplaceeqs(tl,m)) or h=Function(n,tl) & h1=Function(n,treplaceeqs(tl,m)) or h=Constant(_) & h1=h or h=Int(_) & h1=h. removeeqs(Atomic('=',[x,x],_))=Atomic(Name(TRUE,System),[],Pred). removeeqs(Goalform('&',f0,f1))=f2 <- removeeqs(f0)=rf0 & removeeqs(f1)=rf1 & (rf0=Atomic(Name(TRUE,System),[],Pred) & f2=rf1 & / or rf1=Atomic(Name(TRUE,System),[],Pred) & f2=rf0 & / or f2=Goalform('&',rf0,rf1)). removeeqs(Goalform(c,f0,f1))=Goalform(c,removeeqs(f0),removeeqs(f1)) <- c/='&'. removeeqs(x)=x <- otherwise. /* andor converts an andor tree to the right adjusted form. */ andor(x)=x <- x=Atomic(_,_,_). andor(Goalform(c,Goalform(c,f1,f2),f3))= andor(Goalform(c,f1,Goalform(c,f2,f3))) <- (c='&' or c='or'). andor(Goalform(c,f1,f2))=Goalform(c,andor(f1),andor(f2)) <- f1/=Goalform(c,_,_) & (c='&' or c='or'). andor(Goalform(c,f1,f2))=Goalform(c,andor(f1),andor(f2)) <- c/='&' & c/='or'. .FF .B ============================================================================ .ce 1 /home/alf/public_html/LPL/compiler/pars/testtop.lpl ============================================================================ .R /* toplevel.lpl 84 05 25 desc: toplevel for testing scanner and parser frontend. .SW author: Thomas Sj|land, CSALAB .US */ prog() <- char_infile([],0)=l & (true() or writeln('parsprog failed') & false) & parsprog(l,p) & / & diffwriteln(l,[]) & printabstract(p). parsprog(l,Prog(rdefs,schdefs)) <- parsall(l,[],[],rdefs,schdefs). parsall(l,rdefsin,schdefsin,rdefsout,schdefsout) <- parspred(l,r,f,n,type) & ( type=Reldef & deftabupdate(rdefsin,rdefstmp,n,f) & / & parsall(r,rdefstmp,schdefsin,rdefsout,schdefsout) or type=Schdef & deftabupdate(schdefsin,schdefstmp,n,f) & / & parsall(r,rdefsin,schdefstmp,rdefsout,schdefsout) or type=ERROR & writeln('A parsing error occurred.') & / & parsall(r,rdefsin,schdefsin,rdefsout,schdefsout) or type=EOF & schdefsout=schdefsin & rdefsout=rdefsin). deftabupdate([h0|t0],[h1|t1],n,f) <- h0=[n,brdefs,frdefs] & / & ( (f=Limp(_,_,_) or f=Assert(_,_)) & / & insert(f,brdefs)=brdefs0 & frdefs=frdefs0 or f=Rimp(_,_,_) & insert(f,frdefs)=frdefs0 & brdefs=brdefs0 ) & t1=t0 & h1=[n,brdefs0,frdefs0] or h1=h0 & deftabupdate(t0,t1,n,f). deftabupdate([],[[n,bdefs,fdefs]],n,f) <- (f=Limp(_,_,_) or f=Assert(_,_)) & / & bdefs=[f] & fdefs=[] or f=Rimp(_,_,_) & fdefs=[f] & bdefs=[]. parspred(l,r,f,n,type) <- scan(l,r,tokens) & tokens/=[] /* & wrdifflist(l,r) & nl() & / */ & (true() or writeln('parse failed.') & debug(5)) & parse(tokens,s) & / & (true() or writeln('enumvoidvars failed.') & debug(5)) & enumvoidvars(s,0,_) & / & prettyabstract(s,0,2) & (true() or writeln('transform failed.') & debug(5)) & s0=transform(s) & / & writeln('Transformed:') & prettyabstract(s0,0,2) & printabstract(s0) & writeln('.') & / & (true() or writeln('extractvars failed.') & debug(5)) & (s0=Atomic(n,tl,_) & vars=extractvars(tl,[]) & / & f=Assert(vars,tl) & type=Reldef or (c='<-' or c='<->') & s0=Goalform(c,Atomic(n,tl,_),body) & vars=extractvars(s0,[]) & / & f=Limp(vars,tl,body) & type=Reldef) & / or tokens=[] & type=EOF & / or type=ERROR. /* Extracts the variable from a formula. */ extractvars(Atomic(_,tl,_),p)=extractvars(tl,p). extractvars(Goalform(_,f1,f2),p)=extractvars(f2,extractvars(f1,p)). extractvars([],p)=p. extractvars([x|t],p)=extractvars(t,p0) <- x=Dstruct(_,tl) & p0=extractvars(tl,p) & / or x=Var(_) & / & (member(x,p) & p0=p & / or p0=[x|p]) & / or p=p0. scan(l,r,tl) <- token_list(l,r,tl) & / or write('The statement contained an illegal token.'). parse(l,s) <- is_statement(l,[],s) & / or writeln('The syntax of this statement is illegal:') & wrlist(l) & nl(). enumvoidvars(f,n,m) <- (f=Atomic(_,x,_) or f=Schema(_,_,x,_) or f=All(_,x) or f=Exist(_,x) or f=Dstruct(_,x) or f=Function(_,x)) & / & enumvoidvars(x,n,m) or f=Goalform(_,f0,f1) & / & enumvoidvars(f0,n,n0) & enumvoidvars(f1,n0,m) or (f=Constant(_) or f=Int(_) or f=[]) & m=n & / or f=Var(Name(nm,type)) & (type/=Void & m=n or type=Void & nm=n & m=n+1) & / or f=[h|t] & enumvoidvars(h,n,n0) & enumvoidvars(t,n0,m). /* Enumerate a termlist L. */ enumtermlist([Lbl(l)|t],n,i) <- index(i,l,n) & enumtermlist(t,n+1,i). enumtermlist([RELDEF(_)|t],_,i) <- enumtermlist(t,1,i). enumtermlist([FUNCDEF(_,_)|t],_,i) <- enumtermlist(t,1,i). enumtermlist([h|t],n,i) <- h/=Lbl(_) & h/=RELDEF(_) & h/=FUNCDEF(_,_) & enumtermlist(t,n,i). enumtermlist([],_,_). .FF There are also assorted c-programs, shell scripts and makefiles of no particular interest to this undertaking and therefore not added here. The End.