├── .gitignore ├── Cargo.toml ├── Justfile ├── NOTES.md ├── README.md ├── examples ├── 99-prolog-problems │ ├── README.md │ ├── inputs │ │ ├── p7_09a.dat │ │ ├── p7_09b.dat │ │ ├── p7_09c.dat │ │ └── p7_09d.dat │ ├── p1_lists.pl │ ├── p2_arithmetic.pl │ ├── p3_logic_and_codes.pl │ ├── p4_binary_trees.pl │ ├── p5_multiway_trees.pl │ └── p7_miscellaneous.pl ├── eight_queens.pl ├── hello.pl ├── likes.pl ├── mortal.pl ├── not_or.pl ├── overflow.pl └── whole_number.pl ├── lib └── stdlib.pl └── src ├── database.rs ├── errors.rs ├── lib.rs ├── main.rs ├── parser ├── errors.rs ├── lexer.rs ├── mod.rs ├── parser.rs └── reader.rs ├── solver ├── byrd.rs ├── cmp.rs ├── eval.rs ├── math.rs ├── mod.rs ├── tests.rs ├── unify.rs └── vars.rs └── types.rs /.gitignore: -------------------------------------------------------------------------------- 1 | # Generated by Cargo 2 | # will have compiled files and executables 3 | debug/ 4 | target/ 5 | 6 | # Remove Cargo.lock from gitignore if creating an executable, leave it for libraries 7 | # More information here https://doc.rust-lang.org/cargo/guide/cargo-toml-vs-cargo-lock.html 8 | Cargo.lock 9 | 10 | # These are backup files generated by rustfmt 11 | **/*.rs.bk 12 | 13 | # MSVC Windows builds of rustc generate these, which store debugging information 14 | *.pdb 15 | 16 | 17 | # Added by cargo 18 | 19 | /target 20 | 21 | # Custom 22 | 23 | /prolog 24 | -------------------------------------------------------------------------------- /Cargo.toml: -------------------------------------------------------------------------------- 1 | [package] 2 | name = "prologrs" 3 | version = "0.1.0" 4 | edition = "2021" 5 | 6 | [dependencies] 7 | rustyline = "14.0.0" 8 | 9 | [dev-dependencies] 10 | test-case = "3.3.1" 11 | 12 | [profile.optimized] 13 | # see: https://doc.rust-lang.org/rustc/codegen-options/index.html 14 | inherits = "release" 15 | strip = "symbols" 16 | lto = true 17 | 18 | [lib] 19 | doctest = false 20 | -------------------------------------------------------------------------------- /Justfile: -------------------------------------------------------------------------------- 1 | # run linter and tests 2 | test: fmt 3 | cargo clippy 4 | cargo test -q 5 | 6 | # autoformat the code 7 | fmt: 8 | cargo fmt 9 | 10 | # evaluate the FILE and launch REPL 11 | run $FILE: 12 | cargo run -- $FILE 13 | 14 | # build the standalone binary 15 | build: 16 | cargo build --profile optimized 17 | rm -rf ./prolog 18 | mv target/optimized/prologrs ./prolog 19 | 20 | # launch REPL 21 | repl: 22 | cargo run 23 | 24 | # cleanup the build files 25 | clean: 26 | rm -rf ./target/ ./prolog 27 | -------------------------------------------------------------------------------- /NOTES.md: -------------------------------------------------------------------------------- 1 | https://amzi.com/AdventureInProlog/a3simple.php#Chapter3 2 | 3 | Prolog queries work by pattern matching. The query pattern is called a goal. If there is a fact that matches the goal, 4 | then the query succeeds and the listener responds with 'yes.' If there is no matching fact, then the query fails 5 | and the listener responds with 'no.' 6 | 7 | Prolog's pattern matching is called unification. In the case where the logicbase contains only facts, unification 8 | succeeds if the following three conditions hold. 9 | 10 | * The predicate named in the goal and logicbase are the same. 11 | * Both predicates have the same arity. 12 | * All of the arguments are the same. 13 | 14 | https://amzi.com/AdventureInProlog/a4comqry.php#Chapter4 15 | 16 | Simple goals can be combined to form compound queries. For example, we might want to know if there is anything good 17 | to eat in the kitchen. In Prolog we might ask 18 | 19 | ?- location(X, kitchen), edible(X). 20 | 21 | Whereas a simple query had a single goal, the compound query has a conjunction of goals. The comma separating the 22 | goals is read as "and." 23 | 24 | https://amzi.com/AdventureInProlog/a5rules.php 25 | 26 | We said earlier a predicate is defined by clauses, which may be facts or rules. A rule is no more than a stored query. 27 | Its syntax is 28 | 29 | head :- body. 30 | 31 | where 32 | 33 | `head` a predicate definition (just like a fact) 34 | 35 | `:-` the neck symbol, sometimes read as "if" 36 | 37 | `body` one or more goals (a query) 38 | 39 | With rules, Prolog unifies the goal pattern with the head of the clause. If unification succeeds, then Prolog 40 | initiates a new query using the goals in the body of the clause. 41 | 42 | Rules, in effect, give us multiple levels of queries. The first level is composed of the original goals. The next 43 | level is a new query composed of goals found in the body of a clause from the first level. 44 | 45 | Each level can create even deeper levels. Theoretically, this could continue forever. In practice it can continue 46 | until the listener runs out of space. 47 | 48 | ## Unification 49 | 50 | * https://github.com/dtonhofer/prolog_notes/tree/master/other_notes/about_byrd_box_model 51 | * https://preserve.lehigh.edu/lehigh-scholarship/graduate-publications-theses-dissertations/theses-dissertations/design-71?article=5506&context=etd 52 | * https://www.cs.cornell.edu/courses/cs3110/2011sp/Lectures/lec26-type-inference/type-inference.htm#4 53 | * http://www.cs.trincoll.edu/~ram/cpsc352/notes/unification.html 54 | * https://www.cs.bham.ac.uk//research/projects/poplog/paradigms_lectures/lecture20.html#representing 55 | * https://norvig.com/unify-bug.pdf 56 | * https://staff.um.edu.mt/mcam1/Files/Dissertation.pdf 57 | * https://lpn.swi-prolog.org/lpnpage.php?pagetype=html&pageid=lpn-htmlch2 58 | * https://www.amzi.com/articles/prolog_under_the_hood.htm 59 | * https://homes.cs.washington.edu/~bodik/ucb/cs164/sp13/lectures/07-implementing-prolog-sp13.pdf 60 | 61 | ## Backtracking 62 | 63 | * https://mmalmsten.medium.com/a-practical-introduction-to-backtracking-in-prolog-b9cfaee0eb6a 64 | * https://en.wikipedia.org/wiki/Depth-first_search 65 | * https://en.wikipedia.org/wiki/Backtracking 66 | * http://jeffe.cs.illinois.edu/teaching/algorithms/book/02-backtracking.pdf 67 | * https://web.stanford.edu/class/archive/cs/cs106b/cs106b.1188/lectures/Lecture11/Lecture11.pdf 68 | * https://www.cs.toronto.edu/~hojjat/384w09/Lectures/Lecture-04-Backtracking-Search.pdf 69 | 70 | ## Other 71 | 72 | * https://www.cs.jhu.edu/~jason/325/PDFSlides/14prolog.pdf 73 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Prolog.rs 2 | 3 | This is a minimal Prolog interpreter implemented in Rust. 4 | The implementation covers only a subset of Prolog features, 5 | is not intended to be fast, or optimal in any sense. 6 | It is a learning project that helped me to understand Prolog better. 7 | 8 | The implementation is tested using 350+ unit tests, including 9 | running some code solutions for the ["99 Prolog problems"], 10 | and unit tests checking for ISO Prolog consistency. There are 11 | some differences from other Prolog implementations though, 12 | as described [below](#limitations-and-differences-from-other-implementations). 13 | 14 | If you are looking for a mature Prolog implementation in Rust, 15 | check rather the [Scryer](https://www.scryer.pl/) Prolog. 16 | 17 | ## Usage 18 | 19 | To run the Prolog interpreter you can use the [Justfile] commands: 20 | 21 | ```shell 22 | $ just test # runs tests 23 | $ just build # builds the standalone binary ./prolog 24 | $ just run FILE # evaluate the FILE and start REPL 25 | $ just repl # start REPL 26 | ``` 27 | 28 | To install it, move the `prolog` binary together with the `lib/` directory to some 29 | directory of your choice. 30 | 31 | Calling `./prolog -e FILE` from the command line would evaluate the *FILE*, run 32 | the `main/0` goal (if available), and exit. 33 | 34 | ## Data types 35 | 36 | The units of data in Prolog are called *terms*. 37 | 38 | * Atoms are name-only datatypes, for example, `foo`. 39 | Their names need to start with a lowercase letter. 40 | * Integers are the only supported numerical type. 41 | * Variables have no specific value, but they can be initialized 42 | with a value during unification (see below). Their names 43 | need to start with uppercase letters or `_`. 44 | * There exist also compound terms: 45 | * Structures like `foo(a, b)` have name `foo` and 46 | arguments (`c` and `b`). 47 | * Lists like `[1, 2, 3]` can contain multiple terms. 48 | 49 | In Prolog everything is a struct, so atom `foo` is the same as `foo()`, operation like 50 | `2 + 2` is `+(2, 2)`, the "and" operator in `a , b` is `,(a, b)` 51 | (don't be confused with the comma separating the arguments), etc. 52 | 53 | Lists in Prolog are also structs, so `[1, 2, 3]` is represented as `.(1, .(2, .(3, [])))`, where 54 | `[]` stands for an empty list. Prolog allows you to create dotted pairs (in [lisp] terms), for example 55 | `[1 | 2]` is represented as `.(1, 2)`. 56 | 57 | There are no booleans. Terms are evaluated by unification. The term `fail` always fails the unification. 58 | 59 | ```prolog 60 | ?- 1=1. 61 | yes 62 | ?- \+ 1=1. 63 | no 64 | ?- fail. 65 | no 66 | ?- \+ fail. 67 | yes 68 | ``` 69 | 70 | ## Facts, rules, and questions 71 | 72 | Prolog programs are defined in terms of three kinds of expressions: 73 | 74 | * Facts, like `foo.` or `bar(a,b,32).` state what is "true". 75 | * Rules, like `mortal(Who) :- person(Who).` define logical implications. 76 | * Questions, like `?- mortal(socrates).` validate if the question is true. 77 | 78 | A very simple Prolog program may solve the classical logical question: 79 | 80 | ```prolog 81 | % fact 82 | person(socrates). 83 | 84 | % rule 85 | mortal(Who) :- 86 | person(Who). 87 | 88 | % question 89 | ?- mortal(socrates). 90 | ``` 91 | 92 | ## Unification 93 | 94 | Prolog extensively uses pattern matching. When you ask a *question*, it searches its 95 | database if any of the recorded *facts* and *rules* that match the goals in the question. 96 | This is nicely explained in the *[Adventure in Prolog]* book by Dennis Merritt: 97 | 98 | > Prolog's pattern matching is called **unification**. In the case where the logicbase 99 | > contains only facts, unification succeeds if the following three conditions hold. 100 | > 101 | > * The predicate named in the goal and logicbase are the same. 102 | > * Both predicates have the same arity. 103 | > * All of the arguments are the same. 104 | 105 | When variable is unified with the value, the variable becomes equivalent to the value. 106 | If two free variables are unified, they become each other's aliases. 107 | 108 | There are also procedures using special evaluation rules instead of unification, for example: 109 | 110 | ```prolog 111 | ?- X is 1+2. 112 | X = 3 113 | ?- 1+2 < 5. 114 | yes 115 | ?- writeln('hello, world!'). 116 | hello, world! 117 | yes 118 | ``` 119 | 120 | ## Features 121 | 122 | By design, this interpreter covers only a subset of Prolog's features. Those include: 123 | 124 | * `fail` is a goal that always fails. 125 | * `a , b` means that we want to satisfy both *a* and *b*, while `a ; b` means *a* or *b*. 126 | * `\+` can be used to negate a goal. 127 | * `!` is the [cut operator]. It prevents backtracking for the goals preceding it. 128 | * `->` is the if-else operator, `Cond -> Then` tries to satisfy `Cond`, if it succeeds, 129 | then attempts to satisfy `Then`, otherwise it fails. Underneath, it is a syntactic 130 | sugar for expressing `Cond, !, Then`. 131 | * `=` is a unification operator, it is equivalent to `=(A, A)`. 132 | * `_` is a wildcard variable that unifies with anything but never holds any value. 133 | * `is` operator, as in `X is 2 + 2`, evaluates the right-hand-side and if left-hand-side is 134 | a free variable, assigns the result to it, otherwise compares the result to it's value 135 | (so `4 is 2 + 2` evaluates to "yes"). 136 | * The supported mathematical operators and functions are: 137 | * unary operators `+`, `-`, 138 | * binary operators `+`, `-`, `*`, `/`, `//` (last two are synonyms), and `rem`, 139 | * `div` and `mod` (using [`i32::div_euclid`][i32] and [`i32::rem_euclid`][i32]), 140 | * `abs` and `sign` functions. 141 | 142 | Those operators can be used together with procedures with special evaluation rules 143 | like `is`, `=:=`, `<`, etc. Outside of those procedures, they will create structs, 144 | for example `2 + 3` would become `+(2,3)`. 145 | * `=:=`, `<` are the numerical comparison operators that evaluate both sides 146 | and compare them, e.g. `2 + 1 < 7 - 2`. 147 | The operators `=\=`, `=<`, `>`, `>=` are available through `lib/stdlib.pl`. 148 | * `==`, `@<` are comparison operators checking the [standard order of terms] 149 | (see [below](#limitations-and-differences-from-other-implementations)). 150 | The operators `\==`, `@=<`, `@>`, `@>=` are available through `lib/stdlib.pl`. 151 | * `consult('path/to/file.pl')` loads and evaluates the file. If the file contains a question (`?-`) 152 | which cannot be satisfied, it will fail with an error. It takes as an argument an atom with 153 | path to the file, or a list of such atoms. 154 | * `write(X)` prints *X* and `nl` prints a newline. 155 | * The `trace` and `untrace` commands can be used to turn the tracing logging on and off. 156 | * `{a, b, c}` is a syntactic sugar for writing `{}(,(a, ,(b, c)))`. It has no special meaning. 157 | * `atom(X)`, `integer(X)`, `number(X)` are type checkers. `var(X)` checks if *X* is a free variable. 158 | 159 | More functionalities are implemented in the standard library available through `lib/stdlib.pl`. 160 | 161 | ## Limitations and differences from other implementations 162 | 163 | * Only a subset of Prolog's functionalities are implemented. Features such as strings or floats types, DCG's, defining 164 | custom operators, etc are not available. 165 | * The precedence of `;` and `,` operators is reversed, so `a , b ; c, d` is parsed the same as `a , (b ; c) , d`. 166 | Use brackets to assure the correct precedence. 167 | * In quoted atom names only a subset of escape characters are allowed, including: `\n`, `\t`, `\s`, `\\`, `\'`. `\"`, 168 | or `\NEWLINE`. 169 | * Under the [standard order of terms] variables should be sorted by their memory addresses. Since in this 170 | implementation variables don't get memory addresses until they are initialized, such ordering is not possible. 171 | * In Prolog `,/2` is an operator such that `a , b` tries to satisfy `a` and `b`. In this implementation instead 172 | of using linked lists, structs are based on Rust `Vec`'s of any size, so `a , b , c` would become `,(a, b, c)` 173 | rather than `,(a, ,(b, c))`. 174 | * Arithmetic `div` and `mod` use [Rust's `i32::div_euclid` and `i32::rem_euclid`][i32] which are defined 175 | [differently to Prolog][swipl-div], but meet the requirement of being consistent with each other. 176 | * Since `_` does not bind, the query like `?- L = [_, _], L = [1, _], L = [2, _]` would give a logically inconsistent 177 | answer "yes". The same query would work correctly in SWI Prolog, but not in Tau prolog 178 | (e.g. [prolog.run](https://prolog.run/)). 179 | * The implementation is not tail-call optimized, so can easily overflow when satisfying complex goals. 180 | * Tracing is simplified and limited as compared to the other implementations. 181 | 182 | 183 | [antlr]: https://github.com/antlr/grammars-v4/blob/master/prolog/prolog.g4 184 | [Adventure in Prolog]: https://www.amzi.com/AdventureInProlog/index.php 185 | [standard order of terms]: https://www.swi-prolog.org/pldoc/man?section=standardorder 186 | [cut operator]: https://pages.cs.wisc.edu/~fischer/cs538.s02/prolog/A13CUT.HTM 187 | [i32]: https://doc.rust-lang.org/std/primitive.i32.html 188 | [lisp]: https://web.mit.edu/scheme_v9.2/doc/mit-scheme-ref/Lists.html#Lists 189 | ["99 Prolog problems"]: https://www.ic.unicamp.br/~meidanis/courses/mc336/2009s2/prolog/problemas/ 190 | [swipl-div]: https://www.swi-prolog.org/pldoc/man?function=div%2f2 191 | [Justfile]: https://github.com/casey/just 192 | -------------------------------------------------------------------------------- /examples/99-prolog-problems/README.md: -------------------------------------------------------------------------------- 1 | # 99 Prolog Problems 2 | 3 | Those solutions come from the following sources: 4 | * https://github.com/jamesconstable/99-prolog-problems (MIT license) 5 | * https://www.ic.unicamp.br/~meidanis/courses/mc336/2009s2/prolog/problemas/ (no license) 6 | * https://gist.github.com/drademacher/41d7ae23a2d6998e3b44 (no license) 7 | 8 | They were adapted by me. 9 | -------------------------------------------------------------------------------- /examples/99-prolog-problems/inputs/p7_09a.dat: -------------------------------------------------------------------------------- 1 | LINUX 2 | PROLOG 3 | PERL 4 | ONLINE 5 | GNU 6 | XML 7 | NFS 8 | SQL 9 | EMACS 10 | WEB 11 | MAC 12 | 13 | ...... . 14 | . . . . 15 | . ..... . 16 | . . . ... 17 | . ... . 18 | ... 19 | -------------------------------------------------------------------------------- /examples/99-prolog-problems/inputs/p7_09b.dat: -------------------------------------------------------------------------------- 1 | AAL 2 | DER 3 | TAL 4 | TAT 5 | ISEL 6 | TELL 7 | ZANK 8 | ZEUS 9 | ALSEN 10 | BLASE 11 | EOSIN 12 | ETTAL 13 | KARRE 14 | LIANE 15 | NEEFS 16 | NONNE 17 | OSTEN 18 | STUHL 19 | TIARA 20 | ANKARA 21 | EGERIA 22 | GRANAT 23 | HIRTEN 24 | MISERE 25 | SAMPAN 26 | TILSIT 27 | WAGGON 28 | FORTUNA 29 | ITALIEN 30 | MADONNA 31 | MELASSE 32 | REAUMUR 33 | RIVIERA 34 | SEKUNDE 35 | SERBIEN 36 | SKELETT 37 | SKRUPEL 38 | STETTIN 39 | STOIKER 40 | HANNIBAL 41 | REGISTER 42 | RELIGION 43 | STANNIOL 44 | TRUEFFEL 45 | UNTERTAN 46 | USAMBARA 47 | VENDETTA 48 | TUEBINGEN 49 | TURKMENEN 50 | ALLENSTEIN 51 | ATTRAKTION 52 | BRIEFTAUBE 53 | TATTERSALL 54 | PROTEKTORAT 55 | TEMPERAMENT 56 | KRANKENKASSE 57 | CHRONOGRAPHIE 58 | TRAUBENZUCKER 59 | WALZER 60 | 61 | . ......... ............. 62 | . . . . . . 63 | . ........... ....... . 64 | . . . . . . 65 | ...... .... . ...... . . 66 | . . . . . . . 67 | . . ...... ..... ....... 68 | . . . . ... . . . 69 | ........ . . . ..... 70 | . . . . . . . . . 71 | . . . ....... . . 72 | ...... . . . ..... 73 | . . . . . . 74 | . ......... ........ . 75 | . . . . . . . . 76 | .... . . . ....... . . 77 | . . . . . . . ... . 78 | . . . . . .......... . . 79 | ..... . . . . . . . 80 | . . . ... . . . . 81 | . .......... . . . . . 82 | . . . . . . . . 83 | ..... ........ ....... . 84 | . . . . . . 85 | ........ ....... ..... 86 | 87 | -------------------------------------------------------------------------------- /examples/99-prolog-problems/inputs/p7_09c.dat: -------------------------------------------------------------------------------- 1 | AAL 2 | DER 3 | TAL 4 | TAT 5 | ISEL 6 | TELL 7 | ZANK 8 | ZEUS 9 | ALSEN 10 | BLASE 11 | EOSIN 12 | ETTAL 13 | KARREN 14 | LIANE 15 | NEEFS 16 | NONNE 17 | OSTEN 18 | STUHL 19 | TIARA 20 | ANKARA 21 | EGERIA 22 | GRANAT 23 | HIRTEN 24 | MISERE 25 | SAMPAN 26 | TILSIT 27 | WAGGON 28 | FORTUNA 29 | ITALIEN 30 | MADONNA 31 | MELASSE 32 | REAUMUR 33 | RIVIERA 34 | SEKUNDE 35 | SERBIEN 36 | SKELETT 37 | SKRUPEL 38 | STETTIN 39 | STOIKER 40 | HANNIBAL 41 | REGISTER 42 | RELIGION 43 | STANNIOL 44 | TRUEFFEL 45 | UNTERTAN 46 | USAMBARA 47 | VENDETTA 48 | TUEBINGEN 49 | TURKMENEN 50 | ALLENSTEIN 51 | ATTRAKTION 52 | BRIEFTAUBE 53 | TATTERSALL 54 | PROTEKTORAT 55 | TEMPERAMENT 56 | KRANKENKASSE 57 | CHRONOGRAPHIE 58 | TRAUBENZUCKER 59 | WALZER 60 | 61 | . ......... ............. 62 | . . . . . . 63 | . ........... ....... . 64 | . . . . . . 65 | ...... .... . ...... . . 66 | . . . . . . . 67 | . . ...... ..... ....... 68 | . . . . ... . . . 69 | ........ . . . ..... 70 | . . . . . . . . . 71 | . . . ....... . . 72 | ...... . . . ..... 73 | . . . . . . 74 | . ......... ........ . 75 | . . . . . . . . 76 | .... . . . ....... . . 77 | . . . . . . . ... . 78 | . . . . . .......... . . 79 | ..... . . . . . . . 80 | . . . ... . . . . 81 | . .......... . . . . . 82 | . . . . . . . . 83 | ..... ........ ....... . 84 | . . . . . . 85 | ........ ....... ..... 86 | 87 | 88 | -------------------------------------------------------------------------------- /examples/99-prolog-problems/inputs/p7_09d.dat: -------------------------------------------------------------------------------- 1 | BANI 2 | HAUS 3 | NETZ 4 | LENA 5 | ANKER 6 | ARIEL 7 | GASSE 8 | INNEN 9 | ORADE 10 | SESAM 11 | SIGEL 12 | ANGOLA 13 | AZETAT 14 | EKARTE 15 | NATTER 16 | NENNER 17 | NESSEL 18 | RITTER 19 | SOMMER 20 | TAUNUS 21 | TRANIG 22 | AGENTUR 23 | ERRATEN 24 | ERREGER 25 | GELEISE 26 | HAENDEL 27 | KAROSSE 28 | MANAGER 29 | OSTEREI 30 | SIDERIT 31 | TERRIER 32 | ANATOMIE 33 | ANPASSEN 34 | BARKASSE 35 | BEDANKEN 36 | DEKADENT 37 | EINLADEN 38 | ERLASSEN 39 | FRAGMENT 40 | GARANTIE 41 | KRAWATTE 42 | MEISTERN 43 | REAKTION 44 | TENTAKEL 45 | TRIANGEL 46 | UEBERALL 47 | VERGEBEN 48 | AFRIKANER 49 | BESTELLEN 50 | BULLAUGEN 51 | SANTANDER 52 | VERBERGEN 53 | ALLENSTEIN 54 | AUSTRALIEN 55 | BETEILIGEN 56 | NATALITAET 57 | OBERHAUSEN 58 | UNTERSTAND 59 | LEUMUND 60 | 61 | ........ ........ ....... 62 | . . . . . . . 63 | . . . .......... . . . 64 | ....... . . . ........ 65 | . . . . . . . . . . . . 66 | . . . . ...... . . . . 67 | . . . . . ........ . 68 | . . ...... . . . . . . . 69 | . . . . . . . . . 70 | ...... ...... . . ...... 71 | . . . . . . . . . 72 | ....... . . . ....... . 73 | . . . . . . 74 | . . ....... ........ . 75 | . . . . . . 76 | ...... . ....... ........ 77 | . . . . . . . 78 | . . ......... . . . 79 | . . . . . . . ..... 80 | . . ....... . . . 81 | .......... . . . . 82 | . . . . ......... . 83 | . ......... . . . . 84 | . . . . . . . 85 | ........ ......... ..... 86 | 87 | 88 | -------------------------------------------------------------------------------- /examples/99-prolog-problems/p1_lists.pl: -------------------------------------------------------------------------------- 1 | % 1.01 (*) Find the last element of a list. 2 | 3 | % Example: 4 | % ?- my_last(X, [a, b, c, d]). 5 | % X = d 6 | 7 | my_last(X, [X]). 8 | my_last(X, [_|T]) :- my_last(X, T). 9 | 10 | ?- my_last(X, [a, b, c, d]), nonvar(X), X = d, writeln(ok). 11 | 12 | 13 | % 1.02 (*) Find the last but one element of a list. 14 | 15 | % Example: 16 | % ?- last_but_one(X, [a, b, c, d]). 17 | % X = c 18 | 19 | last_but_one(X, [X,_]). 20 | last_but_one(X, [_|T]) :- last_but_one(X, T). 21 | 22 | ?- last_but_one(X, [a, b, c, d]), nonvar(X), X = c, writeln(ok). 23 | 24 | 25 | % 1.03 (*) Find the Kth element of a list. 26 | % The first element in the list is number 1. 27 | 28 | % Example: 29 | % ?- element_at(X, [a, b, c, d], 3). 30 | % X = c 31 | 32 | element_at(X, [X|_], 1). 33 | element_at(X, [_|T], K) :- K > 1, K_ is K-1, element_at(X, T, K_). 34 | 35 | ?- element_at(X, [a, b, c, d], 3), nonvar(X), X = c, writeln(ok). 36 | 37 | 38 | % 1.04 (*) Find the number of elements of a list. 39 | 40 | % Example: 41 | % ?- my_length(X, [a, b, c]). 42 | % X = 3 43 | 44 | my_length([], 0). 45 | my_length([_|T], L) :- my_length(T, L_), L is L_ + 1. 46 | 47 | ?- my_length([a, b, c], X), nonvar(X), X = 3, writeln(ok). 48 | 49 | 50 | % 1.05 (*) Reverse a list. 51 | 52 | % Example: 53 | % ?- reverse([a, b, c, d], X). 54 | % X = [d, c, b, a] 55 | 56 | my_reverse(X, R) :- my_reverse_(X, R, []). 57 | 58 | my_reverse_([], R, R). 59 | my_reverse_([X|Xs], R, Acc) :- my_reverse_(Xs, R, [X|Acc]). 60 | 61 | ?- my_reverse([a, b, c, d], X), nonvar(X), X = [d, c, b, a], writeln(ok). 62 | 63 | 64 | % 1.06 (*) Find out whether a list is a palindrome. 65 | 66 | % Example: 67 | % ?- is_palindrome([x, a, m, a, x]). 68 | % true. 69 | 70 | is_palindrome(X) :- my_reverse(X, X). 71 | 72 | ?- is_palindrome([x, a, m, a, x]), writeln(ok). 73 | 74 | 75 | % 1.07 (**) Flatten a nested list structure. 76 | 77 | % Example: 78 | % ?- my_flatten([a, [b, [c, d], e]], X). 79 | % X = [a, b, c, d, e] 80 | 81 | my_flatten(X, [X]) :- \+ is_list(X). 82 | my_flatten([], []). 83 | my_flatten([X|Xs], Y) :- 84 | my_flatten(X, X_), my_flatten(Xs, Xs_), append(X_, Xs_, Y). 85 | 86 | ?- my_flatten([a, [b, [c, d], e]], X), nonvar(X), X = [a, b, c, d, e], writeln(ok). 87 | 88 | 89 | % 1.08 (**) Eliminate consecutive duplicates of list elements. 90 | 91 | % Example: 92 | % ?- compress([a, a, a, a, b, c, c, a, a, d, e, e, e, e], X). 93 | % X = [a, b, c, d, e] 94 | 95 | compress([], []). 96 | compress([X], [X]). 97 | compress([X,X|Xs], Y) :- compress([X|Xs], Y). 98 | compress([X,Z|Xs], [X|Y]) :- X \= Z, compress([Z|Xs], Y). 99 | 100 | ?- compress([a, a, a, a, b, c, c, d, e, e, e, e], X), 101 | nonvar(X), 102 | X = [a, b, c, d, e], 103 | writeln(ok). 104 | 105 | 106 | % 1.09 (**) Pack consecutive duplicates of list elements into sublists. 107 | 108 | % Example: 109 | % ?- pack([a, a, a, a, b, c, c, a, a, d, e, e, e, e], X). 110 | % X = [[a, a, a, a], [b], [c, c], [a, a], [d], [e, e, e, e]] 111 | 112 | pack([], []). 113 | pack([X], [[X]]). 114 | pack([X|Xs], [[X,X|P]|T]) :- pack(Xs, [[X|P]|T]). 115 | pack([X|Xs], [[X],[Y|P]|T]) :- pack(Xs, [[Y|P]|T]), X \= Y. 116 | 117 | ?- pack([a, a, a, a, b, c, c, a, a, d, e, e, e, e], X), 118 | nonvar(X), 119 | X = [[a, a, a, a], [b], [c, c], [a, a], [d], [e, e, e, e]], 120 | writeln(ok). 121 | 122 | 123 | % 1.10 (*) Run-length encoding of a list. 124 | 125 | % Example: 126 | % ?- encode([a, a, a, a, b, c, c, a, a, d, e, e, e, e], X). 127 | % X = [[4, a], [1, b], [2, c], [2, a], [1, d], [4, e]] 128 | 129 | encode([], []). 130 | encode([X], [[1, X]]). 131 | encode([X|Xs], [[N_, X]|E]) :- encode(Xs, [[N, X]|E]), N_ is N + 1. 132 | encode([X|Xs], [[1, X], [N, Y]|E]) :- encode(Xs, [[N, Y]|E]), X \= Y. 133 | 134 | ?- encode([a, a, a, a, b, c, c, a, a, d, e, e, e, e], X), 135 | nonvar(X), 136 | X = [[4, a], [1, b], [2, c], [2, a], [1, d], [4, e]], 137 | writeln(ok). 138 | 139 | 140 | % 1.11 (*) Modified run-length encoding. 141 | % Modify the result of problem 1.10 in such a way that if an element has no 142 | % duplicates it is simply copied into the result list. 143 | 144 | % Example: 145 | % ?- encode_modified([a, a, a, a, b, c, c, a, a, d, e, e, e, e], X). 146 | % X = [[4, a], b, [2, c], [2, a], d, [4, e]] 147 | 148 | encode_modified(X, Y) :- encode(X, Z), modify(Z, Y). 149 | 150 | modify([], []). 151 | modify([[1,X]|Xs], [X|Ys]) :- modify(Xs, Ys). 152 | modify([[N,X]|Xs], [[N,X]|Ys]) :- N \= 1, modify(Xs, Ys). 153 | 154 | ?- encode_modified([a, a, a, a, b, c, c, a, a, d, e, e, e, e], X), 155 | nonvar(X), 156 | X = [[4, a], b, [2, c], [2, a], d, [4, e]], 157 | writeln(ok). 158 | 159 | 160 | % 1.12 (**) Decode a run-length encoded list. 161 | 162 | % Example: 163 | % ?- decode([[4, a], [1, b], [2, c], [2, a], [1, d], [4, e]], X). 164 | % X = [a, a, a, a, b, c, c, a, a, d, e, e, e, e] 165 | 166 | decode([], []). 167 | decode([[N,X]|Xs], Y) :- repeat(X, N, A), decode(Xs, B), append(A, B, Y). 168 | 169 | repeat(_, 0, []). 170 | repeat(X, N, [X|Xs]) :- N_ is N-1, repeat(X, N_, Xs). 171 | 172 | ?- decode([[4, a], [1, b], [2, c], [2, a], [1, d], [4, e]], X), 173 | nonvar(X), 174 | X = [a, a, a, a, b, c, c, a, a, d, e, e, e, e], 175 | writeln(ok). 176 | 177 | 178 | % 1.13 (**) Run-length encoding of a list (direct solution). 179 | % Implement the so-called run-length encoding data compression method directly. 180 | % I.e. don't explicitly create the sublists containing the duplicates, only 181 | % count them. As in problem 1.11, simplify the result list by replacing the 182 | % singleton terms [1, X] by X. 183 | 184 | % Example: 185 | % ?- encode_direct([a, a, a, a, b, c, c, a, a, d, e, e, e, e], X). 186 | % X = [[4, a], b, [2, c], [2, a], d, [4, e]] 187 | 188 | encode_direct([], []). 189 | encode_direct([X], [X]). 190 | encode_direct([X|Xs], [[2,X]|T]) :- encode_direct(Xs, [X|T]). 191 | encode_direct([X|Xs], [[N_,X]|T]) :- encode_direct(Xs, [[N,X]|T]), N_ is N+1. 192 | encode_direct([X|Xs], [X,Y|T]) :- encode_direct(Xs, [Y|T]), Y \= X, Y \= [_, X]. 193 | 194 | ?- encode_direct([a, a, a, a, b, c, c, a, a, d, e, e, e, e], X), 195 | nonvar(X), 196 | X = [[4, a], b, [2, c], [2, a], d, [4, e]], 197 | writeln(ok). 198 | 199 | 200 | % 1.14 (*) Duplicate the elements of a list. 201 | 202 | % Example: 203 | % ?- dupli([a, b, c, c, d], X). 204 | % X = [a, a, b, b, c, c, c, c, d, d] 205 | 206 | dupli([], []). 207 | dupli([X|Xs], [X,X|Y]) :- dupli(Xs, Y). 208 | 209 | ?- dupli([a, b, c, c, d], X), 210 | nonvar(X), 211 | X = [a, a, b, b, c, c, c, c, d, d], 212 | writeln(ok). 213 | 214 | 215 | % 1.15 ()*) Duplicate the elements of a list a given number of times. 216 | 217 | % Example: 218 | % ?- dupli([a, b, c], 3, X). 219 | % X = [a, a, a, b, b, b, c, c, c] 220 | 221 | dupli([], _, []). 222 | dupli([X|Xs], N, Y) :- repeat(X, N, D), dupli(Xs, N, T), append(D, T, Y). 223 | 224 | ?- dupli([a, b, c], 3, X), 225 | nonvar(X), 226 | X = [a, a, a, b, b, b, c, c, c], 227 | writeln(ok). 228 | 229 | 230 | % 1.16 (**) Drop every Nth element from a list. 231 | 232 | % Example: 233 | % ?- drop_every([a, b, c, d, e, f, g, h, i, k], 3, X). 234 | % X = [a, b, d, e, g, h, k] 235 | 236 | drop_every([], _, []). 237 | drop_every(X, N, Y) :- 238 | X \= [], 239 | N_ is N-1, 240 | take(N_, X, S), 241 | drop(N, X, E), 242 | drop_every(E, N, E_), 243 | append(S, E_, Y). 244 | 245 | take(_, [], []). 246 | take(0, _, []). 247 | take(N, [X|Xs], [X|Y]) :- N > 0, N_ is N-1, take(N_, Xs, Y). 248 | 249 | drop(_, [], []). 250 | drop(0, X, X). 251 | drop(N, [_|Xs], Y) :- N > 0, N_ is N-1, drop(N_, Xs, Y). 252 | 253 | ?- drop_every([a, b, c, d, e, f, g, h, i, k], 3, X), 254 | nonvar(X), 255 | X = [a, b, d, e, g, h, k], 256 | writeln(ok). 257 | 258 | 259 | % 1.17 (*) Split a list into two parts; the length of the first part is given. 260 | 261 | % Example: 262 | % ?- split([a, b, c, d, e, f, g], 3, L1, L2) 263 | % L1 = [a, b, c] 264 | % L2 = [d, e, f, g] 265 | 266 | split(X, N, L1, L2) :- take(N, X, L1), drop(N, X, L2). 267 | 268 | ?- split([a, b, c, d, e, f, g], 3, L1, L2), 269 | nonvar(L1), 270 | nonvar(L2), 271 | L1 = [a, b, c], 272 | L2 = [d, e, f, g], 273 | writeln(ok). 274 | 275 | 276 | % 1.18 (**) Extract a slice from a list. 277 | % Given two indices, I and K, the slice is the list containing the elements 278 | % between the Ith and Kth element of the original list (both limits included). 279 | % Start counting the elements with 1. 280 | 281 | % Example: 282 | % ?- slice([a, b, c, d, e, f, g, h, i, k], 3, 7, L) 283 | % L = [c, d, e, f, g] 284 | 285 | slice(X, I, K, L) :- take(K, X, S), I_ is I-1, drop(I_, S, L). 286 | 287 | ?- slice([a, b, c, d, e, f, g, h, i, k], 3, 7, L), 288 | nonvar(L), 289 | L = [c, d, e, f, g], 290 | writeln(ok). 291 | 292 | 293 | % 1.19 (**) Rotate a list N places to the left. 294 | 295 | % Examples: 296 | % ?- rotate([a, b, c, d, e, f, g, h], 3, X). 297 | % X = [d, e, f, g, h, a, b, c] 298 | % 299 | % ?- rotate([a, b, c, d, e, f, g, h], -2, X). 300 | % X = [g, h, a, b, c, d, e, f] 301 | 302 | rotate(X, N, Y) :- 303 | length(X, L), N_ is N mod L, split(X, N_, L1, L2), append(L2, L1, Y). 304 | 305 | ?- rotate([a, b, c, d, e, f, g, h], 3, X), 306 | nonvar(X), 307 | X = [d, e, f, g, h, a, b, c], 308 | writeln(ok). 309 | ?- rotate([a, b, c, d, e, f, g, h], -2, X), 310 | nonvar(X), 311 | X = [g, h, a, b, c, d, e, f], 312 | writeln(ok). 313 | 314 | 315 | % 1.20 (*) Remove the Kth element from a list. 316 | 317 | % Example: 318 | % ?- remove_at(X, [a, b, c, d], 2, R). 319 | % X = b 320 | % R = [a, c, d] 321 | 322 | remove_at(X, L, N, R) :- N_ is N-1, split(L, N_, S, [X|E]), append(S, E, R). 323 | 324 | ?- remove_at(X, [a, b, c, d], 2, R), 325 | nonvar(X), 326 | nonvar(R), 327 | X = b, 328 | R = [a, c, d], 329 | writeln(ok). 330 | 331 | 332 | % 1.21 (*) Insert an element at a given position into a list. 333 | 334 | % Example: 335 | % ?- insert_at(alfa,[a,b,c,d],2,L). 336 | % L = [a,alfa,b,c,d] 337 | 338 | insert_at(X, L, N, R) :- N_ is N-1, split(L, N_, L1, L2), append(L1, [X|L2], R). 339 | 340 | ?- insert_at(alfa,[a,b,c,d],2,L), nonvar(L), L = [a,alfa,b,c,d], writeln(ok). 341 | 342 | 343 | % 1.22 (*) Create a list containing all integers within a given range. 344 | 345 | % Example: 346 | % ?- range(4, 9, L). 347 | % L = [4, 5, 6, 7, 8, 9] 348 | 349 | range(N, N, [N]). 350 | range(A, B, [A|R]) :- A \= B, A_ is A + sign(B-A), range(A_, B, R). 351 | 352 | ?- range(4, 9, L), 353 | nonvar(L), 354 | L = [4, 5, 6, 7, 8, 9], 355 | writeln(ok). 356 | 357 | 358 | % % Skip: there's no random function 359 | % % 1.23 (**) Extract a given number of randomly selected elements from a list. 360 | 361 | % % Example: 362 | % % ?- rnd_select([a,b,c,d,e,f,g,h],3,L). 363 | % % L = [e,d,a] 364 | 365 | 366 | % % 1.24 (*) Lotto: Draw N different random numbers from the set 1..M 367 | 368 | % % Example: 369 | % % ?- lotto(6,49,L). 370 | % % L = [23,1,17,33,21,37] 371 | 372 | 373 | % % 1.25 (*) Generate a random permutation of the elements of a list. 374 | 375 | % % Example: 376 | % % ?- rnd_permu([a,b,c,d,e,f],L). 377 | % % L = [b,a,d,c,e,f] 378 | 379 | 380 | % 1.26 (**) Generate the combinations of K distinct objects chosen from the N 381 | % elements of a list. 382 | 383 | % Example: 384 | % ?- combination(3,[a,b,c,d,e,f],L). 385 | % L = [a,b,c] ; 386 | % L = [a,b,d] ; 387 | % L = [a,b,e] ; 388 | % ... 389 | 390 | combination(0, _, []). 391 | combination(N, X, [H|R]) :- 392 | 0 < N, tails(X, [H|T]), N_ is N-1, combination(N_, T, R). 393 | 394 | tails(X, X). 395 | tails([_|Xs], T) :- tails(Xs, T). 396 | 397 | ?- combination(3,[a,b,c,d,e,f],[a,c,e]), writeln(ok). 398 | ?- combination(3,[a,b,c,d,e,f],[d,e,f]), writeln(ok). 399 | 400 | 401 | % 1.27 (**) Group the elements of a set into disjoint subsets. 402 | % a) Generate via backtracking all the ways a group of 9 people can work in 3 403 | % disjoint subgroups of 2, 3, and 4 persons. 404 | % 405 | % Example: 406 | % ?- group3([aldo,beat,carla,david,evi,flip,gary,hugo,ida],G1,G2,G3). 407 | % G1 = [aldo,beat], G2 = [carla,david,evi], G3 = [flip,gary,hugo,ida] 408 | % ... 409 | 410 | 411 | % b) Generalize the above predicate in a way that we can specify a list of 412 | % group sizes and the predicate will return a list of groups. 413 | % 414 | % Example: 415 | % ?- group([aldo,beat,carla,david,evi,flip,gary,hugo,ida],[2,2,5],Gs). 416 | % Gs = [[aldo,beat],[carla,david],[evi,flip,gary,hugo,ida]] 417 | % ... 418 | 419 | 420 | % 1.28 (**) Sorting a list of lists according to length of sublists. 421 | % a) Suppose that a list contains elements that are lists themselves. The 422 | % objective is to sort the elements of InList according to their length. 423 | % 424 | % Example: 425 | % ?- lsort([[a,b,c],[d,e],[f,g,h],[d,e],[i,j,k,l],[m,n],[o]],L). 426 | % L = [[o], [d, e], [d, e], [m, n], [a, b, c], [f, g, h], [i, j, k, l]] 427 | 428 | 429 | % b) This time, sort the list by their length frequency, i.e. lists with rare 430 | % lengths are placed first, others with a more frequent length come later. 431 | % 432 | % Example: 433 | % ?- lfsort([[a,b,c],[d,e],[f,g,h],[d,e],[i,j,k,l],[m,n],[o]],L). 434 | % L = [[i, j, k, l], [o], [a, b, c], [f, g, h], [d, e], [d, e], [m, n]] 435 | -------------------------------------------------------------------------------- /examples/99-prolog-problems/p2_arithmetic.pl: -------------------------------------------------------------------------------- 1 | % 2.01 (**) Determine whether a given number is prime. 2 | 3 | % Example: 4 | % ?- is_prime(7). 5 | % true 6 | 7 | is_prime(N) :- integer(N), N > 1, \+ has_factor(N, 2). 8 | 9 | has_factor(N, K) :- K * K =< N, N mod K =:= 0. 10 | has_factor(N, K) :- K * K =< N, K_ is K + 1, has_factor(N, K_). 11 | 12 | ?- \+ is_prime(4), writeln(ok). 13 | ?- is_prime(7), writeln(ok). 14 | 15 | 16 | % 2.02 (**) Determine the prime factors of a given positive integer. 17 | % Construct a flat list containing the prime factors in ascending order. 18 | 19 | % Example: 20 | % ?- prime_factors(315, L). 21 | % L = [3, 3, 5, 7] 22 | 23 | prime_factors(N, Fs) :- N > 1, prime_factors(N, 2, Fs). 24 | 25 | prime_factors(1, _, []) :- !. 26 | prime_factors(N, P, Fs) :- 27 | P =< N, N mod P =\= 0, !, next_prime(P, P_), prime_factors(N, P_, Fs). 28 | prime_factors(N, P, [P|Fs]) :- 29 | P =< N, N_ is N / P, prime_factors(N_, P, Fs). 30 | 31 | next_prime(P, P_) :- P_ is P + 1, is_prime(P_), !. 32 | next_prime(P, N) :- P_ is P + 1, next_prime(P_, N). 33 | 34 | ?- prime_factors(315, L), 35 | nonvar(L), 36 | L = [3, 3, 5, 7], 37 | writeln(ok). 38 | 39 | 40 | % 2.03 (**) Determine the prime factors of a given positive integer (2). 41 | % Construct a list containing the prime factors and their multiplicity. 42 | 43 | % Example: 44 | % ?- prime_factors_mult(315, L). 45 | % L = [[3, 2], [5, 1], [7, 1]] 46 | 47 | prime_factors_mult(N, FMs) :- prime_factors(N, Fs), group_count(Fs, FMs). 48 | 49 | group_count([], []). 50 | group_count([X], [[X, 1]]). 51 | group_count([X|Xs], [[X, N_]|E]) :- group_count(Xs, [[X, N]|E]), N_ is N + 1. 52 | group_count([X|Xs], [[X, 1], [Y, N]|E]) :- group_count(Xs, [[Y, N]|E]), X \= Y. 53 | 54 | ?- prime_factors_mult(315, L), 55 | nonvar(L), 56 | L = [[3, 2], [5, 1], [7, 1]], 57 | writeln(ok). 58 | 59 | 60 | % 2.04 (*) A list of prime numbers. 61 | % Given a range of integer by its lower and upper limit, construct a list of all 62 | % prime numbers in that range. 63 | 64 | prime_list(A,B,L) :- A =< 2, !, p_list(2,B,L). 65 | prime_list(A,B,L) :- A1 is (A // 2) * 2 + 1, p_list(A1,B,L). 66 | 67 | p_list(A,B,[]) :- A > B, !. 68 | p_list(A,B,[A|L]) :- is_prime(A), !, 69 | next(A,A1), p_list(A1,B,L). 70 | p_list(A,B,L) :- 71 | next(A,A1), p_list(A1,B,L). 72 | 73 | next(2,3) :- !. 74 | next(A,A1) :- A1 is A + 2. 75 | 76 | 77 | % 2.05 (**) Goldbach's conjecture. 78 | % Goldbach's conjecture says that every positive even number greater than 2 is 79 | % the sum of two prime numbers. It is one of the most famous facts in number 80 | % theory that has not been proven to be correct in the general case, but has 81 | % been numerically confirmed up to very large numbers (much larger than is 82 | % possible in Prolog). Write a predicate to find the two prime numbers that sum 83 | % to a given even number. 84 | 85 | % Example: 86 | % ?- goldbach(28, L). 87 | % L = [5, 23] 88 | 89 | goldbach(4,[2,2]) :- !. 90 | goldbach(N,L) :- N mod 2 =:= 0, N > 4, goldbach(N,L,3). 91 | 92 | goldbach(N,[P,Q],P) :- Q is N - P, is_prime(Q), !. 93 | goldbach(N,L,P) :- P < N, next_prime(P,P1), goldbach(N,L,P1). 94 | 95 | next_prime(P,P1) :- P1 is P + 2, is_prime(P1), !. 96 | next_prime(P,P1) :- P2 is P + 2, next_prime(P2,P1). 97 | 98 | member(X, [X|_]). 99 | member(X, [_|Xs]) :- member(X, Xs). 100 | 101 | ?- goldbach(28, L), 102 | nonvar(L), 103 | L = [5, 23], 104 | writeln(ok). 105 | 106 | 107 | % 2.06 (**) A list of Goldbach compositions. 108 | % a) Given a range of integers by its lower and upper limit, print a list of all 109 | % even numbers and their Goldbach composition. 110 | % 111 | % Example: 112 | % ?- goldbach_list(9,20). 113 | % 10 = 3 + 7 114 | % 12 = 5 + 7 115 | % 14 = 3 + 11 116 | % 16 = 3 + 13 117 | % 18 = 5 + 13 118 | % 20 = 3 + 17 119 | 120 | 121 | % b) In most cases, if an even number is written as the sum of two prime 122 | % numbers, one of them is very small. Very rarely, the primes are both 123 | % bigger than say 50. Try to find out how many such cases there are in the 124 | % range 2..3000. 125 | % 126 | % Example (for a print limit of 50): 127 | % ?- goldbach_list(1,2000,50). 128 | % 992 = 73 + 919 129 | % 1382 = 61 + 1321 130 | % 1856 = 67 + 1789 131 | % 1928 = 61 + 1867 132 | 133 | 134 | % 2.07 (**) Determine the greatest common divisor of two positive integer 135 | % numbers. Use Euclid's algorithm. 136 | 137 | % Example: 138 | % ?- gcd(36, 63, G). 139 | % G = 9 140 | 141 | % Define gcd as an arithmetic function, so you can use it like this: 142 | % ?- G is gcd(36, 63). 143 | % G = 9 144 | 145 | gcd(N1, 0, N1). 146 | gcd(N1, N2, D) :- N2 > 0, R is N1 mod N2, gcd(N2, R, D). 147 | 148 | ?- gcd(36, 63, G), 149 | nonvar(G), 150 | G = 9, 151 | writeln(ok). 152 | 153 | 154 | % 2.08 (*) Determine whether two positive integer numbers are coprime. 155 | % Two numbers are coprime if their greatest common divisor equals 1. 156 | 157 | % Example: 158 | % ?- coprime(35, 64). 159 | % true 160 | 161 | coprime(A, B) :- gcd(A, B, 1). 162 | 163 | ?- coprime(35, 64), writeln(ok). 164 | 165 | 166 | % 2.09 (**) Calculate Euler's totient function phi(m). 167 | % Euler's so-called totient function phi(m) is defined as the number of positive 168 | % integers r (1 <= r < m) that are coprime to m. 169 | % E.g. m = 10, r = 1,3,7,9; thus phi(m) = 4. Note the special case: phi(1) = 1. 170 | % 171 | % Find out what the value of phi(m) is if m is a prime number. Euler's totient 172 | % function plays an important role in one of the most widely used public key 173 | % cryptography methods (RSA). In this exercise, use the most primitive method to 174 | % calculate this function. There is a smarter way that we shall use in 2.10. 175 | 176 | % Example: 177 | % ?- Phi is totient_phi(10). 178 | % Phi = 4 179 | 180 | totient_phi(N, R) :- totient_phi(1, N, R). 181 | 182 | totient_phi(_, 1, 1) :- !. 183 | totient_phi(U, U, 0) :- !. 184 | totient_phi(L, U, R) :- 185 | L < U, coprime(L, U), !, L_ is L + 1, totient_phi(L_, U, R_), R is R_ + 1. 186 | totient_phi(L, U, R) :- L < U, L_ is L + 1, totient_phi(L_, U, R). 187 | 188 | ?- totient_phi(10, Phi), 189 | nonvar(Phi), 190 | Phi = 4, 191 | writeln(ok). 192 | 193 | 194 | 195 | % 2.10 (**) Calculate Euler's totient function phi(m) (2). 196 | % See problem 2.09 for the definition of Euler's totient function. If the list 197 | % of the prime factors of a number m is known in the form of problem 2.03 then 198 | % the function phi(m) can be efficiently calculated as follows: Let [[p1, m1], 199 | % [p2, m2], [p3, m3], ...] be the list of prime factors (and their 200 | % multiplicities) of a given number m. Then phi(m) can be calculated with the 201 | % following formula: 202 | % phi(m) = (p1 - 1) * p1**(m1 - 1) 203 | % * (p2 - 1) * p2**(m2 - 1) 204 | % * (p3 - 1) * p3**(m3 - 1) 205 | % * ... 206 | 207 | 208 | % 2.11 (*) Compare the two methods of calculating Euler's totient function. 209 | % Use the solutions of problems 2.09 and 2.10 to compare the algorithms. Take 210 | % the number of logical inferences as a measure for efficiency. Try to calculate 211 | % phi(10090) as an example. 212 | -------------------------------------------------------------------------------- /examples/99-prolog-problems/p3_logic_and_codes.pl: -------------------------------------------------------------------------------- 1 | % 3.01 (**) Truth tables for logical expressions. 2 | % Define predicates and/2, or/2, nand/2, nor/2, xor/2, impl/2 and equ/2 (for 3 | % logical equivalence) which succeed or fail according to the result of their 4 | % respective operations; e.g. and(A, B) will succeed, if and only if both A and 5 | % B succeed. Note that A and B can be Prolog goals (not only the constants true 6 | % and fail). 7 | 8 | % A logical expression in two variables can then be written in prefix notation, 9 | % as in the following example: and(or(A, B), nand(A, B)). 10 | 11 | % Now, write a predicate table/3 which prints the truth table of a given logical 12 | % expression in two variables. 13 | 14 | % Example: 15 | % ?- table(A, B, and(A, or(A, B))). 16 | % true true true 17 | % true false true 18 | % false true false 19 | % false false false 20 | 21 | and(A, B) :- A, B. 22 | 23 | or(A, _) :- A. 24 | or(_, B) :- B. 25 | 26 | nand(A, B) :- not(and(A, B)). 27 | 28 | nor(A, B) :- not(or(A, B)). 29 | 30 | xor(A, B) :- and(or(A, B), not(and(A, B))) . 31 | 32 | impl(A, B) :- or(not(A), B). 33 | 34 | equ(A, B) :- not(xor(A, B)). 35 | 36 | table(A, B, Expr) :- bind(A), bind(B), write_row(A, B, Expr), fail. 37 | table(_, _, _). 38 | 39 | bind(true). 40 | bind(false). 41 | 42 | write_row(A, B, E) :- E, !, writeln([A, B, true]), nl. 43 | write_row(A, B, _) :- writeln([A, B, false]), nl. 44 | 45 | 46 | % 3.02 (*) Truth tables for logical expressions (2). 47 | % Continue problem 3.01 by defining and/2, or/2, etc as being operators. This 48 | % allows to write the logical expression in the more natural way, as in the 49 | % example: A and (A or not B). Define operator precedence as usual. 50 | 51 | % Example: 52 | % ?- table(A, B, A and (A or not B)). 53 | % true true true 54 | % true false true 55 | % false true false 56 | % false false false 57 | 58 | 59 | % 3.03 (**) Truth tables for logical expressions (3). 60 | % Generalize problem 3.02 in such a way that the logical expression may contain 61 | % any number of logical variables. Define table/2 in a way that 62 | % table(List, Expr) prints the truth table for the expression Expr, which 63 | % contains the logical variables enumerated in List. 64 | 65 | % Example: 66 | % ?- table2([A,B,C], A and (B or C) equ A and B or A and C). 67 | % true true true true 68 | % true true false true 69 | % true false true true 70 | % true false false true 71 | % false true true true 72 | % false true false true 73 | % false false true true 74 | % false false false true 75 | 76 | table2(Vs, Expr) :- bind_vars(Vs), write_row2(Vs, Expr), fail. 77 | table2(_, _). 78 | 79 | bind_vars([]). 80 | bind_vars([V|Vs]) :- bind(V), bind_vars(Vs). 81 | 82 | write_row2([], E) :- E, !, write(' true'), nl. 83 | write_row2([], _) :- write(' false'), nl. 84 | write_row2([V|Vs], E) :- write(V), write('\t'), write_row2(Vs, E). 85 | 86 | 87 | % 3.04 (**) Gray code. 88 | % An n-bit Gray code is a sequence of n-bit strings constructed according to 89 | % certain rules. For example, 90 | % n = 1: C(1) = ['0','1']. 91 | % n = 2: C(2) = ['00','01','11','10']. 92 | % n = 3: C(3) = ['000','001','011','010','110','111','101','100']. 93 | 94 | % Find out the construction rules and write a predicate with the following 95 | % specification: 96 | % gray(N,C) :- C is the N-bit Gray code 97 | 98 | % Can you apply the method of "result caching" in order to make the predicate 99 | % more efficient, when it is to be used repeatedly? 100 | 101 | gray(1, ['0', '1']). 102 | gray(N, C) :- 103 | N > 1, 104 | N_ is N - 1, 105 | gray(N_, C_), 106 | reverse(C_, Cr), 107 | prepend_all('0', C_, P1), 108 | prepend_all('1', Cr, P2), 109 | append(P1, P2, C). 110 | 111 | prepend_all(_, [], []). 112 | prepend_all(S, [X|Xs], [Y|Ys]) :- atom_concat(S, X, Y), prepend_all(S, Xs, Ys). 113 | 114 | 115 | % 3.05 (***) Huffman code. 116 | % First of all, study a good book on discrete mathematics or algorithms for a 117 | % detailed description of Huffman codes, or consult Wikipedia. 118 | 119 | % We suppose a set of symbols with their frequencies, given as a list of fr(S,F) 120 | % terms. Example: [fr(a, 45), fr(b, 13), fr(c, 12), fr(d, 16), fr(e, 9), 121 | % fr(f, 5)]. Our objective is to construct a list hc(S, C) terms, where C is the 122 | % Huffman code word for the symbol S. In our example, the result could be 123 | % Hs = [hc(a, '0'), hc(b, '101'), hc(c, '100'), hc(d, '111'), hc(e, '1101'), 124 | % hc(f, '1100')]. The task shall be performed by the predicate huffman/2 defined 125 | % as follows: 126 | 127 | % huffman(Fs, Hs) :- Hs is the Huffman code table for the frequency table Fs 128 | -------------------------------------------------------------------------------- /examples/99-prolog-problems/p4_binary_trees.pl: -------------------------------------------------------------------------------- 1 | % 4.01 (*) Check whether a given term represents a binary tree. 2 | % Write a predicate istree/1 which succeeds if and only if its argument is a 3 | % Prolog term representing a binary tree. 4 | 5 | % Example: 6 | % ?- istree(t(a,t(b,nil,nil),nil)). 7 | % Yes 8 | % ?- istree(t(a,t(b,nil,nil))). 9 | % No 10 | 11 | istree(nil). 12 | istree(t(_, T1, T2)) :- istree(T1), istree(T2). 13 | 14 | ?- istree(t(a,t(b,nil,nil),nil)), writeln(ok). 15 | ?- \+ istree(t(a,t(b,nil,nil))), writeln(ok). 16 | 17 | 18 | % 4.02 (**) Construct completely balanced binary trees. 19 | % In a completely balanced binary tree, the following property holds for every 20 | % node: the number of nodes in its left subtree and the number of nodes in its 21 | % right subtree are almost equal, which means their difference is not greater 22 | % than one. 23 | 24 | % Write a predicate cbal_tree/2 to construct completely balanced binary trees 25 | % for a given number of nodes. The predicate should generate all solutions vi 26 | % backtracking. Put the letter 'x' as information into all nodes of the tree. 27 | 28 | % Example: 29 | % ?- cbal_tree(4,T). 30 | % T = t(x, t(x, nil, nil), t(x, nil, t(x, nil, nil))) ; 31 | % T = t(x, t(x, nil, nil), t(x, t(x, nil, nil), nil)) ; 32 | % ... 33 | % No 34 | 35 | cbal_tree(0, nil). 36 | cbal_tree(X, t(x, L, R)) :- 37 | X =\= 0, 38 | X1 is div(X-1, 2), 39 | X2 is X - 1 - X1, 40 | cbal_tree(X1, T1), 41 | cbal_tree(X2, T2), 42 | ( 43 | (X1 =\= X2, T1 = R, T2 = L) 44 | ; (T1 = L, T2 = R) 45 | ). 46 | 47 | % FIXME: it likely fails because of using different div/2 definition. 48 | % ?- cbal_tree(4, T), 49 | % nonvar(T), 50 | % T = t(x, t(x, nil, nil), t(x, nil, t(x, nil, nil))), 51 | % writeln(ok). 52 | 53 | 54 | % 4.03 (**) Symmetric binary trees. 55 | % Let us call a binary tree symmetric if you can draw a vertical line through 56 | % the root node and then the right subtree is the mirror image of the left 57 | % subtree. Write a predicate symmetric/1 to check whether a given binary tree is 58 | % symmetric. Hint: Write a predicate mirror/2 first to check whether one tree is 59 | % the mirror image of another. We are only interested in the structure, not in 60 | % the contents of the nodes. 61 | 62 | symmetric(nil). 63 | symmetric(t(_, L, R)) :- mirror(L, R). 64 | 65 | mirror(nil, nil). 66 | mirror(t(_, A, B), t(_, B_, A_)) :- mirror(A, A_), mirror(B, B_). 67 | 68 | ?- symmetric(t(a, t(a, t(b, nil, nil), nil), t(c, nil, t(d, nil, nil)))), 69 | writeln(ok). 70 | 71 | 72 | % 4.04 (**) Binary search trees (dictionaries). 73 | % Use the predicate add/3, developed in chapter 4 of the course, to write a 74 | % predicate to construct a binary search tree from a list of integer numbers. 75 | 76 | % Example: 77 | % ?- construct([3,2,5,7,1],T). 78 | % T = t(3, t(2, t(1, nil, nil), nil), t(5, nil, t(7, nil, nil))) 79 | 80 | % Then use this predicate to test the solution of the problem P56. 81 | % Example: 82 | % ?- test_symmetric([5,3,18,1,4,12,21]). 83 | % Yes 84 | % ?- test_symmetric([3,2,5,7,4]). 85 | % No 86 | 87 | construct(X, T) :- construct_(X, T, nil). 88 | 89 | construct_([], T, T). 90 | construct_([X|Xs], R, Acc) :- add(X, Acc, Acc2), construct_(Xs, R, Acc2). 91 | 92 | add(X, nil, t(X, nil, nil)). 93 | add(X, t(Y, L, R), t(Y, L_, R)) :- X @=< Y, add(X, L, L_). 94 | add(X, t(Y, L, R), t(Y, L, R_)) :- X @> Y, add(X, R, R_). 95 | 96 | test_symmetric(L) :- construct(L, T), symmetric(T). 97 | 98 | ?- construct([3,2,5,7,1],T), 99 | nonvar(T), 100 | T = t(3, t(2, t(1, nil, nil), nil), t(5, nil, t(7, nil, nil))), 101 | writeln(ok). 102 | ?- test_symmetric([5,3,18,1,4,12,21]), 103 | writeln(ok). 104 | ?- \+ test_symmetric([3,2,5,7,4]), 105 | writeln(ok). 106 | 107 | 108 | % 4.05 (**) Generate-and-test paradigm. 109 | % Apply the generate-and-test paradigm to construct all symmetric, completely 110 | % balanced binary trees with a given number of nodes. 111 | 112 | % Example: 113 | % ?- sym_cbal_trees(5,Ts). 114 | % Ts = [t(x, t(x, nil, t(x, nil, nil)), t(x, t(x, nil, nil), nil)), t(x, t(x, 115 | % t(x, nil, nil), nil), t(x, nil, t(x, nil, nil)))] 116 | 117 | % How many such trees are there with 57 nodes? Investigate about how many 118 | % solutions there are for a given number of nodes? What if the number is even? 119 | % Write an appropriate predicate. 120 | 121 | 122 | % 4.06 (**) Construct height-balanced binary trees. 123 | % In a height-balanced binary tree, the following property holds for every node: 124 | % The height of its left subtree and the height of its right subtree are almost 125 | % equal, which means their difference is not greater than one. 126 | 127 | % Write a predicate hbal_tree/2 to construct height-balanced binary trees for a 128 | % given height. The predicate should generate all solutions via backtracking. 129 | % Put the letter 'x' as information into all nodes of the tree. 130 | 131 | % Example: 132 | % ?- hbal_tree(3,T). 133 | % T = t(x, t(x, t(x, nil, nil), t(x, nil, nil)), t(x, t(x, nil, nil), 134 | % t(x, nil, nil))) ; 135 | % T = t(x, t(x, t(x, nil, nil), t(x, nil, nil)), t(x, t(x, nil, nil), nil)) ; 136 | % ... 137 | % No 138 | 139 | hbal_tree(0, nil). 140 | hbal_tree(H, t(x, L, R)) :- 141 | H > 0, H1 is H-1, hbal_tree(H1, L), hbal_tree(H1, R). 142 | hbal_tree(H, t(x, L, R)) :- 143 | H > 1, H1 is H-1, H2 is H-2, hbal_tree(H1, L), hbal_tree(H2, R). 144 | hbal_tree(H, t(x, L, R)) :- 145 | H > 1, H1 is H-1, H2 is H-2, hbal_tree(H2, L), hbal_tree(H1, R). 146 | 147 | ?- hbal_tree(3, T), 148 | nonvar(T), 149 | T = t(x,t(x,t(x,nil,nil),t(x,nil,nil)),t(x,t(x,nil,nil),t(x,nil,nil))), 150 | writeln(ok). 151 | 152 | 153 | % 4.07 (**) Construct height-balanced binary trees with a given number of nodes. 154 | % a) Consider a height-balanced binary tree of height H. What is the maximum 155 | % number of nodes it can contain? Clearly, MaxN = 2**H - 1. However, what is 156 | % the minimum number MinN? This question is more difficult. Try to find a 157 | % recursive statement and turn it into a predicate minNodes/2 defined as 158 | % follows: 159 | 160 | % minNodes(H, N) :- N is the minimum number of nodes in a height-balanced 161 | % binary tree of height H. (integer, integer), (+, ?) 162 | 163 | minNodes(0, 0). 164 | minNodes(1, 1). 165 | minNodes(H, N) :- 166 | H > 1, H1 is H-1, H2 is H-2, minNodes(H1, N1), minNodes(H2, N2), N is N1+N2+1. 167 | 168 | ?- minNodes(5, 12), writeln(ok). 169 | 170 | 171 | % b) On the other hand, we might ask: what is the maximum height H a 172 | % height-balanced binary tree with N nodes can have? 173 | 174 | % maxHeight(N, H) :- H is the maximum height of a height-balanced binary tree 175 | % with N nodes. (integer, integer), (+, ?) 176 | 177 | maxHeight(N, H) :- maxHeight(N, H, 0). 178 | 179 | maxHeight(N, H, HCurr) :- 180 | minNodes(HCurr, M), M =< N, HCurr_ is HCurr+1, maxHeight(N, H, HCurr_). 181 | maxHeight(N, H, HCurr) :- 182 | minNodes(HCurr, M), M > N, H is HCurr-1. 183 | 184 | ?- maxHeight(3, 2), writeln(ok). 185 | ?- maxHeight(12, 5), writeln(ok). 186 | 187 | 188 | % c) Now, we can attack the main problem: construct all the height-balanced 189 | % binary trees with a given number of nodes. Find out how many height-balanced 190 | % trees exist for N = 15. 191 | 192 | % hbal_tree_nodes(N, T) :- T is a height-balanced binary tree with N nodes. 193 | 194 | 195 | % 4.08 (*) Count the leaves of a binary tree. 196 | % A leaf is a node with no successors. Write a predicate count_leaves/2 to count 197 | % them. 198 | 199 | % count_leaves(T, N) :- the binary tree T has N leaves 200 | 201 | count_leaves(nil, 0). 202 | count_leaves(t(_, nil, nil), 1) :- !. 203 | count_leaves(t(_, L, R), N) :- 204 | count_leaves(L, Nl), count_leaves(R, Nr), N is Nl+Nr. 205 | 206 | ?- construct([5,3,18,1,4,12,21,42],T), 207 | count_leaves(T, 4), 208 | writeln(ok). 209 | 210 | 211 | % 4.09 (*) Collect the leaves of a binary tree in a list. 212 | % A leaf is a node with no successors. Write a predicate leaves/2 to collect 213 | % them in a list. 214 | 215 | % leaves(T, S) :- S is the list of all leaves of the binary tree T 216 | 217 | leaves(nil, []). 218 | leaves(t(X, nil, nil), [X]) :- !. 219 | leaves(t(_, L, R), Ls) :- leaves(L, Ls1), leaves(R, Ls2), append(Ls1, Ls2, Ls). 220 | 221 | ?- construct([5,3,18,1,4,12,21,42],T), 222 | leaves(T, [1, 4, 12, 42]), 223 | writeln(ok). 224 | 225 | 226 | % 4.10 (*) Collect the internal nodes of a binary tree in a list. 227 | % An internal node of a binary tree has either one or two non-empty successors. 228 | % Write a predicate internals/2 to collect them in a list. 229 | 230 | % internals(T,S) :- S is the list of internal nodes of the binary tree T. 231 | 232 | internals(nil, []). 233 | internals(t(_, nil, nil), []) :- !. 234 | internals(t(X, L, R), Is) :- 235 | internals(L, Is1), internals(R, Is2), append(Is1, [X|Is2], Is). 236 | 237 | % FIXME 238 | % ?- construct([5,3,18,1,4,12,21,42],T), 239 | % internals(T, [5, 3, 18, 21]), 240 | % writeln(ok). 241 | 242 | 243 | % 4.11 (*) Collect the nodes at a given level in a list. 244 | % A node of a binary tree is at level N if the path from the root to the node 245 | % has length N-1. The root node is at level 1. Write a predicate atlevel/3 to 246 | % collect all nodes at a given level in a list. 247 | 248 | % atlevel(T,L,S) :- S is the list of nodes of the binary tree T at level L 249 | 250 | atlevel(_, 0, []). 251 | atlevel(nil, _, []). 252 | atlevel(t(X, _, _), 1, [X]) :- !. 253 | atlevel(t(_, L, R), N, S) :- 254 | N_ is N-1, atlevel(L, N_, Sl), atlevel(R, N_, Sr), append(Sl, Sr, S). 255 | 256 | 257 | % 4.12 (**) Construct a complete binary tree. 258 | % A complete binary tree with height H is defined as follows: The levels 259 | % 1, 2, 3, ..., H-1 contain the maximum number of nodes (i.e 2**(i-1) at the 260 | % level i; note that we start counting the levels from 1 at the root). In level 261 | % H, which may contain less than the maximum possible number of nodes, all the 262 | % nodes are "left-adjusted". This means that in a levelorder tree traversal all 263 | % internal nodes come first, the leaves come second, and empty successors (the 264 | % nil's which are not really nodes!) come last. 265 | 266 | % Particularly, complete binary trees are used as data structures (or addressing 267 | % schemes) for heaps. 268 | 269 | % We can assign an address number to each node in a complete binary tree by 270 | % enumerating the nodes in levelorder, starting at the root with number 1. In 271 | % doing so, we realize that for every node X with address A the following 272 | % property holds: The address of X's left and right successors are 2*A and 273 | % 2*A+1, respectively, supposed the successors do exist. This fact can be used 274 | % to elegantly construct a complete binary tree structure. Write a predicate 275 | % complete_binary_tree/2 with the following specification: 276 | 277 | % complete_binary_tree(N,T) :- T is a complete binary tree with N nodes. (+,?) 278 | 279 | complete_binary_tree(N, T) :- complete_binary_tree(N, T, 1). 280 | 281 | complete_binary_tree(N, t(x, L, R), C) :- 282 | C =< N, 283 | complete_binary_tree(N, L, 2*C), 284 | complete_binary_tree(N, R, 2*C+1). 285 | complete_binary_tree(N, nil, C) :- C > N. 286 | 287 | 288 | % 4.13 (**) Layout a binary tree (1). 289 | % Given a binary tree as the usual Prolog term t(X,L,R) (or nil). As a 290 | % preparation for drawing the tree, a layout algorithm is required to determine 291 | % the position of each node in a rectangular grid. Several layout methods are 292 | % conceivable, one of them is shown in the illustration at: 293 | % https://sites.google.com/site/prologsite/_/rsrc/1264933989828/prolog-problems/4/p64.gif. 294 | 295 | % In this layout strategy, the position of a node v is obtained by the following 296 | % two rules: 297 | % * x(v) is equal to the positioni of the node v in the inorder 298 | % * y(v) is equal to the depth of the node v in the tree sequence 299 | 300 | % In order to store the position of the nodes, we extend the Prolog term 301 | % representing a node (and its successors) as follows: 302 | % * nil represents the empty tree (as usual) 303 | % * t(W, X, Y, L R) represents a (non-empty) binary tree with root W 304 | % "positioned" at (X, Y) and subtrees L and R. 305 | 306 | % Write a predicate layout_binary_tree/2 with the following specification: 307 | % layout_binary_tree(T, PT) :- PT is the "positioned" binary tree obtained from 308 | % the binary tree T. (+, ?) 309 | 310 | layout_binary_tree(T, PT) :- layout_binary_tree(T, PT, 1, _, 1). 311 | 312 | layout_binary_tree(nil, nil, _, I, I). 313 | layout_binary_tree(t(W, nil, nil), t(W, X_in, Y, nil, nil), X_in, X_out, Y) :- 314 | X_out is X_in + 1, !. 315 | layout_binary_tree(t(W, L, R), t(W, X_root, Y, PL, PR), X_in, X_out, Y) :- 316 | Y1 is Y+1, 317 | layout_binary_tree(L, PL, X_in, X_root, Y1), 318 | X_after_root is X_root + 1, 319 | layout_binary_tree(R, PR, X_after_root, X_out, Y1). 320 | 321 | 322 | % 4.14 (**) Layout a binary tree (2). 323 | % An alternative layout method is depicted in the illlustration at: 324 | % https://sites.google.com/site/prologsite/_/rsrc/1264934255598/prolog-problems/4/p65.gif 325 | 326 | % Find out the rules and write the corresponding Prolog predicate. Hint: on a 327 | % given level, the horizontal distance between neighbouring nodes is constant. 328 | 329 | 330 | % 4.15 (***) Layout a binary tree (3). 331 | % Yet another layout strategy is shown in the illustration at: 332 | % https://sites.google.com/site/prologsite/prolog-problems/4/p66.gif 333 | % The method yields a very compact layout while maintaining a certain symmetry 334 | % in every node. Find out the rules and write the corresponding Prolog 335 | % predicate. 336 | 337 | % Hint: Consider the horizontal distance between a node and its 338 | % successor nodes. How tight can you pack together two subtrees to construct the 339 | % combined binary tree? 340 | 341 | % Implementation note: this solution allows negative x-values. If this is 342 | % undesirable, an extra step could be added that finds the minimum value in 343 | % LEdge and shifts the tree by that amount * -1. 344 | 345 | layout_binary_tree3(T, PT) :- layout_binary_tree3(T, PT, 1, _, _). 346 | 347 | layout_binary_tree3(nil, nil, _, [], []). 348 | layout_binary_tree3(t(W, nil, nil), t(W, 1, Y, nil, nil), Y, [1], [1]) :- !. 349 | layout_binary_tree3(t(W, L, R), t(W, X, Y, PL, PR), Y, [X|LEdge], [X|REdge]) :- 350 | Y_ is Y+1, 351 | layout_binary_tree3(L, PL, Y_, LEdge, LREdge), 352 | layout_binary_tree3(R, PR_, Y_, RLEdge, RREdge), 353 | maplist(plus(2), LREdge, LRBoundary), 354 | zip_subtract(LRBoundary, RLEdge, Overlap), 355 | max_list([0|Overlap], Offset), 356 | shift_tree(PR_, Offset, PR), 357 | maplist(plus(Offset), RREdge, REdge), 358 | (PL = t(_, LX, _, _, _), ! ; LX = RX-2), 359 | (PR = t(_, RX, _, _, _), ! ; RX = LX+2), 360 | X is (LX + RX) / 2. 361 | 362 | zip_subtract([], _, []) :- !. 363 | zip_subtract(_, [], []). 364 | zip_subtract([X|Xs], [Y|Ys], [Z|Zs]) :- zip_subtract(Xs, Ys, Zs), Z is X-Y. 365 | 366 | shift_tree(nil, _, nil). 367 | shift_tree(t(W, X, Y, L, R), Offset, t(W, X_, Y, L_, R_)) :- 368 | shift_tree(L, Offset, L_), 369 | shift_tree(R, Offset, R_), 370 | X_ is X + Offset. 371 | 372 | 373 | % 4.16 (**) A string representation of binary trees. 374 | % Somebody represents binary trees as strings of the following type: 375 | % a(b(d,e),c(,f(g,))) 376 | 377 | % a) Write a Prolog predicate which generates this string representation, if the 378 | % tree is given as usual (as nil or t(X,L,R) term). Then write a predicate 379 | % which does this inverse; i.e. given the string representation, construct 380 | % the tree in the usual form. Finally, combine the two predicates in a single 381 | % predicate tree_string/2 which can be used in both directions. 382 | % For simplicity, suppose the information in the nodes is a single letter and 383 | % there are no spaces in the string. 384 | 385 | 386 | % b) Write the same predicate tree_string/2 using difference lists and a single 387 | % predicate tree_dlist/2 which does the conversion between a tree and a 388 | % difference list in both directions. 389 | 390 | 391 | % 4.17 (**) Preorder and inorder sequences of binary trees. 392 | % We consider binary trees with nodes that are identified by single lower-case 393 | % letters, as in the example of problem 4.16. 394 | 395 | % a) Write predicates preorder/2 and inorder/2 that construct the preorder and 396 | % inorder sequence of a given binary tree, respectively. The results should 397 | % be atoms. 398 | 399 | % b) Can you use preorder/2 from problem part a) in the reverse direction; i.e. 400 | % given a preorder sequence, construct a corresponding tree? If not, make the 401 | % necessary arrangements. 402 | 403 | 404 | % c) If both the preorder sequence and the inorder sequence of the nodes of a 405 | % binary tree are given, then the tree is determined unambiguously. Write a 406 | % predicate pre_in_tree/3 that does the job. 407 | 408 | 409 | % d) Solve problems a) to c) using difference lists. Cool! Use the predefined 410 | % predicate time/1 to compare the solutions. 411 | 412 | 413 | % 4.18 (**) Dotstring representation of binary trees. 414 | % We consider again binary trees with nodes that are identified by single 415 | % lower-case letters. Such a tree can be represented by the preorder sequence of 416 | % its nodes in which dots (.) are inserted where an empty subtree (nil) is 417 | % encountered during the tree traversal. For example, 'abd..e..c.fg...'. First, 418 | % try to establish a syntax (BNF or syntax diagrams) and then write a predicate 419 | % tree_dotstring/2 which does the conversion in both directions. Use difference 420 | % lists. 421 | -------------------------------------------------------------------------------- /examples/99-prolog-problems/p5_multiway_trees.pl: -------------------------------------------------------------------------------- 1 | % 5.01 (*) Check whether a given term represents a multiway tree. 2 | % Write a predicate istree/1 which succeeds if and only if its argument is a 3 | % Prolog term representing a multiway tree. 4 | 5 | % Example: 6 | % ?- istree(t(a,[t(f,[t(g,[])]),t(c,[]),t(b,[t(d,[]),t(e,[])])])). 7 | % Yes 8 | 9 | is_multitree(mt(_, [])) :- !. 10 | is_multitree(mt(_, [M|Ms])) :- 11 | is_multitree(M), 12 | is_multitree(mt(_, Ms)). 13 | 14 | ?- is_multitree(mt(a,[mt(f,[mt(g,[])]),mt(c,[]),mt(b,[mt(d,[]),mt(e,[])])])), 15 | writeln(ok). 16 | 17 | % 5.02 (*) Count the nodes of a multiway tree. 18 | % Write a predicate nnodes/1 which counts the nodes of a given multiway tree. 19 | 20 | % Example: 21 | % ?- nnodes(t(a,[t(f,[])]),N). 22 | % N = 2 23 | 24 | % Write another version of the predicate that allows for a flow pattern (o,i). 25 | 26 | nnodes(mt(_, []), 1) :- !. 27 | nnodes(mt(_, [M|Ms]), N) :- 28 | nnodes(M, N1), 29 | nnodes(mt(_, Ms), N2), 30 | N is N1+N2, !. 31 | 32 | ?- nnodes(mt(a,[mt(f,[])]),2), writeln(ok). 33 | ?- nnodes(mt(a,[mt(f,[mt(g,[])]),mt(c,[]),mt(b,[mt(d,[]),mt(e,[])])]),7), writeln(ok). 34 | 35 | 36 | % 5.03 (**) Tree construction from a node string. 37 | % We suppose that the nodes of a multiway tree contain single characters. In the 38 | % depth-first order sequence of its nodes, a special character ^ has been 39 | % inserted whenever, during the tree traversal, the move is a backtrack to the 40 | % previous level. 41 | 42 | % By this rule, the tree in the figure at: 43 | % https://sites.google.com/site/prologsite/prolog-problems/5/p70.gif 44 | % is represented as: afg^^c^bd^e^^^ 45 | 46 | % Define the syntax of the string and write a predicate tree(String,Tree) to 47 | % construct the Tree when the String is given. Work with atoms (instead of 48 | % strings). Make your predicate work in both directions. 49 | 50 | 51 | % 5.04 (*) Determine the internal path length of a tree. 52 | % We define the internal path length of a multiway tree as the total sum of the 53 | % path lengths from the root to all nodes of the tree. By this definition, the 54 | % tree in the figure of problem 5.03 has an internal path length of 9. 55 | 56 | % Write a predicate ipl(Tree,IPL) for the flow pattern (+,-). 57 | 58 | ipl(mt(_, Ms), N) :- 59 | ipl_acc(Ms, 0, 0, N). 60 | 61 | ipl_acc([], Acc1, Acc2, N) :- 62 | N is Acc1 + Acc2. 63 | 64 | ipl_acc([mt(_, Ms1)|Ms2], Acc1, Acc2, Res) :- 65 | Acc3 is Acc1+1, 66 | ipl_acc(Ms1, Acc3, Acc2, Res1), 67 | ipl_acc(Ms2, Acc1, Res1, Res). 68 | 69 | ?- ipl(mt(a,[mt(f,[mt(g,[])]),mt(c,[]),mt(b,[mt(d,[]),mt(e,[])])]), 9), 70 | writeln(ok). 71 | 72 | 73 | % 5.05 (*) Construct the bottom-up order sequence of the tree nodes. 74 | % Write a predicate bottom_up(Tree,Seq) which constructs the bottom-up sequence 75 | % of the nodes of the multiway tree Tree. Seq should be a Prolog list. 76 | 77 | % What happens if you run your predicate backwards? 78 | 79 | bottom_up(Ms, Res) :- 80 | bottom_up_acc(Ms, [], Res1), 81 | reverse(Res1, Res). 82 | 83 | bottom_up_acc([], Acc, Acc) :- !. 84 | bottom_up_acc(mt(X, []), Acc, [X|Acc]) :- !. 85 | bottom_up_acc(mt(X, [M|Ms]), Acc, Res) :- 86 | bottom_up_acc(M, Acc, Acc1), 87 | bottom_up_acc(mt(X, Ms), Acc1, Res). 88 | 89 | ?- bottom_up( 90 | mt(a,[mt(f,[mt(g,[])]),mt(c,[]),mt(b,[mt(d,[]),mt(e,[])])]), 91 | [g, f, c, d, e, b, a] 92 | ), writeln(ok). 93 | 94 | 95 | % 5.06 (**) Lisp-like tree representation. 96 | % There is a particular notation for multiway trees in Lisp. Lisp is a prominent 97 | % functional programming language, which is used primarily for artificial 98 | % intelligence problems. As such it is one of the main competitors of Prolog. In 99 | % Lisp almost everything is a list, just as in Prolog everything is a term. 100 | 101 | % The picture at: 102 | % https://sites.google.com/site/prologsite/prolog-problems/5/p73.png?attredirects=0 103 | % shows how multiway tree structures are represented in Lisp. 104 | 105 | % Note that in the "lispy" notation a node with successors (children) in the 106 | % tree is always the first element in a list, followed by its children. The 107 | % "lispy" representation of a multiway tree is a sequence of atoms and 108 | % parentheses '(' and ')', which we shall collectively call "tokens". We can 109 | % represent this sequence of tokens as a Prolog list; e.g. the lispy expression 110 | % (a (b c)) could be represented as the Prolog list 111 | % ['(', a, '(', b, c, ')', ')']. Write a predicate tree_ltl(T,LTL) which 112 | % constructs the "lispy token list" LTL if the tree is given as term T in the 113 | % usual Prolog notation. 114 | 115 | % Example: 116 | % ?- tree_ltl(t(a, [t(b, [t(c, [])])]), LTL). 117 | % LTL = ['(', a, '(', b, c, ')', ')'] 118 | 119 | % As a second, even more interesting exercise try to rewrite tree_ltl/2 in a way 120 | % that the inverse conversion is also possible: Given the list LTL, construct 121 | % the Prolog tree T. Use difference lists. 122 | -------------------------------------------------------------------------------- /examples/99-prolog-problems/p7_miscellaneous.pl: -------------------------------------------------------------------------------- 1 | % 7.01 (**) Eight queens problem. 2 | % This is a classical problem in computer science. The objective is to place 3 | % eight queens on a chessboard so that no two queens are attacking each other; 4 | % i.e., no two queens are in the same row, the same column, or on the same 5 | % diagonal. 6 | 7 | % Hint: Represent the positions of the queens as a list of numbers 1..N. 8 | % Example: [4, 2, 7, 3, 6, 8, 5, 1] means that the queen in the first column is 9 | % in row 4, the queen in the second column is in row 2, etc. Use the 10 | % generate-and-test paradigm. 11 | 12 | 13 | % 7.02 (**) Knight's tour. 14 | % Another famous problem is this one: How can a knight jump on an NxN chessboard 15 | % in such a way that it visits every square exactly once? 16 | 17 | % Hints: Represent the squares by pairs of their coordinates of the form X/Y, 18 | % where both X and Y are integers between 1 and N. (Note that '/' is just a 19 | % convenient functor, not division!) Define the relation jump(N, X/Y, U/V) to 20 | % express the fact that a knight can jump from X/Y to U/V on a NxN chessboard. 21 | % And finally, represent the solution of our problem as a list of N*N knight 22 | % positions (the knight's tour). 23 | 24 | % This implementation is mysteriously faster than the equivalent using assocs 25 | % for checking visitedness. Maybe they just have a very high constant overhead? 26 | 27 | 28 | % 7.03 (***) Von Koch's conjecture. 29 | % Several years ago I met a mathematician who was intrigued by a problem for 30 | % which he didn't know a solution. His name was Von Koch, and I don't know 31 | % whether the problem has been solved since. The problem goes like this: 32 | % given a tree with N nodes (and hence N-1 edges), find a way to enumerate the 33 | % nodes from 1 to N and, accordingly the edges from 1 to N-1, in such a way that 34 | % for each edge k the difference of its node numbers equals to K. The conjecture 35 | % is that this is always possible. 36 | 37 | % For small trees the problem is easy to solve by hand. However, for larger 38 | % trees, and 14 is already very large, it is extremely difficult to find a 39 | % solution. And remember, we don't know for sure whether there is always a 40 | % solution! 41 | 42 | % Write a predicate that calculates a numbering scheme for a given tree. What is 43 | % the solution for the larger tree pictured at: 44 | % https://sites.google.com/site/prologsite/prolog-problems/7/p92b.gif 45 | 46 | % One solution (turns out there are many): 47 | % [a=1, b=2, c=12, d=3, e=4, f=5, g=11, h=13, i=14, k=8, m=6, n=7, p=9, q=10] 48 | 49 | 50 | % m terms represent partially or fully mapped edges. They have one of two 51 | % structures: 52 | % m(A, nil, B) -> Partially mapped: A is mapped; B is unmapped 53 | % m(A, B, nil) -> Fully mapped 54 | 55 | 56 | % 7.04 (***) An arithmetic puzzle. 57 | % Given a list of integer numbers, find a correct way of inserting arithmetic 58 | % signs (operators) such that the result is a correct equation. 59 | 60 | % Example: Given the list of numbers [2, 3, 5, 7, 11], we can form the equations 61 | % 2 - 3 + 5 + 7 = 11, 2 = (3 * 5 + 7) / 11, and ten others! 62 | 63 | 64 | % 7.05 (**) English number words. 65 | % On financial documents, like cheques, numbers must sometimes be written in 66 | % full words. Example: 175 must be written as one-seven-five. Write a predicate 67 | % full_words/1 to print (non-negative) integer numbers in full words. 68 | 69 | full_words(N) :- 70 | N < 0, 71 | !, fail. 72 | 73 | full_words(N) :- 74 | N < 10, 75 | word(N, W), 76 | write(W), !. 77 | full_words(N) :- 78 | N1 is div(N, 10), 79 | N2 is mod(N, 10), 80 | full_words(N1), 81 | word(N2, W), 82 | write('-'), 83 | write(W), !. 84 | 85 | word(0, 'zero'). 86 | word(1, 'one'). 87 | word(2, 'two'). 88 | word(3, 'three'). 89 | word(4, 'four'). 90 | word(5, 'five'). 91 | word(6, 'six'). 92 | word(7, 'seven'). 93 | word(8, 'eight'). 94 | word(9, 'nine'). 95 | 96 | 97 | % 7.06 (**) Syntax checker. 98 | % In a certain programming language (Ada) identifiers are defined by the syntax 99 | % diagram (railroad chart) at: 100 | % https://sites.google.com/site/prologsite/prolog-problems/7/p96.gif 101 | 102 | % Transform the syntax diagram into a system of syntax diagrams which do not 103 | % contain loops; i.e. which are purely recursive. Using these modified diagrams, 104 | % write a predicate identifier/1 that can check whether or not a given string is 105 | % a legal identifier. 106 | 107 | 108 | % 7.07 (**) Sudoku. 109 | 110 | % Problem statement Solution 111 | % . . 4 | 8 . . | . 1 7 9 3 4 | 8 2 5 | 6 1 7 112 | % | | | | 113 | % 6 7 . | 9 . . | . . . 6 7 2 | 9 1 4 | 8 5 3 114 | % | | | | 115 | % 5 . 8 | . 3 . | . . 4 5 1 8 | 6 3 7 | 9 2 4 116 | % --------+---------+-------- --------+---------+-------- 117 | % 3 . . | 7 4 . | 1 . . 3 2 5 | 7 4 8 | 1 6 9 118 | % | | | | 119 | % . 6 9 | . . . | 7 8 . 4 6 9 | 1 5 3 | 7 8 2 120 | % | | | | 121 | % . . 1 | . 6 9 | . . 5 7 8 1 | 2 6 9 | 4 3 5 122 | % --------+---------+-------- --------+---------+-------- 123 | % 1 . . | . 8 . | 3 . 6 1 9 7 | 5 8 2 | 3 4 6 124 | % | | | | 125 | % . . . | . . 6 | . 9 1 8 5 3 | 4 7 6 | 2 9 1 126 | % | | | | 127 | % 2 4 . | . . 1 | 5 . . 2 4 6 | 3 9 1 | 5 7 8 128 | 129 | % Every spot in the puzzle belongs to a (horizontal) row and a (vertical) 130 | % column, as well as to one single 3x3 square (which we call "square" for 131 | % short). At the beginning, some of the spots carry a single-digit number 132 | % between 1 and 9. The problem is to fill the missing spots with digits in such 133 | % a way that every number between 1 and 9 appears exactly once in each row, in 134 | % each column, and in each square. 135 | 136 | 137 | % 7.08 (***) Nonograms. 138 | % Around 1994, a certain kind of puzzles was very popular in England. The 139 | % "Sunday Telegraph" newspaper wrote: "Nonograms are puzzles from Japan and are 140 | % currently published each week only in The Sunday Telegraph. Simply use your 141 | % logic and skill to complete the grid and reveal a picture or diagram." As a 142 | % Prolog programmer, you are in a better situation: you can have your computer 143 | % do the work! 144 | 145 | % The puzzle goes like this: Essentially, each row and column of a rectangular 146 | % bitmap is annotated with the respective lengths of its distinct strings of 147 | % occupied cells. The person who solves the puzzle must complete the bitmap 148 | % given only these lengths. 149 | 150 | % Problem statement: Solution: 151 | % 152 | % |_|_|_|_|_|_|_|_| 3 |_|X|X|X|_|_|_|_| 3 153 | % |_|_|_|_|_|_|_|_| 2 1 |X|X|_|X|_|_|_|_| 2 1 154 | % |_|_|_|_|_|_|_|_| 3 2 |_|X|X|X|_|_|X|X| 3 2 155 | % |_|_|_|_|_|_|_|_| 2 2 |_|_|X|X|_|_|X|X| 2 2 156 | % |_|_|_|_|_|_|_|_| 6 |_|_|X|X|X|X|X|X| 6 157 | % |_|_|_|_|_|_|_|_| 1 5 |X|_|X|X|X|X|X|_| 1 5 158 | % |_|_|_|_|_|_|_|_| 6 |X|X|X|X|X|X|_|_| 6 159 | % |_|_|_|_|_|_|_|_| 1 |_|_|_|_|X|_|_|_| 1 160 | % |_|_|_|_|_|_|_|_| 2 |_|_|_|X|X|_|_|_| 2 161 | % 1 3 1 7 5 3 4 3 1 3 1 7 5 3 4 3 162 | % 2 1 5 1 2 1 5 1 163 | 164 | % For the example above, the problem can be stated as the two lists 165 | % [[3], [2, 1], [3, 2], [2, 2], [6], [1, 5], [6], [1], [2]] and 166 | % [[1, 2], [3, 1], [1, 5], [7, 1], [5], [3], [4], [3]] which give the "solid" 167 | % lengths of the rows and columns, top-to-bottom and left-to-right, 168 | % respectively. Published puzzles are larger than this example, e.g. 25 x 20, 169 | % and apparently always have unique solutions. 170 | 171 | 172 | % 7.09 (***) Crossword puzzle. 173 | % Given an empty (or almost empty) framework of a crossword puzzle and a set of 174 | % words. The problem is to place the words into the framework. 175 | 176 | % The crossword puzzle depicted at: 177 | % https://sites.google.com/site/prologsite/prolog-problems/7/p99.gif 178 | % is specified in a text file which first lists the words (one word per line) in 179 | % an arbitrary order. Then, after an empty line, the crossword framework is 180 | % defined. In this framework specification, an empty character location is 181 | % represented by a dot (.). In order to make the solution easier, character 182 | % locations can also contain predefined character values. The image puzzle is 183 | % defined in the file p7_09a.dat, other examples are p7_09b.dat and p7_09d.dat. 184 | % There is also an example of a puzzle (p7_09c.dat) which does not have a 185 | % solution. 186 | 187 | % Words are strings (character lists) of at least two characters. A horizontal 188 | % or vertical sequence of character places in the crossword puzzle framework is 189 | % called a site. Our problem is to find a compatible way of placing words onto 190 | % sites. 191 | 192 | % Hints: 193 | % 1) The problem is not easy. You will need some time to thoroughly understand 194 | % it. So, don't give up too early! And remember that the objective is a clean 195 | % solution, not just a quick-and-dirty hack! 196 | % 2) Reading the data file is a tricky problem for which a solution is provided 197 | % in the file p7_09-readfile.pl. Use the predicate read_lines/2. 198 | % 3) For efficiency reasons it is important, at least for larger puzzles, to 199 | % sort the words and the sites in a particular order. For this part of the 200 | % problem, the solution of 1.28 may be very helpful. 201 | 202 | %% solve_crossword(+File, -Framework) is multi 203 | % File is a path to a crossword specification (several are found in the inputs 204 | % directory) and Crossword is the completed puzzle. Multiple solutions may be 205 | % found on backtracking. 206 | 207 | % This solution runs about as fast the example solution, but could probably be 208 | % made substantially faster by constructing a graph of slot overlaps and then 209 | % building outward from one point, rather than jumping all over the place. That 210 | % would require fairly substantial re-engineering of this solution though... 211 | -------------------------------------------------------------------------------- /examples/eight_queens.pl: -------------------------------------------------------------------------------- 1 | % generated: 10 November 1989 2 | % option(s): 3 | % 4 | % (queens) queens_8 5 | % 6 | % from Sterling and Shapiro, "The Art of Prolog," page 211. 7 | % 8 | % solve the 8 queens problem 9 | 10 | 11 | % This program solves the N queens problem: place N pieces on an N 12 | % by N rectangular board so that no two pieces are on the same line 13 | % - horizontal, vertical, or diagonal. (N queens so placed on an N 14 | % by N chessboard are unable to attack each other in a single move 15 | % under the rules of chess.) The strategy is incremental generate- 16 | % and-test. 17 | % 18 | % A solution is specified by a permutation of the list of numbers 1 to 19 | % N. The first element of the list is the row number for the queen in 20 | % the first column, the second element is the row number for the queen 21 | % in the second column, et cetera. This scheme implicitly incorporates 22 | % the observation that any solution of the problem has exactly one queen 23 | % in each column. 24 | % 25 | % The program distinguishes symmetric solutions. For example, 26 | % 27 | % ?- queens(4, Qs). 28 | % 29 | % produces 30 | % 31 | % Qs = [3,1,4,2] ; 32 | % 33 | % Qs = [2,4,1,3] 34 | 35 | queens(N,Qs) :- 36 | range(1,N,Ns), 37 | queens(Ns,[],Qs). 38 | 39 | queens([],Qs,Qs). 40 | queens(UnplacedQs,SafeQs,Qs) :- 41 | select(UnplacedQs,UnplacedQs1,Q), 42 | not_attack(SafeQs,Q), 43 | queens(UnplacedQs1,[Q|SafeQs],Qs). 44 | 45 | not_attack(Xs,X) :- 46 | not_attack(Xs,X,1). 47 | 48 | not_attack([],_,_) :- !. 49 | not_attack([Y|Ys],X,N) :- 50 | X =\= Y+N, X =\= Y-N, 51 | N1 is N+1, 52 | not_attack(Ys,X,N1). 53 | 54 | select([X|Xs],Xs,X). 55 | select([Y|Ys],[Y|Zs],X) :- select(Ys,Zs,X). 56 | 57 | range(N,N,[N]) :- !. 58 | range(M,N,[M|Ns]) :- 59 | M < N, 60 | M1 is M+1, 61 | range(M1,N,Ns). 62 | 63 | % This goal will print all the solutions and exit 64 | main :- 65 | queens(8, Qs), 66 | display(Qs), 67 | fail. 68 | main. 69 | -------------------------------------------------------------------------------- /examples/hello.pl: -------------------------------------------------------------------------------- 1 | % Hello, World! example 2 | 3 | ?- write('Hello, World!'), nl. 4 | -------------------------------------------------------------------------------- /examples/likes.pl: -------------------------------------------------------------------------------- 1 | % example from https://www.youtube.com/watch?v=IJ5zp9DQfMU 2 | 3 | person(alice). 4 | person(mary). 5 | person(sally). 6 | 7 | likes(alice, coke). 8 | likes(alice, fanta). 9 | likes(alice, sprite). 10 | likes(mark, water). 11 | likes(mark, coffee). 12 | likes(sally, pepsi). 13 | 14 | ?- person(Name), likes(Name, Drink). 15 | -------------------------------------------------------------------------------- /examples/mortal.pl: -------------------------------------------------------------------------------- 1 | 2 | person(socrates). 3 | person(plato). 4 | person(zeno). 5 | person(aristotle). 6 | 7 | mortal(Who) :- 8 | person(Who). 9 | 10 | ?- mortal(socrates). 11 | ?- \+ mortal(zeus). 12 | 13 | % this would print all by backtracking 14 | ?- mortal(X), 15 | writeln(X), 16 | fail. 17 | -------------------------------------------------------------------------------- /examples/not_or.pl: -------------------------------------------------------------------------------- 1 | 2 | p(a). 3 | p(b). 4 | q(c). 5 | q(d). 6 | 7 | % this should run only the first p example, fail, and jump to q examples 8 | ?- trace. 9 | ?- (\+ (p(X), ! )) ; q(X). 10 | 11 | % this should run only the first p example, succeed, and jump to q examples 12 | once(X) :- X, !. 13 | ?- once(p(X)) ; q(X). 14 | -------------------------------------------------------------------------------- /examples/overflow.pl: -------------------------------------------------------------------------------- 1 | % !!! DON'T RUN !!! 2 | % an infinite loop 3 | 4 | ping :- pong. 5 | pong :- ping. 6 | ?- ping. 7 | -------------------------------------------------------------------------------- /examples/whole_number.pl: -------------------------------------------------------------------------------- 1 | whole_number(0). 2 | whole_number(X) :- whole_number(Y), X is Y + 1. 3 | 4 | % For an infinite loop call: 5 | % ?- whole_number(X). 6 | -------------------------------------------------------------------------------- /lib/stdlib.pl: -------------------------------------------------------------------------------- 1 | 2 | true. 3 | false :- fail. 4 | 5 | \=(X, Y) :- \+ (X = Y). 6 | =\=(X, Y) :- \+ (X =:= Y). 7 | \==(A, B) :- \+ (A == B). 8 | 9 | >(A, B) :- B < A. 10 | =<(A, B) :- \+ (B < A). 11 | >=(A, B) :- \+ (A < B). 12 | 13 | @>(A, B) :- B @< A. 14 | @=<(A, B) :- \+ (B @< A). 15 | @>=(A, B) :- \+ (A @< B). 16 | 17 | forall(Cond, Action) :- \+ (Cond, \+ Action). 18 | 19 | is_list(X) :- var(X), !, fail. 20 | is_list([]). 21 | is_list([_|T]) :- is_list(T). 22 | 23 | append([], X, X). 24 | append([A|B], C, [A|D]) :- append(B, C, D). 25 | 26 | member(X, [X|_]). 27 | member(X, [_|Xs]) :- member(X, Xs). 28 | 29 | memberchk(Elem, List) :- once(member(Elem, List)). 30 | 31 | length([], 0). 32 | length([_|T], L) :- length(T, L_), L is L_ + 1. 33 | 34 | reverse(X, R) :- reverse(X, R, []). 35 | reverse([], R, R). 36 | reverse([X|Xs], R, Acc) :- reverse(Xs, R, [X|Acc]). 37 | 38 | nonvar(X) :- \+ var(X). 39 | 40 | atomic(X) :- atom(X). 41 | atomic(X) :- number(X). 42 | 43 | compound(X) :- \+ atomic(X). 44 | 45 | writeln(X) :- write(X), nl. 46 | display(X) :- writeln(X). 47 | 48 | call(X) :- X. 49 | 50 | once(X) :- X, !. 51 | 52 | ignore(X) :- X, !. 53 | ignore(_). 54 | 55 | repeat. 56 | repeat :- repeat. 57 | -------------------------------------------------------------------------------- /src/database.rs: -------------------------------------------------------------------------------- 1 | use crate::{errors::Error, types::Term}; 2 | use std::{cell::RefCell, collections::HashMap, ops::Deref, rc::Rc}; 3 | 4 | /// The name and arity of the predicate. 5 | type Key = (String, usize); 6 | type Predicates = Vec; 7 | 8 | #[derive(PartialEq, Clone)] 9 | pub struct Database(Rc>>); 10 | 11 | impl Database { 12 | #[allow(clippy::new_without_default)] 13 | pub fn new() -> Self { 14 | Database(Rc::new(RefCell::new(HashMap::new()))) 15 | } 16 | 17 | /// Assert (record) the predicate in the database. 18 | pub fn assert(&mut self, term: &Term) -> Result<(), Error> { 19 | use Term::*; 20 | match term { 21 | Atom(id) => self.insert(id.to_string(), 0, term.clone()), 22 | Struct(id, args) => self.insert(id.to_string(), args.len(), term.clone()), 23 | Rule(head, _) => match head.deref() { 24 | Atom(id) => self.insert(id.to_string(), 0, term.clone()), 25 | Struct(id, args) => self.insert(id.to_string(), args.len(), term.clone()), 26 | other => return Err(Error::TypeError(other.clone())), 27 | }, 28 | other => return Err(Error::TypeError(other.clone())), 29 | } 30 | Ok(()) 31 | } 32 | 33 | /// Query the database for the predicate. 34 | pub(crate) fn query(&self, term: &Term) -> Option> { 35 | use Term::{Atom, Struct}; 36 | match term { 37 | Atom(id) => self.get(id.to_string(), 0), 38 | Struct(id, args) => self.get(id.to_string(), args.len()), 39 | _ => unreachable!(), 40 | } 41 | } 42 | 43 | fn insert(&mut self, name: String, arity: usize, val: Term) { 44 | let key = (name, arity); 45 | if let Some(elems) = self.0.borrow_mut().get_mut(&key) { 46 | elems.push(val); 47 | return; 48 | } 49 | self.0.borrow_mut().insert(key, vec![val]); 50 | } 51 | 52 | fn get(&self, name: String, arity: usize) -> Option> { 53 | let key = (name, arity); 54 | self.0.borrow().get(&key).cloned() 55 | } 56 | } 57 | 58 | impl std::fmt::Debug for Database { 59 | fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result { 60 | write!(f, "Database({:p})", self.0.as_ptr()) 61 | } 62 | } 63 | -------------------------------------------------------------------------------- /src/errors.rs: -------------------------------------------------------------------------------- 1 | use crate::{parser, types::Term}; 2 | use core::fmt; 3 | 4 | #[derive(PartialEq, Debug, Clone)] 5 | pub enum Error { 6 | TypeError(Term), 7 | NotCallable(Term), 8 | ArithError(Term), 9 | UnsetVar(String), 10 | Unknown(Term), 11 | ParsingError(parser::ParsingError), 12 | NoMatch, 13 | } 14 | 15 | impl fmt::Display for Error { 16 | fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { 17 | use Error::*; 18 | match self { 19 | TypeError(term) => write!(f, "{} has an invalid type", term), 20 | NotCallable(term) => write!(f, "{} is not callable", term), 21 | ArithError(term) => write!(f, "{} cannot be part of an arithmetic expression", term), 22 | UnsetVar(var) => write!(f, "variable {} was not instantiated", var), 23 | Unknown(term) => match term { 24 | Term::Atom(id) => write!(f, "unknown procedure: {}/0", id), 25 | Term::Struct(id, args) => write!(f, "unknown procedure: {}/{}", id, args.len()), 26 | _ => unreachable!(), 27 | }, 28 | NoMatch => write!(f, "query returned no matches"), 29 | ParsingError(err) => err.fmt(f), 30 | } 31 | } 32 | } 33 | 34 | impl From for Error { 35 | fn from(value: parser::ParsingError) -> Self { 36 | Self::ParsingError(value) 37 | } 38 | } 39 | -------------------------------------------------------------------------------- /src/lib.rs: -------------------------------------------------------------------------------- 1 | pub mod database; 2 | pub mod errors; 3 | pub mod parser; 4 | pub mod solver; 5 | pub mod types; 6 | -------------------------------------------------------------------------------- /src/main.rs: -------------------------------------------------------------------------------- 1 | use prologrs::{ 2 | database::Database, 3 | errors::Error, 4 | parser::{ 5 | self, switch_prompt, Lexer, 6 | ParsingError::{EndOfInput, Interrupted}, 7 | StdinReader, 8 | }, 9 | solver::{eval_expr, eval_file, eval_main, Solver}, 10 | }; 11 | use std::env; 12 | 13 | macro_rules! err { 14 | ( $msg:expr ) => { 15 | println!("Error: {}", $msg) 16 | }; 17 | } 18 | 19 | fn repl(db: Database) { 20 | println!("Press ^C to exit. Press enter key or type ; for more solutions.\n"); 21 | 22 | let mut reader = StdinReader::new().unwrap(); 23 | let lex = &mut Lexer::from(&mut reader); 24 | 25 | loop { 26 | let expr = match parser::next(lex) { 27 | Ok(expr) => expr, 28 | Err(Interrupted | EndOfInput) => return, 29 | Err(msg) => { 30 | lex.drain(); 31 | err!(msg); 32 | continue; 33 | } 34 | }; 35 | let solver = match eval_expr(&expr, db.clone()) { 36 | Ok(Some(solver)) => solver, 37 | Ok(None) => continue, 38 | Err(msg) => { 39 | lex.drain(); 40 | err!(msg); 41 | continue; 42 | } 43 | }; 44 | if let Err(err) = print_solutions(solver, lex) { 45 | lex.drain(); 46 | err!(err); 47 | } 48 | } 49 | } 50 | 51 | fn print_solutions(mut solver: Solver, lex: &mut Lexer) -> Result<(), Error> { 52 | loop { 53 | match solver.next() { 54 | Some(Ok(vars)) => { 55 | if vars.is_empty() { 56 | println!("yes"); 57 | return Ok(()); 58 | } 59 | for (k, v) in vars.iter() { 60 | println!("{} = {}", k, v); 61 | } 62 | } 63 | None => { 64 | println!("no"); 65 | return Ok(()); 66 | } 67 | Some(Err(err)) => { 68 | return Err(err); 69 | } 70 | } 71 | 72 | // wait for input what to do next 73 | switch_prompt(); 74 | lex.drain(); 75 | let result = lex.read_char(); 76 | switch_prompt(); 77 | 78 | match result { 79 | Ok(';' | '\n') => (), 80 | Ok(_) => return Ok(()), 81 | Err(err) => { 82 | lex.drain(); 83 | return Err(err.into()); 84 | } 85 | } 86 | } 87 | } 88 | 89 | pub fn print_help() { 90 | println!("{} [-e][-h] [FILE...]\n", env::args().next().unwrap()); 91 | println!(" -e, --exit\trun the main/0 goal and exit"); 92 | println!(" -n, --no-std\tdo not load the standard library"); 93 | println!(" -h, --help\tdisplay this help"); 94 | } 95 | 96 | fn main() { 97 | let mut no_std = false; 98 | let mut exit = false; 99 | let mut files = Vec::new(); 100 | for arg in env::args().skip(1) { 101 | match arg.as_ref() { 102 | "-h" | "--help" => { 103 | print_help(); 104 | return; 105 | } 106 | "-e" | "--exit" => exit = true, 107 | "-n" | "--no-std" => no_std = true, 108 | name => files.push(name.to_string()), 109 | } 110 | } 111 | 112 | let db = Database::new(); 113 | 114 | if !no_std { 115 | let stdlib = "lib/stdlib.pl"; 116 | if let Err(msg) = eval_file(stdlib, db.clone()) { 117 | err!(format!("failed to load stdlib: {}", msg)); 118 | } 119 | } 120 | 121 | for path in files { 122 | if let Err(msg) = eval_file(&path, db.clone()) { 123 | err!(msg); 124 | std::process::exit(1); 125 | } 126 | } 127 | 128 | if exit { 129 | if let Err(msg) = eval_main(db) { 130 | err!(msg); 131 | std::process::exit(1); 132 | } 133 | } else { 134 | repl(db) 135 | } 136 | } 137 | -------------------------------------------------------------------------------- /src/parser/errors.rs: -------------------------------------------------------------------------------- 1 | use rustyline::error::ReadlineError; 2 | use std::fmt; 3 | 4 | #[derive(PartialEq, Debug, Clone)] 5 | pub enum ParsingError { 6 | EndOfInput, 7 | Interrupted, 8 | Invalid(char), 9 | Unexpected(String), 10 | Missing(String), 11 | IoError(String), 12 | SyntaxError, 13 | } 14 | 15 | impl fmt::Display for ParsingError { 16 | fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { 17 | use ParsingError::*; 18 | match self { 19 | Interrupted => write!(f, "interrupted"), 20 | EndOfInput => write!(f, "end of input"), 21 | Invalid(ch) => write!(f, "invalid character: '{}'", ch), 22 | Missing(msg) => write!(f, "missing {}", msg), 23 | IoError(msg) => msg.fmt(f), 24 | SyntaxError => write!(f, "syntax error"), 25 | Unexpected(token) => write!(f, "unexpected token: {}", token), 26 | } 27 | } 28 | } 29 | 30 | impl From for ParsingError { 31 | fn from(value: ReadlineError) -> Self { 32 | match value { 33 | ReadlineError::Eof => ParsingError::EndOfInput, 34 | ReadlineError::Interrupted => ParsingError::Interrupted, 35 | other => ParsingError::IoError(other.to_string()), 36 | } 37 | } 38 | } 39 | -------------------------------------------------------------------------------- /src/parser/lexer.rs: -------------------------------------------------------------------------------- 1 | use super::{ParsingError, Reader}; 2 | use core::fmt; 3 | 4 | #[derive(Debug, Clone, PartialEq)] 5 | pub(super) enum Token { 6 | Atom(String), 7 | Variable(String), 8 | Number(String), 9 | Op(String, u16, bool), 10 | Bracket(char), // '(', ')' 11 | Curly(char), // '{', '}' 12 | List(char), // '[', '|', ']' 13 | Not, // '\+' 14 | Question, // '?-' 15 | Implies, // ':-' 16 | Comma, // ',' 17 | Dot, // '.' 18 | } 19 | 20 | impl fmt::Display for Token { 21 | fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { 22 | use Token::*; 23 | match self { 24 | Atom(s) | Variable(s) | Number(s) | Op(s, _, _) => write!(f, "{}", s), 25 | Bracket(c) | Curly(c) | List(c) => write!(f, "{}", c), 26 | Not => write!(f, "\\+"), 27 | Question => write!(f, "?-"), 28 | Implies => write!(f, ":-"), 29 | Comma => write!(f, ","), 30 | Dot => write!(f, "."), 31 | } 32 | } 33 | } 34 | 35 | pub struct Lexer<'a> { 36 | reader: &'a mut dyn Reader, 37 | cache: Option, 38 | } 39 | 40 | impl<'a, R> From<&'a mut R> for Lexer<'a> 41 | where 42 | R: Reader, 43 | { 44 | fn from(value: &'a mut R) -> Self { 45 | Lexer { 46 | reader: value, 47 | cache: None, 48 | } 49 | } 50 | } 51 | 52 | impl<'a> Lexer<'a> { 53 | pub(super) fn peek(&mut self) -> Result { 54 | loop { 55 | match self.cache { 56 | Some(ref token) => return Ok(token.clone()), 57 | None => self.cache = Some(self.read_token()?), 58 | } 59 | } 60 | } 61 | 62 | pub(super) fn skip(&mut self) { 63 | self.cache = None; 64 | } 65 | 66 | pub(super) fn next(&mut self) -> Result { 67 | let result = self.peek(); 68 | self.skip(); 69 | result 70 | } 71 | 72 | fn read_token(&mut self) -> Result { 73 | use Token::*; 74 | 75 | self.skip_whitespace()?; 76 | let c = self.reader.peek()?; 77 | let token = match c { 78 | '%' => { 79 | loop { 80 | if let Ok('\n') = self.reader.next() { 81 | break; 82 | } 83 | } 84 | return self.read_token(); 85 | } 86 | '\'' => self.read_atom()?, 87 | '.' => { 88 | self.reader.skip(); 89 | Dot 90 | } 91 | ',' => { 92 | self.reader.skip(); 93 | Comma 94 | } 95 | '(' | ')' => { 96 | self.reader.skip(); 97 | Bracket(c) 98 | } 99 | '{' | '}' => { 100 | self.reader.skip(); 101 | Curly(c) 102 | } 103 | '[' | '|' | ']' => { 104 | self.reader.skip(); 105 | List(c) 106 | } 107 | '!' => { 108 | self.reader.skip(); 109 | Atom("!".to_string()) 110 | } 111 | c if c.is_numeric() => { 112 | let num = self.read_while(|c| c.is_numeric())?; 113 | Number(num) 114 | } 115 | c if is_symbol(c) => { 116 | let id = self.read_while(is_symbol)?; 117 | token_type(id) 118 | } 119 | c if c.is_lowercase() => { 120 | let id = self.read_while(is_identifier)?; 121 | token_type(id) 122 | } 123 | c if c.is_uppercase() || c == '_' => { 124 | let id = self.read_while(is_identifier)?; 125 | Variable(id) 126 | } 127 | c => { 128 | self.reader.skip(); 129 | return Err(ParsingError::Invalid(c)); 130 | } 131 | }; 132 | Ok(token) 133 | } 134 | 135 | fn read_while(&mut self, condition: fn(char) -> bool) -> Result { 136 | let mut chars: Vec = vec![]; 137 | loop { 138 | match self.reader.peek() { 139 | Ok(c) => { 140 | if !condition(c) { 141 | break; 142 | } 143 | self.reader.skip(); 144 | chars.push(c); 145 | } 146 | Err(ParsingError::EndOfInput) => break, 147 | Err(msg) => return Err(msg), 148 | } 149 | } 150 | Ok(chars.into_iter().collect()) 151 | } 152 | 153 | fn read_atom(&mut self) -> Result { 154 | // https://www.swi-prolog.org/pldoc/man?section=charescapes 155 | // https://github.com/saghm/unescape-rs/blob/master/src/lib.rs 156 | use Token::Atom; 157 | self.reader.skip(); 158 | let mut id = Vec::new(); 159 | loop { 160 | match self.reader.next()? { 161 | '\'' => return Ok(Atom(id.iter().collect())), 162 | '\\' => (), 163 | c => { 164 | id.push(c); 165 | continue; 166 | } 167 | } 168 | match self.reader.next()? { 169 | '"' => id.push('"'), 170 | '\'' => id.push('\''), 171 | '\\' => id.push('\\'), 172 | '\n' => id.push('\n'), 173 | 'n' => id.push('\n'), 174 | 'r' => id.push('\r'), 175 | 's' => id.push(' '), 176 | 't' => id.push('\t'), 177 | other => return Err(ParsingError::Invalid(other)), 178 | } 179 | } 180 | } 181 | 182 | fn skip_whitespace(&mut self) -> Result<(), ParsingError> { 183 | loop { 184 | match self.reader.peek() { 185 | Ok(c) => { 186 | if !c.is_whitespace() { 187 | break; 188 | } 189 | self.reader.skip(); 190 | } 191 | Err(ParsingError::EndOfInput) => break, 192 | Err(msg) => return Err(msg), 193 | } 194 | } 195 | Ok(()) 196 | } 197 | 198 | pub fn read_char(&mut self) -> Result { 199 | let char = self.reader.peek()?; 200 | self.reader.skip(); 201 | Ok(char) 202 | } 203 | 204 | pub fn drain(&mut self) { 205 | self.reader.drain(); 206 | } 207 | } 208 | 209 | fn token_type(token: String) -> Token { 210 | use Token::*; 211 | match token.as_str() { 212 | "\\+" => return Not, 213 | ":-" => return Implies, 214 | "?-" => return Question, 215 | _ => (), 216 | } 217 | match precedence(&token) { 218 | Some((prec, left)) => Op(token, prec, left), 219 | None => Atom(token), 220 | } 221 | } 222 | 223 | fn is_identifier(c: char) -> bool { 224 | c.is_alphanumeric() || c == '_' 225 | } 226 | 227 | fn is_symbol(c: char) -> bool { 228 | matches!( 229 | c, 230 | '+' | '-' 231 | | '*' 232 | | '/' 233 | | '\\' 234 | | '^' 235 | | '~' 236 | | ':' 237 | | ';' 238 | | '?' 239 | | '@' 240 | | '#' 241 | | '$' 242 | | '&' 243 | | '>' 244 | | '<' 245 | | '=' 246 | ) 247 | } 248 | 249 | fn precedence(op: &str) -> Option<(u16, bool)> { 250 | // https://www.swi-prolog.org/pldoc/man?section=operators 251 | let res = match op { 252 | "-" => (500, true), 253 | "->" => (1050, false), 254 | "," => (1000, false), 255 | ";" => (1100, false), 256 | ":-" => (1200, true), 257 | "@<" => (700, true), 258 | "@=<" => (700, true), 259 | "@>" => (700, true), 260 | "@>=" => (700, true), 261 | "*" => (400, true), 262 | "**" => (200, true), 263 | "/" => (400, true), 264 | "//" => (400, true), 265 | "\\" => (200, true), 266 | "\\=" => (700, true), 267 | "\\==" => (700, true), 268 | "+" => (500, true), 269 | "<" => (700, true), 270 | "=:=" => (700, true), 271 | "=" => (700, true), 272 | "=\\=" => (700, true), 273 | "=<" => (700, true), 274 | "==" => (700, true), 275 | ">" => (700, true), 276 | ">=" => (700, true), 277 | "div" => (400, true), 278 | "is" => (700, true), 279 | "mod" => (400, true), 280 | "rem" => (400, true), 281 | _ => return None, 282 | }; 283 | Some(res) 284 | } 285 | 286 | /// Check if the string is recognized as an operator by the parser. 287 | pub fn is_operator(op: &str) -> bool { 288 | precedence(op).is_some() 289 | } 290 | 291 | #[cfg(test)] 292 | mod tests { 293 | use super::{ 294 | Lexer, 295 | Token::{self, *}, 296 | }; 297 | use crate::parser::StringReader; 298 | use test_case::test_case; 299 | 300 | #[test_case( 301 | "foo.", 302 | &[Atom("foo".to_string()), Dot]; 303 | "single atom" 304 | )] 305 | #[test_case( 306 | "?- foo, 2 + 2 > 3.", 307 | &[ 308 | Question, 309 | Atom("foo".to_string()), 310 | Comma, 311 | Number("2".to_string()), 312 | Op("+".to_string(), 500, true), 313 | Number("2".to_string()), 314 | Op(">".to_string(), 700, true), 315 | Number("3".to_string()), 316 | Dot, 317 | ]; 318 | "question" 319 | )] 320 | #[test_case( 321 | "foo(a,b) :- bar(a).", 322 | &[ 323 | Atom("foo".to_string()), 324 | Bracket('('), 325 | Atom("a".to_string()), 326 | Comma, 327 | Atom("b".to_string()), 328 | Bracket(')'), 329 | Implies, 330 | Atom("bar".to_string()), 331 | Bracket('('), 332 | Atom("a".to_string()), 333 | Bracket(')'), 334 | Dot, 335 | ]; 336 | "rule" 337 | )] 338 | #[test_case( 339 | "'start\\'\\n=\\\"\\\nend'.", 340 | &[Atom("start'\n=\"\nend".to_string()), Dot]; 341 | "atom uses escape characters" 342 | )] 343 | fn lex(input: &str, expected: &[Token]) { 344 | let reader = &mut StringReader::from(input); 345 | let mut lex = Lexer::from(reader); 346 | let mut result = Vec::new(); 347 | while let Ok(token) = lex.peek() { 348 | result.push(token); 349 | lex.skip(); 350 | } 351 | assert_eq!(expected, result) 352 | } 353 | } 354 | -------------------------------------------------------------------------------- /src/parser/mod.rs: -------------------------------------------------------------------------------- 1 | mod errors; 2 | mod lexer; 3 | #[allow(clippy::module_inception)] 4 | mod parser; 5 | mod reader; 6 | 7 | pub use errors::*; 8 | pub use lexer::is_operator; 9 | pub use lexer::Lexer; 10 | pub use parser::*; 11 | pub use reader::*; 12 | -------------------------------------------------------------------------------- /src/parser/parser.rs: -------------------------------------------------------------------------------- 1 | use super::{ 2 | lexer::{Lexer, Token}, 3 | ParsingError, 4 | }; 5 | use crate::types::Term::{self, *}; 6 | 7 | pub fn next(lex: &mut Lexer) -> Result { 8 | let expr = match lex.next()? { 9 | Token::Op(id, _, _) | Token::Atom(id) => { 10 | let term = read_struct(lex, id)?; 11 | if let Token::Implies = lex.peek()? { 12 | lex.skip(); 13 | let body = read_seq(lex)?; 14 | Rule(Box::new(term), body) 15 | } else { 16 | term 17 | } 18 | } 19 | Token::Question => { 20 | let question = read_seq(lex)?; 21 | Question(question) 22 | } 23 | other => { 24 | return Err(ParsingError::Unexpected(other.to_string())); 25 | } 26 | }; 27 | expect(lex, Token::Dot)?; 28 | Ok(expr) 29 | } 30 | 31 | fn read_struct(lex: &mut Lexer, id: String) -> Result { 32 | if let Ok(Token::Bracket('(')) = lex.peek() { 33 | lex.skip(); 34 | let args = read_brackets(lex)?; 35 | if !args.is_empty() { 36 | return Ok(Struct(id, args)); 37 | } 38 | } 39 | Ok(Atom(id)) 40 | } 41 | 42 | fn read_seq(lex: &mut Lexer) -> Result, ParsingError> { 43 | let mut seq = Vec::new(); 44 | if is_boundary(&lex.peek()?) { 45 | return Ok(seq); 46 | } 47 | loop { 48 | let term = read_operation(lex)?; 49 | seq.push(term); 50 | 51 | match lex.peek()? { 52 | Token::Comma => lex.skip(), 53 | ref token if is_boundary(token) => break, 54 | other => return Err(ParsingError::Unexpected(other.to_string())), 55 | } 56 | } 57 | Ok(seq) 58 | } 59 | 60 | fn is_boundary(token: &Token) -> bool { 61 | matches!( 62 | token, 63 | Token::Bracket(')') 64 | | Token::List(']') 65 | | Token::Curly('}') 66 | | Token::List('|') 67 | | Token::Comma 68 | | Token::Dot 69 | ) 70 | } 71 | 72 | fn read_operation(lex: &mut Lexer) -> Result { 73 | pratt_parser(lex, 1200) 74 | } 75 | 76 | fn pratt_parser(lex: &mut Lexer, max_bp: u16) -> Result { 77 | // Unlike [1],[2],[3], the precedence scores in Prolog's documentation are reversed, 78 | // so instead of checking for smaller precedence when doing the check in the loop, 79 | // we need to check for higher precedence. 80 | // 81 | // [1]: https://martin.janiczek.cz/2023/07/03/demystifying-pratt-parsers.html 82 | // [2]: https://matklad.github.io/2020/04/13/simple-but-powerful-pratt-parsing.html 83 | // [3]: https://journal.stuffwithstuff.com/2011/03/19/pratt-parsers-expression-parsing-made-easy/ 84 | 85 | let mut lhs = read_term(lex)?; 86 | loop { 87 | match lex.peek()? { 88 | ref token if is_boundary(token) => break, 89 | Token::Op(op, mut prec, left) => { 90 | if prec >= max_bp { 91 | break; 92 | } 93 | lex.skip(); 94 | 95 | if !left { 96 | prec += 1; 97 | } 98 | let rhs = pratt_parser(lex, prec)?; 99 | 100 | lhs = Struct(op, vec![lhs, rhs]) 101 | } 102 | other => return Err(ParsingError::Unexpected(other.to_string())), 103 | } 104 | } 105 | Ok(lhs) 106 | } 107 | 108 | fn read_term(lex: &mut Lexer) -> Result { 109 | let term = match lex.next()? { 110 | Token::Atom(id) => read_struct(lex, id)?, 111 | Token::Variable(id) => { 112 | if id == "_" { 113 | Any 114 | } else { 115 | Variable(id, 0) 116 | } 117 | } 118 | Token::Number(val) => { 119 | let num = val.parse().unwrap(); 120 | Number(num) 121 | } 122 | op @ Token::Not => { 123 | let expr = read_operation(lex)?; 124 | Struct(op.to_string(), vec![expr]) 125 | } 126 | Token::Op(ref op, _, _) if op == "+" || op == "-" => match lex.peek()? { 127 | // a struct 128 | Token::Bracket('(') => { 129 | lex.skip(); 130 | let args = read_brackets(lex)?; 131 | Struct(op.to_string(), args) 132 | } 133 | // prefix operator 134 | _ => match read_term(lex)? { 135 | Number(val) => Number(-val), 136 | term => Struct(op.to_string(), vec![term]), 137 | }, 138 | }, 139 | Token::Op(ref op, _, _) => { 140 | expect(lex, Token::Bracket('('))?; 141 | let args = read_brackets(lex)?; 142 | Struct(op.to_string(), args) 143 | } 144 | Token::Bracket('(') => { 145 | lex.skip(); 146 | let body = read_brackets(lex)?; 147 | match body.len() { 148 | 0 => Atom("()".to_string()), 149 | 1 => body[0].clone(), 150 | _ => Struct(",".to_string(), body), 151 | } 152 | } 153 | Token::Curly('{') => { 154 | lex.skip(); 155 | let body = read_seq(lex)?; 156 | expect(lex, Token::Curly('}'))?; 157 | Struct( 158 | "{}".to_string(), 159 | match to_and(body) { 160 | Some(term) => vec![term], 161 | None => Vec::new(), 162 | }, 163 | ) 164 | } 165 | Token::List('[') => { 166 | lex.skip(); 167 | read_list(lex)? 168 | } 169 | other => return Err(ParsingError::Unexpected(other.to_string())), 170 | }; 171 | Ok(term) 172 | } 173 | 174 | fn read_brackets(lex: &mut Lexer) -> Result, ParsingError> { 175 | let body = read_seq(lex)?; 176 | expect(lex, Token::Bracket(')'))?; 177 | Ok(body) 178 | } 179 | 180 | fn read_list(lex: &mut Lexer) -> Result { 181 | let head = read_seq(lex)?; 182 | let tail = match lex.next()? { 183 | Token::List('|') => { 184 | if head.is_empty() { 185 | return Err(ParsingError::SyntaxError); 186 | } 187 | let term = read_term(lex)?; 188 | expect(lex, Token::List(']'))?; 189 | term 190 | } 191 | Token::List(']') => { 192 | if head.is_empty() { 193 | return Ok(Nil); 194 | } 195 | Nil 196 | } 197 | other => return Err(ParsingError::Unexpected(other.to_string())), 198 | }; 199 | // pack it into Cons list 200 | Ok(make_list(&head, tail)) 201 | } 202 | 203 | /// Convert [head | tail] to a cons list. 204 | pub(crate) fn make_list(head: &[Term], mut tail: Term) -> Term { 205 | use Term::Struct; 206 | for elem in head.iter().rev() { 207 | tail = Struct(".".to_string(), vec![elem.clone(), tail]) 208 | } 209 | tail 210 | } 211 | 212 | fn to_and(mut seq: Vec) -> Option { 213 | let tail = match seq.pop() { 214 | Some(rhs) => match seq.pop() { 215 | Some(lhs) => vec![lhs, rhs], 216 | None => return Some(rhs), 217 | }, 218 | None => return None, 219 | }; 220 | let init = Struct(",".to_string(), tail); 221 | let term = seq 222 | .iter() 223 | .rev() 224 | .cloned() 225 | .fold(init, |acc, x| Struct(",".to_string(), vec![x, acc])); 226 | Some(term) 227 | } 228 | 229 | fn expect(lex: &mut Lexer, expected: Token) -> Result<(), ParsingError> { 230 | let token = lex.next()?; 231 | if token != expected { 232 | return Err(ParsingError::Unexpected(token.to_string())); 233 | } 234 | Ok(()) 235 | } 236 | 237 | #[cfg(test)] 238 | mod tests { 239 | use crate::{ 240 | parser::{lexer::Lexer, FileReader, StringReader}, 241 | types::Term::{self, *}, 242 | var, 243 | }; 244 | use test_case::test_case; 245 | 246 | #[test_case( 247 | "foo.", 248 | Atom("foo".to_string()); 249 | "simple atom fact" 250 | )] 251 | #[test_case( 252 | "bar(a, 1).", 253 | Struct("bar".to_string(), vec![Atom("a".to_string()), Number(1)]); 254 | "simple struct fact" 255 | )] 256 | #[test_case( 257 | "yes(_).", 258 | Struct("yes".to_string(), vec![Any]); 259 | "wildcard" 260 | )] 261 | #[test_case( 262 | "baz(a) :- foo(a).", 263 | Rule( 264 | Box::new(Struct("baz".to_string(), vec![Atom("a".to_string())])), 265 | vec![Struct("foo".to_string(), vec![Atom("a".to_string())])] 266 | ); 267 | "simple rule" 268 | )] 269 | #[test_case( 270 | "bar(a,b,c) :- a,b,c.", 271 | Rule( 272 | Box::new(Struct("bar".to_string(), vec![Atom("a".to_string()), Atom("b".to_string()), Atom("c".to_string())])), 273 | vec![Atom("a".to_string()), Atom("b".to_string()), Atom("c".to_string())] 274 | ); 275 | "rule with and" 276 | )] 277 | #[test_case( 278 | "fizzbuzz(X) :- X mod 3 =:= 0, X mod 5 =:= 0.", 279 | Rule( 280 | Box::new(Struct("fizzbuzz".to_string(), vec![var!("X")])), 281 | vec![ 282 | Struct("=:=".to_string(), vec![ 283 | Struct("mod".to_string(), vec![ 284 | var!("X"), 285 | Number(3), 286 | ]), 287 | Number(0) 288 | ]), 289 | Struct("=:=".to_string(), vec![ 290 | Struct("mod".to_string(), vec![ 291 | var!("X"), 292 | Number(5), 293 | ]), 294 | Number(0) 295 | ]) 296 | ] 297 | ); 298 | "fizbuzz rule" 299 | )] 300 | #[test_case( 301 | "?- foo.", 302 | Question(vec![Atom("foo".to_string())]); 303 | "simple question" 304 | )] 305 | #[test_case( 306 | "?- 1+2*3>4.", 307 | Question(vec![ 308 | Struct(">".to_string(), vec![ 309 | Struct("+".to_string(), vec![ 310 | Number(1), 311 | Struct("*".to_string(), vec![ 312 | Number(2), Number(3) 313 | ]), 314 | ]), 315 | Number(4) 316 | ]) 317 | ]); 318 | "question with arithmetics" 319 | )] 320 | #[test_case( 321 | "?- (1+2)*3>4,a->b;c.", 322 | Question(vec![ 323 | Struct(">".to_string(), vec![ 324 | Struct("*".to_string(), vec![ 325 | Struct("+".to_string(), vec![ 326 | Number(1), Number(2) 327 | ]), 328 | Number(3), 329 | ]), 330 | Number(4) 331 | ]), 332 | Struct(";".to_string(), vec![ 333 | Struct("->".to_string(), vec![ 334 | Atom("a".to_string()), Atom("b".to_string()) 335 | ]), 336 | Atom("c".to_string()) 337 | ]) 338 | ]); 339 | "question with operator precedence" 340 | )] 341 | #[test_case( 342 | "?- 1+2-3+4.", 343 | Question(vec![ 344 | Struct("+".to_string(), vec![ 345 | Struct("-".to_string(), vec![ 346 | Struct("+".to_string(), vec![ 347 | Number(1), Number(2), 348 | ]), 349 | Number(3) 350 | ]), 351 | Number(4) 352 | ]) 353 | ]); 354 | "question left associative" 355 | )] 356 | #[test_case( 357 | "?- a;b;c;d.", 358 | Question(vec![ 359 | Struct(";".to_string(), vec![ 360 | Atom("a".to_string()), 361 | Struct(";".to_string(), vec![ 362 | Atom("b".to_string()), 363 | Struct(";".to_string(), vec![ 364 | Atom("c".to_string()), Atom("d".to_string()), 365 | ]), 366 | ]), 367 | ]) 368 | ]); 369 | "question right associative" 370 | )] 371 | #[test_case( 372 | "?- [] = [].", 373 | Question(vec![ 374 | Struct("=".to_string(), vec![ 375 | Nil, Nil, 376 | ]) 377 | ]); 378 | "question empty list" 379 | )] 380 | #[test_case( 381 | "?- [1,2] = [1,2|[]].", 382 | Question(vec![ 383 | Struct("=".to_string(), vec![ 384 | Struct(".".to_string(), vec![Number(1), Struct(".".to_string(), vec![Number(2), Nil])]), 385 | Struct(".".to_string(), vec![Number(1), Struct(".".to_string(), vec![Number(2), Nil])]), 386 | ]) 387 | ]); 388 | "question non-empty list" 389 | )] 390 | #[test_case( 391 | "?- [1,2,[3]|[]] = [1,2|[3]],[].", 392 | Question(vec![ 393 | Struct("=".to_string(), vec![ 394 | Struct(".".to_string(), vec![ 395 | Number(1), 396 | Struct(".".to_string(), vec![ 397 | Number(2), 398 | Struct(".".to_string(), vec![ 399 | Struct(".".to_string(), vec![Number(3), Nil]), 400 | Nil, 401 | ]) 402 | ]) 403 | ]), 404 | Struct(".".to_string(), vec![ 405 | Number(1), 406 | Struct(".".to_string(), vec![ 407 | Number(2), 408 | Struct(".".to_string(), vec![Number(3), Nil]), 409 | ]), 410 | ]) 411 | ]), 412 | Nil 413 | ]); 414 | "question more lists" 415 | )] 416 | #[test_case( 417 | "?- +(1, 2).", 418 | Question(vec![Struct("+".to_string(), vec![Number(1), Number(2)])]); 419 | "operator in front" 420 | )] 421 | #[test_case( 422 | "?- [1|X] = [1,2].", 423 | Question(vec![ 424 | Struct("=".to_string(), vec![ 425 | Struct(".".to_string(), vec![Number(1), var!("X")]), 426 | Struct(".".to_string(), vec![Number(1), Struct(".".to_string(), vec![Number(2), Nil])]), 427 | ]) 428 | ]); 429 | "two lists" 430 | )] 431 | #[test_case( 432 | "max2(X,Y,Max) :- (X >= Y, !, Max = X) ; Max = Y.", 433 | Rule( 434 | Box::new(Struct("max2".to_string(), vec![ 435 | Variable("X".to_string(), 0), 436 | Variable("Y".to_string(), 0), 437 | Variable("Max".to_string(), 0), 438 | ])), 439 | vec![Struct(";".to_string(), vec![ 440 | Struct(",".to_string(), vec![ 441 | Struct(">=".to_string(), vec![ 442 | Variable("X".to_string(), 0), 443 | Variable("Y".to_string(), 0), 444 | ]), 445 | Atom("!".to_string()), 446 | Struct("=".to_string(), vec![ 447 | Variable("Max".to_string(), 0), 448 | Variable("X".to_string(), 0), 449 | ]) 450 | ]), 451 | Struct("=".to_string(), vec![ 452 | Variable("Max".to_string(), 0), 453 | Variable("Y".to_string(), 0), 454 | ]) 455 | ])] 456 | ); 457 | "max2 rule" 458 | )] 459 | fn parser(input: &str, expected: Term) { 460 | let reader = &mut StringReader::from(input); 461 | let mut lex = Lexer::from(reader); 462 | assert_eq!(Ok(expected), super::next(&mut lex)); 463 | } 464 | 465 | #[test_case("'foo'(1, 2).", "foo(1, 2)."; "quoted atoms")] 466 | #[test_case("?- [a].", "?- [a|[]]."; "short lists")] 467 | #[test_case("?- [1,2,3,4].", "?- [1|[2|[3|[4]]]]."; "long lists")] 468 | #[test_case("?- 1 + 2 * 3.", "?- +(1, *(2, 3))."; "operation precedence")] 469 | #[test_case("?- (1 + 2) * 3.", "?- +(1, 2) * 3."; "quotes")] 470 | #[test_case("?- is(X, 2+2).", "?- X is 2+2."; "is operator")] 471 | #[test_case("?- -(5).", "?- -(((5)))."; "skip redundant brackets")] 472 | #[test_case("?- 1 + 2 div 3 * 6.", "?- 1 + *(2 div 3, 6)."; "mixed operators and structs")] 473 | #[test_case("?- \\+ foo.", "?- \\+ (foo)."; "negation and brackets")] 474 | // this is inconsistent with prolog, but this is how it works now 475 | #[test_case("?- A, B, (C ; D), E, F.", "?- A, B, C ; D, E, F."; "or with brackets")] 476 | fn parsing_equalities(lhs: &str, rhs: &str) { 477 | let reader = &mut StringReader::from(lhs); 478 | let mut lex = Lexer::from(reader); 479 | let lhs_parsed = super::next(&mut lex); 480 | 481 | let reader = &mut StringReader::from(rhs); 482 | let mut lex = Lexer::from(reader); 483 | let rhs_parsed = super::next(&mut lex); 484 | 485 | assert_eq!(lhs_parsed, rhs_parsed); 486 | } 487 | 488 | #[test] 489 | fn read_file() { 490 | let reader = &mut FileReader::from("examples/mortal.pl").unwrap(); 491 | let mut lex = Lexer::from(reader); 492 | 493 | let mut facts = 0; 494 | let mut rules = 0; 495 | let mut questions = 0; 496 | 497 | while let Ok(term) = super::next(&mut lex) { 498 | match term { 499 | Atom(_) | Struct(_, _) => facts += 1, 500 | Rule(_, _) => rules += 1, 501 | Question(_) => questions += 1, 502 | other => panic!("unexpected: {:?}", other), 503 | } 504 | } 505 | 506 | assert_eq!(facts, 4); 507 | assert_eq!(rules, 1); 508 | assert_eq!(questions, 3); 509 | } 510 | } 511 | -------------------------------------------------------------------------------- /src/parser/reader.rs: -------------------------------------------------------------------------------- 1 | use super::ParsingError; 2 | use rustyline::{Config, DefaultEditor}; 3 | use std::{ 4 | borrow::BorrowMut, 5 | fs::File, 6 | io::{BufRead, BufReader, Lines}, 7 | iter::Peekable, 8 | vec::IntoIter, 9 | }; 10 | 11 | const PROMPT: &str = "| "; 12 | pub static mut USE_PROMPT: bool = true; 13 | 14 | pub fn switch_prompt() { 15 | unsafe { 16 | USE_PROMPT = !USE_PROMPT; 17 | } 18 | } 19 | 20 | pub trait Reader { 21 | fn skip(&mut self); 22 | fn peek(&mut self) -> Result; 23 | fn drain(&mut self); 24 | 25 | fn next(&mut self) -> Result { 26 | let c = self.peek()?; 27 | self.skip(); 28 | Ok(c) 29 | } 30 | } 31 | 32 | pub struct StringReader { 33 | cache: Peekable>, 34 | } 35 | 36 | impl StringReader { 37 | pub fn from(s: &str) -> StringReader { 38 | StringReader { 39 | cache: s.chars().collect::>().into_iter().peekable(), 40 | } 41 | } 42 | 43 | fn empty() -> StringReader { 44 | StringReader::from("") 45 | } 46 | } 47 | 48 | impl Reader for StringReader { 49 | fn skip(&mut self) { 50 | self.cache.next(); 51 | } 52 | 53 | fn peek(&mut self) -> Result { 54 | self.cache.peek().ok_or(ParsingError::EndOfInput).cloned() 55 | } 56 | 57 | fn drain(&mut self) { 58 | self.cache.borrow_mut().for_each(drop); 59 | } 60 | } 61 | 62 | pub struct FileReader { 63 | lines: Lines>, 64 | iter: StringReader, 65 | } 66 | 67 | impl FileReader { 68 | pub fn from(filename: &str) -> Result { 69 | let file = File::open(filename).map_err(|msg| ParsingError::IoError(msg.to_string()))?; 70 | let mut lines = BufReader::new(file).lines(); 71 | let iter = FileReader::next_line(&mut lines)?; 72 | Ok(FileReader { lines, iter }) 73 | } 74 | 75 | fn next_line(lines: &mut Lines>) -> Result { 76 | match lines.next() { 77 | Some(Ok(line)) => Ok(StringReader::from(&format!("{}\n", line))), 78 | Some(Err(msg)) => Err(ParsingError::IoError(msg.to_string())), 79 | None => Err(ParsingError::EndOfInput), 80 | } 81 | } 82 | } 83 | 84 | impl Reader for FileReader { 85 | fn skip(&mut self) { 86 | self.iter.skip() 87 | } 88 | 89 | fn peek(&mut self) -> Result { 90 | loop { 91 | match self.iter.peek() { 92 | Err(ParsingError::EndOfInput) => { 93 | self.iter = FileReader::next_line(&mut self.lines)? 94 | } 95 | result => return result, 96 | } 97 | } 98 | } 99 | 100 | fn drain(&mut self) { 101 | self.iter.drain(); 102 | } 103 | } 104 | 105 | pub struct StdinReader { 106 | reader: DefaultEditor, 107 | buffer: StringReader, 108 | } 109 | 110 | impl StdinReader { 111 | pub fn new() -> Result { 112 | let config = Config::builder().auto_add_history(true).build(); 113 | let reader = match DefaultEditor::with_config(config) { 114 | Ok(editor) => editor, 115 | Err(msg) => return Err(ParsingError::IoError(msg.to_string())), 116 | }; 117 | Ok(StdinReader { 118 | reader, 119 | buffer: StringReader::empty(), 120 | }) 121 | } 122 | 123 | fn next_line(&mut self) -> Result { 124 | let prompt = if unsafe { USE_PROMPT } { PROMPT } else { "" }; 125 | match self.reader.readline(prompt) { 126 | Ok(line) => Ok(StringReader::from(&format!("{}\n", line))), 127 | Err(err) => Err(err.into()), 128 | } 129 | } 130 | } 131 | 132 | impl Reader for StdinReader { 133 | fn skip(&mut self) { 134 | self.buffer.skip() 135 | } 136 | 137 | fn peek(&mut self) -> Result { 138 | loop { 139 | match self.buffer.peek() { 140 | Err(ParsingError::EndOfInput) => self.buffer = self.next_line()?, 141 | result => return result, 142 | } 143 | } 144 | } 145 | 146 | fn drain(&mut self) { 147 | self.buffer.drain(); 148 | } 149 | } 150 | 151 | #[cfg(test)] 152 | mod tests { 153 | use super::{FileReader, ParsingError, Reader, StringReader}; 154 | 155 | #[test] 156 | fn string_reader() { 157 | let mut r = StringReader::from("hello"); 158 | assert_eq!(r.next(), Ok('h')); 159 | assert_eq!(r.peek(), Ok('e')); 160 | assert_eq!(r.peek(), Ok('e')); 161 | assert_eq!(r.next(), Ok('e')); 162 | assert_eq!(r.next(), Ok('l')); 163 | assert_eq!(r.next(), Ok('l')); 164 | assert_eq!(r.next(), Ok('o')); 165 | assert_eq!(r.next(), Err(ParsingError::EndOfInput)); 166 | assert_eq!(r.next(), Err(ParsingError::EndOfInput)); 167 | assert_eq!(r.peek(), Err(ParsingError::EndOfInput)); 168 | } 169 | 170 | #[test] 171 | fn file_reader() { 172 | // FileReader works the same as just iterating over the lines and characters 173 | 174 | use std::fs::File; 175 | use std::io::{BufRead, BufReader}; 176 | 177 | let filename = "src/parser/reader.rs"; 178 | 179 | let file = BufReader::new(File::open(&filename).expect("Unable to open file")); 180 | let chars = &mut Vec::::new(); 181 | for line in file.lines() { 182 | for ch in line.expect("Unable to read line").chars() { 183 | chars.push(ch); 184 | } 185 | chars.push('\n'); 186 | } 187 | 188 | let reader = &mut FileReader::from(filename).unwrap(); 189 | for ch in chars { 190 | assert_eq!(Ok(*ch), reader.next()); 191 | } 192 | } 193 | } 194 | -------------------------------------------------------------------------------- /src/solver/byrd.rs: -------------------------------------------------------------------------------- 1 | use super::{eval_file, unify, vars::Vars, TRACE}; 2 | use crate::{ 3 | atom, 4 | database::Database, 5 | errors::Error, 6 | solver::math, 7 | types::{ 8 | ConsIter, 9 | Term::{self, *}, 10 | }, 11 | }; 12 | use std::slice; 13 | 14 | /// If the question was satisfied (exit) or not (fail). 15 | pub type Status = bool; 16 | 17 | // It would be nicer to have this as a trait, but the compiler does not like 18 | // having dynamic fields in structs and complains about lifetimes. 19 | // The suggestion to make it an enum comes from the compiler itself. 20 | #[derive(Clone, Debug)] 21 | #[allow(private_interfaces)] 22 | pub enum ByrdBox { 23 | /// Does classical search and unification for the goal. 24 | Unify(Unify), 25 | /// Evaluates a function with special evaluation rules. 26 | Eval(Eval), 27 | /// Negates the result of the contained goal, then it changes 28 | /// the boolean flag forcing every coming call to fail. 29 | Not(Box, bool), 30 | /// Series of goals to satisfy. 31 | And(And), 32 | /// Has two alternating clauses. 33 | Or(Or), 34 | /// When the argument is `None` that's the cut (`!`) operator. 35 | /// Otherwise, it marks `Some(goal)`, which preceded `!`, not to be backtracked, 36 | /// ``` 37 | /// // ?- goal1, goal2, !, goal4, ... 38 | /// [Cut(Some(goal1)), Cut(Some(goal2)), Cut(None), goal4, ...] 39 | /// ``` 40 | Cut(Option>), 41 | /// A standalone variable. 42 | Var(Var), 43 | } 44 | 45 | impl ByrdBox { 46 | fn call(&mut self, vars: &mut Vars) -> Result { 47 | if unsafe { TRACE } { 48 | let goal = self.materialize(vars); 49 | println!("CALL: {}", goal); 50 | } 51 | 52 | use ByrdBox::*; 53 | let mut call = || match self { 54 | Unify(this) => this.call(vars), 55 | Eval(this) => this.call(vars), 56 | Not(_, true) => Ok(false), 57 | Not(this, done) => { 58 | *done = true; 59 | Ok(!this.call(vars)?) 60 | } 61 | And(this) => this.call(vars), 62 | Or(this) => this.call(vars), 63 | Cut(None) => Ok(true), 64 | Cut(Some(this)) => this.call(vars), 65 | Var(this) => this.call(vars), 66 | }; 67 | 68 | let status = call()?; 69 | if unsafe { TRACE } { 70 | let goal = self.materialize(vars); 71 | if status { 72 | println!("EXIT: {}", goal); 73 | } else { 74 | println!("FAIL: {}", goal); 75 | } 76 | } 77 | Ok(status) 78 | } 79 | 80 | /// Reset the branch of the search tree to start fresh search. 81 | fn reset(&mut self) { 82 | use ByrdBox::*; 83 | match self { 84 | Unify(this) => this.reset(), 85 | Not(this, done) => { 86 | *done = false; 87 | this.reset() 88 | } 89 | And(this) => this.reset(), 90 | Or(this) => this.reset(), 91 | Var(this) => this.reset(), 92 | _ => (), 93 | } 94 | } 95 | 96 | fn init(&mut self, vars: &Vars) { 97 | use ByrdBox::*; 98 | match self { 99 | Unify(this) => this.goal = vars.init(&this.goal), 100 | Eval(this) => this.args = vars.init_all(&this.args), 101 | Not(this, _) => this.init(vars), 102 | And(this) => this.init(vars), 103 | Or(this) => { 104 | this.branches[0].init(vars); 105 | this.branches[1].init(vars); 106 | } 107 | Var(this) => this.init(vars), 108 | _ => (), 109 | } 110 | } 111 | 112 | /// Move to the next clause in the search tree. Return status if the switch was possible. 113 | fn next_clause(&mut self, vars: &Vars) -> Result { 114 | use ByrdBox::*; 115 | match self { 116 | Unify(this) => this.next_clause(vars), 117 | Not(_, true) => Ok(false), 118 | Not(this, _) => this.next_clause(vars), 119 | And(this) => this.next_clause(vars), 120 | Or(this) => this.next_clause(vars), 121 | Var(this) => this.next_clause(vars), 122 | _ => Ok(false), 123 | } 124 | } 125 | 126 | /// Mark this goal as `Cut` as a result of the cut (`!`) operation. 127 | /// Such goal cannot be backtracked. 128 | fn cut(&mut self) { 129 | use ByrdBox::Cut; 130 | if !matches!(self, Cut(_)) { 131 | *self = Cut(Some(Box::new(self.clone()))); 132 | } 133 | } 134 | 135 | fn is_cut(&self) -> bool { 136 | use ByrdBox::*; 137 | match self { 138 | And(this) => this.is_cut(), 139 | Or(this) => this.is_cut(), 140 | Var(this) => this.is_cut(), 141 | Cut(_) => true, 142 | _ => false, 143 | } 144 | } 145 | 146 | /// Convert current state of the branch to the `Term` with variables replaced by their values. 147 | fn materialize(&self, vars: &Vars) -> Term { 148 | use ByrdBox::*; 149 | use Term::*; 150 | match self { 151 | Unify(this) => vars.subst(&this.goal), 152 | Eval(this) => { 153 | if this.args.is_empty() { 154 | atom!(this.id) 155 | } else { 156 | Struct(this.id.clone(), vars.subst_all(&this.args)) 157 | } 158 | } 159 | Not(this, _) => Struct("\\+".to_string(), vec![this.materialize(vars)]), 160 | And(this) => this.materialize(vars), 161 | Or(this) => Struct( 162 | ";".to_string(), 163 | vec![ 164 | this.branches[0].materialize(vars), 165 | this.branches[1].materialize(vars), 166 | ], 167 | ), 168 | Cut(None) => atom!("!"), 169 | Cut(Some(this)) => this.materialize(vars), 170 | Var(this) => this.materialize(vars), 171 | } 172 | } 173 | 174 | fn new(goal: &Term, db: Database) -> Result { 175 | use Term::*; 176 | let this = match goal { 177 | // special atoms 178 | Atom(id) if id == "!" => ByrdBox::Cut(None), 179 | Atom(id) if id == "nl" || id == "fail" || id == "trace" || id == "notrace" => { 180 | ByrdBox::Eval(Eval::new(id.to_string(), Vec::new(), db)) 181 | } 182 | // unary functions 183 | Struct(id, args) if args.len() == 1 && id == "\\+" => { 184 | let body = ByrdBox::new(&args[0], db)?; 185 | ByrdBox::Not(Box::new(body), false) 186 | } 187 | Struct(id, args) 188 | if args.len() == 1 189 | && (id == "write" 190 | || id == "consult" 191 | || id == "integer" 192 | || id == "number" 193 | || id == "var" 194 | || id == "atom") => 195 | { 196 | ByrdBox::Eval(Eval::new(id.to_string(), args.clone(), db)) 197 | } 198 | // binary functions 199 | Struct(id, args) 200 | // other inequalities are implemented in the standard library 201 | if args.len() == 2 202 | && (id == "=" 203 | || id == "is" 204 | || id == "=:=" 205 | || id == "<" 206 | || id == "==" 207 | || id == "@<") => 208 | { 209 | ByrdBox::Eval(Eval::new(id.to_string(), args.clone(), db)) 210 | } 211 | Struct(id, ref args) if args.len() == 2 && id == ";" => ByrdBox::Or(Or::new(args, db)?), 212 | Struct(id, ref args) if args.len() == 2 && id == "->" => { 213 | // `If -> Else` is a syntactic sugar for `If, !, Else` 214 | // it's implemented like this to be consistent with the ISO Prolog standard. 215 | // For `->(If, Then) :- If, !, Then.` the cut does not propagate properly, 216 | // and `If -> Then ; Else` does not pass the ISO Prolog tests by running also the Else branch. 217 | let cond = ByrdBox::new(&args[0], db.clone())?; 218 | let then = ByrdBox::new(&args[1], db.clone())?; 219 | ByrdBox::And(And::new(vec![cond, ByrdBox::Cut(None), then])) 220 | }, 221 | // functions with other number of arguments 222 | Struct(id, args) if args.len() == 3 && id == "functor" => { 223 | ByrdBox::Eval(Eval::new(id.to_string(), args.clone(), db)) 224 | } 225 | Struct(id, args) if id == "," => Self::from(args, db)?, 226 | // standalone variable 227 | Variable(_, _) => ByrdBox::Var(Var::new(goal.clone(), db)), 228 | // regular unifications 229 | Atom(_) | Struct(_, _) => ByrdBox::Unify(Unify::new(goal.clone(), db)?), 230 | _ => return Err(Error::NotCallable(goal.clone())), 231 | }; 232 | Ok(this) 233 | } 234 | 235 | pub fn from(terms: &[Term], db: Database) -> Result { 236 | let goals = boxes_from(terms, db)?; 237 | if goals.len() == 1 { 238 | Ok(goals[0].clone()) 239 | } else { 240 | Ok(Self::And(And::new(goals))) 241 | } 242 | } 243 | 244 | pub fn iter(&self) -> Solver { 245 | Solver { 246 | this: self.clone(), 247 | done: false, 248 | } 249 | } 250 | } 251 | 252 | fn boxes_from(terms: &[Term], db: Database) -> Result, Error> { 253 | let mut boxes = Vec::new(); 254 | for term in terms { 255 | match term { 256 | Term::Struct(id, args) if id == "," => { 257 | // flatten the ,() 258 | for arg in args { 259 | boxes.push(ByrdBox::new(arg, db.clone())?) 260 | } 261 | } 262 | _ => boxes.push(ByrdBox::new(term, db.clone())?), 263 | } 264 | } 265 | Ok(boxes) 266 | } 267 | 268 | pub struct Solver { 269 | this: ByrdBox, 270 | /// The final branch of the search tree was reached. 271 | /// This prevents an infinite loop. 272 | done: bool, 273 | } 274 | 275 | impl Iterator for Solver { 276 | type Item = Result; 277 | 278 | fn next(&mut self) -> Option { 279 | if self.done { 280 | return None; 281 | } 282 | 283 | // variables 284 | let mut vars = Vars::default(); 285 | vars.branch(); 286 | self.this.init(&vars); 287 | 288 | // search for solution 289 | let result = self.this.call(&mut vars); 290 | 291 | if unsafe { TRACE } { 292 | // so that there's a visual break after we end 293 | println!(); 294 | } 295 | 296 | // move the pointer, so on the next iteration we check the next branch 297 | match self.this.next_clause(&vars) { 298 | // we cannot switch to next clause 299 | // to avoid an infinite loop at the last clause mark it as done 300 | Ok(false) => self.done = true, 301 | Ok(true) => (), 302 | Err(err) => return Some(Err(err)), 303 | } 304 | 305 | match result { 306 | Ok(false) => None, 307 | Ok(true) => { 308 | // post-process 309 | vars.prune(); 310 | Some(Ok(vars)) 311 | } 312 | Err(msg) => Some(Err(msg)), 313 | } 314 | } 315 | } 316 | 317 | /// Perform standard unification of the `goal` against the clauses from the `queue`. 318 | /// The `clause` is the currently explored clause. 319 | #[derive(Clone, Debug)] 320 | struct Unify { 321 | /// The goal that is matched. 322 | goal: Term, 323 | /// The current clause it is unified against. 324 | clause: Option, 325 | /// The queue of all the clauses to be unified against. 326 | queue: Vec, 327 | /// The position of the current clause that we unify against. 328 | pos: usize, 329 | db: Database, 330 | } 331 | 332 | impl Unify { 333 | fn call(&mut self, vars: &mut Vars) -> Result { 334 | vars.branch(); 335 | let prev_vars = vars.len(); 336 | loop { 337 | if let Some(clause) = self.clause.as_mut() { 338 | if clause.call(vars)? { 339 | return Ok(true); 340 | } 341 | } 342 | 343 | // reset vars (it's append only, so we can truncate it to the previous state) 344 | vars.truncate(prev_vars); 345 | 346 | if !self.queue_next(vars)? { 347 | // there's no more clauses, search falseed 348 | // mark it as None so we don't call it again in an infinite loop 349 | self.clause = None; 350 | return Ok(false); 351 | } 352 | } 353 | } 354 | 355 | fn next_clause(&mut self, vars: &Vars) -> Result { 356 | if let Some(clause) = self.clause.as_mut() { 357 | if clause.next_clause(vars)? { 358 | return Ok(true); 359 | } 360 | } 361 | self.queue_next(vars) 362 | } 363 | 364 | fn queue_next(&mut self, vars: &Vars) -> Result { 365 | if self.is_cut() || self.is_done() { 366 | return Ok(false); 367 | } 368 | let goal = self.goal.clone(); 369 | let clause = vars.init(&self.queue[self.pos]); 370 | self.clause = Some(Clause::new(goal, clause, self.db.clone())?); 371 | self.pos += 1; 372 | Ok(true) 373 | } 374 | 375 | /// We explored all the branches in the queue. 376 | fn is_done(&self) -> bool { 377 | self.pos >= self.queue.len() 378 | } 379 | 380 | fn reset(&mut self) { 381 | if !self.is_cut() { 382 | self.clause = None; 383 | self.pos = 0; 384 | } 385 | } 386 | 387 | /// The current clause reached the cutpoint, this means 388 | /// that the the cut (`!`) is applicable also to searching 389 | /// for further solutions. 390 | fn is_cut(&self) -> bool { 391 | if let Some(ref clause) = self.clause { 392 | return clause.is_cut(); 393 | } 394 | false 395 | } 396 | 397 | fn new(goal: Term, db: Database) -> Result { 398 | let queue = db.query(&goal).unwrap_or_default(); 399 | if queue.is_empty() { 400 | return Err(Error::Unknown(goal.clone())); 401 | } 402 | Ok(Self { 403 | goal, 404 | clause: None, 405 | queue, 406 | pos: 0, 407 | db, 408 | }) 409 | } 410 | } 411 | 412 | /// The `goal` is unified with `head`, then the `body` is evaluated. 413 | #[derive(Clone, Debug)] 414 | struct Clause { 415 | goal: Term, 416 | head: Term, 417 | body: Option>, 418 | } 419 | 420 | impl Clause { 421 | fn call(&mut self, vars: &mut Vars) -> Result { 422 | if !unify(&self.goal, &self.head, vars) { 423 | self.body = None; 424 | return Ok(false); 425 | } 426 | 427 | if let Some(body) = self.body.as_mut() { 428 | vars.branch(); 429 | let prev_vars = vars.len(); 430 | if body.call(vars)? { 431 | return Ok(true); 432 | } 433 | // reset vars (it's append only, so we can truncate it to the previous state) 434 | vars.truncate(prev_vars); 435 | return Ok(false); 436 | } 437 | Ok(true) 438 | } 439 | 440 | fn next_clause(&mut self, vars: &Vars) -> Result { 441 | if let Some(body) = self.body.as_mut() { 442 | return body.next_clause(vars); 443 | } 444 | Ok(false) 445 | } 446 | 447 | fn is_cut(&self) -> bool { 448 | if let Some(ref body) = self.body { 449 | return body.is_cut(); 450 | } 451 | false 452 | } 453 | 454 | fn new(goal: Term, clause: Term, db: Database) -> Result { 455 | let (head, body) = match clause { 456 | Rule(head, ref body) => { 457 | let body = Box::new(ByrdBox::from(body, db)?); 458 | (*head.clone(), Some(body)) 459 | } 460 | _ => (clause, None), 461 | }; 462 | Ok(Self { goal, head, body }) 463 | } 464 | } 465 | 466 | /// Call an expression with special evaluation rules (e.g. arithmetic operations). 467 | /// The `id` is the name of the evaluated function, `args` are it's arguments (can be empty), 468 | /// and `done` is the status flag signaling that it was already evaluated, so there is nothing 469 | /// more to explore here (to avoid infinite loops when calling it again). 470 | #[derive(Clone, Debug)] 471 | struct Eval { 472 | id: String, 473 | args: Vec, 474 | db: Database, 475 | } 476 | 477 | impl Eval { 478 | fn call(&mut self, vars: &mut Vars) -> Result { 479 | let args = vars.subst_all(&self.args); 480 | 481 | match self.id.as_str() { 482 | "fail" => Ok(false), 483 | "=" => Ok(unify(&args[0], &args[1], vars)), 484 | "is" => { 485 | let (lhs, rhs) = (&args[0], &args[1]); 486 | let result = math::eval(rhs.clone(), vars)?; 487 | match lhs { 488 | Variable(_, _) => match vars.get(lhs) { 489 | Some(val) => Ok(val == &result), 490 | None => { 491 | vars.insert(lhs.clone(), result.clone()); 492 | Ok(true) 493 | } 494 | }, 495 | Number(_) => Ok(lhs == &result), 496 | _ => Err(Error::TypeError(lhs.clone())), 497 | } 498 | } 499 | "=:=" => { 500 | let (lhs, rhs) = math::eval_args(&args, vars)?; 501 | Ok(lhs == rhs) 502 | } 503 | "<" => { 504 | let (lhs, rhs) = math::eval_args(&args, vars)?; 505 | Ok(lhs < rhs) 506 | } 507 | "==" => { 508 | // _ \== _ according to ISO Prolog 509 | if args[0] == Any || args[1] == Any { 510 | return Ok(false); 511 | } 512 | Ok(args[0] == args[1]) 513 | } 514 | "@<" => Ok(vars.cmp(&args[0], &args[1]) == std::cmp::Ordering::Less), 515 | "nl" => { 516 | println!(); 517 | Ok(true) 518 | } 519 | "integer" | "number" => Ok(matches!(args[0], Number(_))), 520 | "var" => { 521 | Ok(matches!(&self.args[0], Variable(_, _)) && vars.get(&self.args[0]).is_none()) 522 | } 523 | "atom" => Ok(matches!(args[0], Atom(_) | Nil)), 524 | "write" => { 525 | print!("{}", args[0]); 526 | Ok(true) 527 | } 528 | "consult" => { 529 | match &args[0] { 530 | Atom(path) => { 531 | let path = assure_pl_extension(path); 532 | eval_file(&path, self.db.clone())?; 533 | } 534 | list @ Struct(id, _) if id == "." => { 535 | for path in ConsIter::from(list.clone()) { 536 | match path { 537 | Atom(ref path) => { 538 | let path = assure_pl_extension(path); 539 | eval_file(&path, self.db.clone())?; 540 | } 541 | other => return Err(Error::TypeError(other.clone())), 542 | } 543 | } 544 | } 545 | other => return Err(Error::TypeError(other.clone())), 546 | } 547 | Ok(true) 548 | } 549 | "trace" => { 550 | unsafe { 551 | TRACE = true; 552 | } 553 | Ok(true) 554 | } 555 | "untrace" => { 556 | unsafe { 557 | TRACE = false; 558 | } 559 | Ok(true) 560 | } 561 | "functor" => match &args[0] { 562 | Struct(name, func_args) => { 563 | if !unify(&atom!(name), &args[1], vars) { 564 | return Ok(false); 565 | } 566 | if !unify(&Number(func_args.len().try_into().unwrap()), &args[2], vars) { 567 | return Ok(false); 568 | } 569 | Ok(true) 570 | } 571 | Atom(id) => { 572 | if !unify(&atom!(id), &args[1], vars) { 573 | return Ok(false); 574 | } 575 | if !unify(&Number(0), &args[2], vars) { 576 | return Ok(false); 577 | } 578 | Ok(true) 579 | } 580 | _ => Ok(false), 581 | }, 582 | _ => unreachable!(), 583 | } 584 | } 585 | 586 | fn new(id: String, args: Vec, db: Database) -> Self { 587 | Self { id, args, db } 588 | } 589 | } 590 | 591 | fn assure_pl_extension(path: &str) -> String { 592 | // like Prolog, add the extension if needed 593 | if std::fs::metadata(path).is_err() { 594 | return format!("{}.pl", path); 595 | } 596 | path.to_string() 597 | } 598 | 599 | #[derive(Debug, Clone)] 600 | struct And { 601 | goals: Vec, 602 | /// We reached the final branch of the search tree, don't call it again (to avoid an infinite loop). 603 | done: bool, 604 | } 605 | 606 | impl And { 607 | fn call(&mut self, vars: &mut Vars) -> Result { 608 | // the checkpoints are used to garbage collect the old variables 609 | let mut checkpoints = vec![0; self.goals.len()]; 610 | let mut pos = 0; 611 | 612 | while pos < self.goals.len() { 613 | checkpoints[pos] = vars.len(); 614 | 615 | if self.goals[pos].is_cut() { 616 | self.cut_before(pos); 617 | } 618 | 619 | if self.goals[pos].call(vars)? { 620 | pos += 1; 621 | } else { 622 | // try other branch or backtrack 623 | match self.backtrack(pos, vars)? { 624 | Some(i) => { 625 | pos = i; 626 | vars.truncate(checkpoints[pos]); 627 | } 628 | None => { 629 | self.done = true; 630 | return Ok(false); 631 | } 632 | } 633 | } 634 | } 635 | Ok(true) 636 | } 637 | 638 | /// Mark the goals preceding the `pos` index for no backtracking. 639 | /// The goals following `pos` can be backtracked. 640 | fn cut_before(&mut self, pos: usize) { 641 | for i in 0..pos { 642 | self.goals[i].cut(); 643 | } 644 | } 645 | 646 | fn backtrack(&mut self, mut pos: usize, vars: &Vars) -> Result, Error> { 647 | loop { 648 | if self.goals[pos].next_clause(vars)? { 649 | return Ok(Some(pos)); 650 | } 651 | if pos > 0 { 652 | self.goals[pos].reset(); 653 | pos -= 1; 654 | } else { 655 | return Ok(None); 656 | } 657 | } 658 | } 659 | 660 | fn next_clause(&mut self, vars: &Vars) -> Result { 661 | if self.done || self.goals.is_empty() { 662 | return Ok(false); 663 | } 664 | Ok(self.backtrack(self.goals.len() - 1, vars)?.is_some()) 665 | } 666 | 667 | fn materialize(&self, vars: &Vars) -> Term { 668 | use Term::Struct; 669 | let goals: Vec<_> = self 670 | .goals 671 | .iter() 672 | .map(|goal| goal.materialize(vars)) 673 | .collect(); 674 | if goals.len() > 1 { 675 | Struct(",".to_string(), goals) 676 | } else { 677 | goals[0].clone() 678 | } 679 | } 680 | 681 | fn init(&mut self, vars: &Vars) { 682 | self.goals.iter_mut().for_each(|goal| goal.init(vars)); 683 | } 684 | 685 | fn reset(&mut self) { 686 | self.goals.iter_mut().for_each(|goal| goal.reset()); 687 | self.done = false; 688 | } 689 | 690 | fn is_cut(&self) -> bool { 691 | // cut, when reached, propagates to earlier goals 692 | // so it is enough to check the first one 693 | self.goals 694 | .first() 695 | .map_or(false, |goal| matches!(goal, ByrdBox::Cut(_))) 696 | } 697 | 698 | fn new(goals: Vec) -> Self { 699 | And { goals, done: false } 700 | } 701 | } 702 | 703 | /// Switch between alternative goals until success. 704 | #[derive(Clone, Debug)] 705 | struct Or { 706 | branches: Box<[ByrdBox; 2]>, 707 | pos: usize, 708 | } 709 | 710 | impl Or { 711 | fn call(&mut self, vars: &mut Vars) -> Result { 712 | let prev_vars = vars.len(); 713 | loop { 714 | if self.last_mut().call(vars)? { 715 | return Ok(true); 716 | } 717 | // reset vars (it's append only, so we can truncate it to the previous state) 718 | vars.truncate(prev_vars); 719 | // otherwise try next branch 720 | if !self.next_clause(vars)? { 721 | return Ok(false); 722 | } 723 | } 724 | } 725 | 726 | fn last_mut(&mut self) -> &mut ByrdBox { 727 | &mut self.branches[self.pos] 728 | } 729 | 730 | fn last(&self) -> &ByrdBox { 731 | &self.branches[self.pos] 732 | } 733 | 734 | fn is_cut(&self) -> bool { 735 | self.last().is_cut() 736 | } 737 | 738 | /// Reset the branch of the search tree to start fresh search. 739 | fn reset(&mut self) { 740 | if !self.is_cut() { 741 | self.pos = 0; 742 | self.branches[0].reset(); 743 | self.branches[1].reset(); 744 | } 745 | } 746 | 747 | fn next_clause(&mut self, vars: &Vars) -> Result { 748 | if self.last_mut().next_clause(vars)? { 749 | return Ok(true); 750 | } 751 | if self.is_cut() { 752 | return Ok(false); 753 | } 754 | if self.pos == 0 { 755 | self.pos += 1; 756 | return Ok(true); 757 | } 758 | Ok(false) 759 | } 760 | 761 | fn new(args: &[Term], db: Database) -> Result { 762 | debug_assert!(args.len() == 2); 763 | let branches = Box::new([ 764 | ByrdBox::from(slice::from_ref(&args[0]), db.clone())?, 765 | ByrdBox::from(slice::from_ref(&args[1]), db)?, 766 | ]); 767 | Ok(Self { branches, pos: 0 }) 768 | } 769 | } 770 | 771 | #[derive(Debug, Clone)] 772 | struct Var { 773 | var: Term, 774 | val: Option>, 775 | db: Database, 776 | } 777 | 778 | impl Var { 779 | fn call(&mut self, vars: &mut Vars) -> Result { 780 | if let Some(this) = self.val.as_mut() { 781 | return this.call(vars); 782 | } 783 | if self.init_val(vars)? { 784 | return self.call(vars); 785 | } 786 | let var = vars.find_origin(self.var.clone()); 787 | Err(Error::UnsetVar(var.to_string())) 788 | } 789 | 790 | fn next_clause(&mut self, vars: &Vars) -> Result { 791 | if let Some(val) = self.val.as_mut() { 792 | return val.next_clause(vars); 793 | } 794 | self.init_val(vars) 795 | } 796 | 797 | fn init_val(&mut self, vars: &Vars) -> Result { 798 | if let Some(term) = vars.get(&self.var) { 799 | let goal = ByrdBox::new(term, self.db.clone())?; 800 | self.val = Some(Box::new(goal)); 801 | return Ok(true); 802 | } 803 | Ok(false) 804 | } 805 | 806 | fn is_cut(&self) -> bool { 807 | if let Some(val) = self.val.as_ref() { 808 | return val.is_cut(); 809 | } 810 | false 811 | } 812 | 813 | fn materialize(&self, vars: &Vars) -> Term { 814 | vars.subst(&self.var) 815 | } 816 | 817 | fn init(&mut self, vars: &Vars) { 818 | self.var = vars.init(&self.var); 819 | } 820 | 821 | fn reset(&mut self) { 822 | self.val = None; 823 | } 824 | 825 | fn new(var: Term, db: Database) -> Self { 826 | Self { var, val: None, db } 827 | } 828 | } 829 | -------------------------------------------------------------------------------- /src/solver/cmp.rs: -------------------------------------------------------------------------------- 1 | use super::Vars; 2 | use crate::types::Term; 3 | use std::iter::zip; 4 | 5 | impl Term { 6 | fn ord(&self) -> u8 { 7 | use Term::*; 8 | match self { 9 | Variable(_, _) | Any => 0, 10 | Number(_) => 1, 11 | Atom(_) => 2, 12 | Struct(_, _) | Nil => 3, 13 | _ => unreachable!(), 14 | } 15 | } 16 | } 17 | 18 | impl Vars { 19 | #[allow(clippy::only_used_in_recursion)] 20 | pub(super) fn cmp(&self, lhs: &Term, rhs: &Term) -> std::cmp::Ordering { 21 | use std::cmp::Ordering::*; 22 | use Term::*; 23 | 24 | match lhs.ord().cmp(&rhs.ord()) { 25 | Equal => (), 26 | other => return other, 27 | }; 28 | match (lhs, rhs) { 29 | (Any, _) => Less, 30 | (_, Any) => Greater, 31 | (Nil, Nil) => Equal, 32 | // variables should be sorted by address, 33 | // but here they don't reserve memory, so it is not possible 34 | // comparing them by scope seems the closest we can get 35 | (Variable(_, lhs), Variable(_, rhs)) => lhs.cmp(rhs), 36 | (Number(lhs), Number(rhs)) => lhs.cmp(rhs), 37 | (Atom(lhs), Atom(rhs)) => lhs.cmp(rhs), 38 | (Struct(lhs_id, lhs_args), Struct(rhs_id, rhs_args)) => { 39 | match lhs_args.len().cmp(&rhs_args.len()) { 40 | Equal => (), 41 | other => return other, 42 | }; 43 | match lhs_id.cmp(rhs_id) { 44 | Equal => (), 45 | other => return other, 46 | }; 47 | zip(lhs_args, rhs_args) 48 | .find_map(|(a, b)| match self.cmp(a, b) { 49 | Equal => None, 50 | other => Some(other), 51 | }) 52 | .unwrap_or(Equal) 53 | } 54 | _ => unreachable!(), 55 | } 56 | } 57 | } 58 | -------------------------------------------------------------------------------- /src/solver/eval.rs: -------------------------------------------------------------------------------- 1 | use super::{byrd::ByrdBox, Solver}; 2 | use crate::{ 3 | atom, 4 | database::Database, 5 | errors::Error, 6 | parser::{self, FileReader, Lexer}, 7 | types::Term::{self, Atom, Question}, 8 | }; 9 | use std::borrow::BorrowMut; 10 | 11 | pub fn eval_file(path: &str, db: Database) -> Result<(), Error> { 12 | use parser::ParsingError::*; 13 | 14 | let mut reader = match FileReader::from(path) { 15 | Ok(reader) => reader, 16 | Err(err) => return Err(err.into()), 17 | }; 18 | let lex = &mut Lexer::from(&mut reader); 19 | 20 | loop { 21 | match parser::next(lex) { 22 | Ok(ref expr) => { 23 | if let Some(mut solver) = eval_expr(expr, db.clone())? { 24 | match solver.next() { 25 | Some(Ok(_)) => (), 26 | Some(Err(err)) => return Err(err), 27 | None => return Err(Error::NoMatch), 28 | } 29 | } 30 | } 31 | Err(Interrupted | EndOfInput) => return Ok(()), 32 | Err(msg) => return Err(msg.into()), 33 | } 34 | } 35 | } 36 | 37 | pub fn eval_main(db: Database) -> Result<(), Error> { 38 | if db.query(&atom!("main")).is_some() { 39 | match eval_expr(&Question(vec![atom!("main")]), db) { 40 | Ok(Some(mut solver)) => match solver.next() { 41 | Some(_) => (), 42 | None => return Err(Error::NoMatch), 43 | }, 44 | Ok(None) => (), 45 | Err(err) => return Err(err), 46 | } 47 | } 48 | Ok(()) 49 | } 50 | 51 | pub fn eval_expr(term: &Term, mut db: Database) -> Result, Error> { 52 | match term { 53 | Question(goals) => { 54 | let solver = ByrdBox::from(goals, db.clone())?.iter(); 55 | Ok(Some(solver)) 56 | } 57 | _ => { 58 | db.borrow_mut().assert(term)?; 59 | Ok(None) 60 | } 61 | } 62 | } 63 | -------------------------------------------------------------------------------- /src/solver/math.rs: -------------------------------------------------------------------------------- 1 | use super::Vars; 2 | use crate::{errors::Error, types::Term}; 3 | 4 | pub(super) fn eval(mut term: Term, vars: &Vars) -> Result { 5 | use Term::*; 6 | loop { 7 | match term { 8 | Number(_) => return Ok(term), 9 | Struct(ref id, ref args) if args.len() == 1 => { 10 | let num = match eval(args[0].clone(), vars)? { 11 | Number(val) => val, 12 | other => return Err(Error::TypeError(other)), 13 | }; 14 | let val = match id.as_str() { 15 | "-" => -num, 16 | "+" => num, 17 | "abs" => num.abs(), 18 | "sign" => num.signum(), 19 | _ => return Err(Error::TypeError(term)), 20 | }; 21 | return Ok(Number(val)); 22 | } 23 | Struct(ref id, ref args) if args.len() == 1 && id == "+" => { 24 | return eval(args[0].clone(), vars) 25 | } 26 | Struct(ref id, ref args) if args.len() == 2 => { 27 | let (lhs, rhs) = eval_args(args, vars)?; 28 | match id.as_str() { 29 | "+" => return Ok(Number(lhs + rhs)), 30 | "-" => return Ok(Number(lhs - rhs)), 31 | "*" => return Ok(Number(lhs * rhs)), 32 | "/" | "//" => return Ok(Number(lhs / rhs)), 33 | "div" => return Ok(Number(lhs.div_euclid(rhs))), 34 | "rem" => return Ok(Number(lhs % rhs)), 35 | "mod" => return Ok(Number(lhs.rem_euclid(rhs))), 36 | _ => return Err(Error::ArithError(term)), 37 | } 38 | } 39 | Variable(_, _) => match vars.get(&term) { 40 | Some(val) => term = val.clone(), 41 | None => { 42 | return { 43 | let var = vars.find_origin(term.clone()); 44 | Err(Error::UnsetVar(var.to_string())) 45 | } 46 | } 47 | }, 48 | _ => return Err(Error::ArithError(term)), 49 | } 50 | } 51 | } 52 | 53 | pub(super) fn eval_args(args: &[Term], vars: &Vars) -> Result<(i32, i32), Error> { 54 | use Term::Number; 55 | debug_assert!(args.len() == 2); 56 | 57 | let lhs = eval(args[0].clone(), vars)?; 58 | let rhs = eval(args[1].clone(), vars)?; 59 | match (lhs, rhs) { 60 | (Number(lhs), Number(rhs)) => Ok((lhs, rhs)), 61 | (Number(_), other) | (other, _) => Err(Error::TypeError(other)), 62 | } 63 | } 64 | -------------------------------------------------------------------------------- /src/solver/mod.rs: -------------------------------------------------------------------------------- 1 | mod byrd; 2 | mod cmp; 3 | mod eval; 4 | mod math; 5 | mod unify; 6 | mod vars; 7 | 8 | pub use byrd::{ByrdBox, Solver}; 9 | pub use eval::{eval_expr, eval_file, eval_main}; 10 | pub(crate) use unify::unify; 11 | pub use vars::Vars; 12 | 13 | #[cfg(test)] 14 | mod tests; 15 | 16 | pub static mut TRACE: bool = false; 17 | -------------------------------------------------------------------------------- /src/solver/unify.rs: -------------------------------------------------------------------------------- 1 | use super::vars::Vars; 2 | use crate::types::Term::{self, *}; 3 | use std::iter::zip; 4 | 5 | /// Unification algorithm. 6 | /// 7 | /// * Atoms are checked for equality. 8 | /// * The wildcard "_" unifies with anything. 9 | /// * Compound terms have same IDs, arity, and elements. 10 | /// * Variable unifies with a value if it is not initialized 11 | /// or it was initialized with a value that unifies with the new value. 12 | pub(crate) fn unify(lhs: &Term, rhs: &Term, vars: &mut Vars) -> bool { 13 | use Term::*; 14 | match (lhs, rhs) { 15 | (Any, _) | (_, Any) => true, 16 | (Struct(lhs_id, lhs_args), Struct(rhs_id, rhs_args)) => { 17 | if lhs_id != rhs_id || lhs_args.len() != rhs_args.len() { 18 | return false; 19 | } 20 | let prev_vars = vars.len(); 21 | if !unify_all(lhs_args, rhs_args, vars) { 22 | // rollback the changes 23 | vars.truncate(prev_vars); 24 | return false; 25 | } 26 | true 27 | } 28 | (var @ Variable(_, _), val) | (val, var @ Variable(_, _)) => unify_var(var, val, vars), 29 | (lhs, rhs) => lhs == rhs, 30 | } 31 | } 32 | 33 | fn unify_all(lhs: &[Term], rhs: &[Term], vars: &mut Vars) -> bool { 34 | zip(lhs, rhs).all(|(a, b)| unify(a, b, vars)) 35 | } 36 | 37 | fn unify_var(var: &Term, val: &Term, vars: &mut Vars) -> bool { 38 | if var == val { 39 | return true; 40 | } 41 | if let Some(ref new) = vars.get(var).cloned() { 42 | return unify(new, val, vars); 43 | } 44 | // Dereferencing the value to avoid invalid unification for cycles, as described in 45 | // Norvig "Correcting A Widespread Error in Unification Algorithms" 46 | // https://norvig.com/unify-bug.pdf 47 | if let Variable(_, _) = val { 48 | if let Some(ref val) = vars.get(val).cloned() { 49 | return unify(var, val, vars); 50 | } 51 | }; 52 | vars.insert(var.clone(), val.clone()); 53 | true 54 | } 55 | -------------------------------------------------------------------------------- /src/solver/vars.rs: -------------------------------------------------------------------------------- 1 | use crate::types::Term::{self, *}; 2 | 3 | pub(super) const UNINIT: usize = 0; 4 | pub(super) const BASE: usize = 1; 5 | 6 | #[derive(Debug, Clone, PartialEq, Default)] 7 | pub struct Vars { 8 | map: Vec<(Term, Term)>, 9 | branch: usize, 10 | } 11 | 12 | impl Vars { 13 | pub(super) fn get(&self, key: &Term) -> Option<&Term> { 14 | self.map 15 | .iter() 16 | .rev() 17 | .find(|(term, _)| term == key) 18 | .map(|(_, val)| val) 19 | } 20 | 21 | pub(super) fn insert(&mut self, key: Term, val: Term) { 22 | debug_assert!(matches!(key, Variable(_, scope) if scope != UNINIT)); 23 | self.map.push((key, val)); 24 | } 25 | 26 | /// Retain the variables from the initial goal mapped to their values. 27 | pub(super) fn prune(&mut self) { 28 | self.flatten(); 29 | self.map.retain(|(key, val)| match (key, val) { 30 | (Variable(_, x), Variable(_, y)) => *x == BASE && *y == BASE, 31 | (_, Variable(_, BASE)) | (Variable(_, BASE), _) => true, 32 | _ => false, 33 | }); 34 | self.branch = UNINIT; 35 | } 36 | 37 | /// Replace the references to the values with the values. 38 | pub(super) fn flatten(&mut self) { 39 | for i in (0..self.len()).rev() { 40 | let old = &self.map[i].1; 41 | if let Some(new) = self.replacement(old) { 42 | self.map[i].1 = self.subst(&new); 43 | } 44 | } 45 | } 46 | 47 | /// Find a replacement value for `val` when flattening `Vars`. 48 | pub(super) fn replacement(&self, val: &Term) -> Option { 49 | match val { 50 | Variable(_, BASE) => None, 51 | Variable(_, _) => self.get(val).cloned(), 52 | Struct(id, args) => { 53 | let new_args = args 54 | .iter() 55 | .map(|arg| self.replacement(arg).unwrap_or(arg.clone())) 56 | .collect(); 57 | Some(Struct(id.to_string(), new_args)) 58 | } 59 | _ => None, 60 | } 61 | } 62 | 63 | pub fn iter(&self) -> std::slice::Iter<(Term, Term)> { 64 | self.map.iter() 65 | } 66 | 67 | pub(super) fn branch(&mut self) { 68 | self.branch += 1; 69 | } 70 | 71 | pub(super) fn len(&self) -> usize { 72 | self.map.len() 73 | } 74 | 75 | pub fn is_empty(&self) -> bool { 76 | self.map.is_empty() 77 | } 78 | 79 | pub(super) fn truncate(&mut self, len: usize) { 80 | self.map.truncate(len) 81 | } 82 | 83 | /// Recursively find the earliest key pointing to this value. 84 | pub(super) fn find_origin(&self, mut val: Term) -> Term { 85 | loop { 86 | match self.map.iter().find(|(_, v)| *v == val) { 87 | None => return val, 88 | Some((key, _)) => val = key.clone(), 89 | } 90 | } 91 | } 92 | 93 | /// Initialize uninitialized variables. 94 | pub(super) fn init(&self, term: &Term) -> Term { 95 | match term { 96 | Variable(id, UNINIT) => Variable(id.to_string(), self.branch), 97 | Variable(_, _) => self.get(term).unwrap_or(term).clone(), 98 | Struct(id, args) => Struct(id.to_string(), self.init_all(args)), 99 | Rule(head, body) => Rule(Box::new(self.init(head)), self.init_all(body)), 100 | other => other.clone(), 101 | } 102 | } 103 | 104 | /// Initialize uninitialized variables. 105 | pub(super) fn init_all(&self, terms: &[Term]) -> Vec { 106 | terms.iter().map(|term| self.init(term)).collect() 107 | } 108 | 109 | /// Substitute variables with their values. 110 | pub(super) fn subst(&self, term: &Term) -> Term { 111 | match term { 112 | Variable(_, _) => match self.get(term) { 113 | Some(term) => self.subst(term), 114 | None => term.clone(), 115 | }, 116 | Struct(id, args) => Struct(id.to_string(), self.subst_all(args)), 117 | Rule(head, body) => Rule(Box::new(self.init(head)), self.subst_all(body)), 118 | other => other.clone(), 119 | } 120 | } 121 | 122 | /// Substitute variables with their values. 123 | pub(super) fn subst_all(&self, terms: &[Term]) -> Vec { 124 | terms.iter().map(|term| self.subst(term)).collect() 125 | } 126 | } 127 | 128 | #[cfg(test)] 129 | impl From<[(Term, Term); SIZE]> for Vars { 130 | fn from(value: [(Term, Term); SIZE]) -> Self { 131 | Vars { 132 | map: value.to_vec(), 133 | branch: UNINIT, 134 | } 135 | } 136 | } 137 | -------------------------------------------------------------------------------- /src/types.rs: -------------------------------------------------------------------------------- 1 | use crate::parser::is_operator; 2 | use std::fmt; 3 | 4 | #[derive(Clone, PartialEq)] 5 | pub enum Term { 6 | Number(i32), 7 | Atom(String), // id 8 | Struct(String, Vec), // id(args...), it also is used for lists [1,2|[]] is .(1, .(2, [])) 9 | Nil, // empty list [] 10 | // special forms 11 | Variable(String, usize), // Id 12 | Any, // wildcard _ 13 | Rule(Box, Vec), // head :- body 14 | Question(Vec), // ?- body. 15 | } 16 | 17 | impl fmt::Display for Term { 18 | fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { 19 | use Term::*; 20 | match self { 21 | Any => write!(f, "_"), 22 | Atom(id) => write!(f, "{}", id), 23 | term @ Struct(name, _) if name == "." => { 24 | let (list, last) = list_to_vec(term); 25 | let s = join(&list); 26 | match last { 27 | Some(last) => write!(f, "[{}|{}]", s, last), 28 | None => write!(f, "[{}]", s), 29 | } 30 | } 31 | Struct(op, args) if args.len() == 2 && is_operator(op) => { 32 | if op.chars().any(|c| c.is_alphabetic()) { 33 | write!(f, "{} {} {}", args[0], op, args[1]) 34 | } else { 35 | write!(f, "{}{}{}", args[0], op, args[1]) 36 | } 37 | } 38 | Struct(name, args) => write!(f, "{}({})", name, join(args)), 39 | Variable(id, _) => write!(f, "{}", id), 40 | Number(val) => write!(f, "{}", val), 41 | Nil => write!(f, "[]"), 42 | Rule(head, body) => write!(f, "{} :- {}.", head, join(body)), 43 | Question(body) => write!(f, "?- {}.", join(body)), 44 | } 45 | } 46 | } 47 | 48 | impl fmt::Debug for Term { 49 | fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result { 50 | write!(f, "{}", self) 51 | } 52 | } 53 | 54 | fn list_to_vec(mut term: &Term) -> (Vec, Option) { 55 | use Term::{Nil, Struct}; 56 | 57 | let mut res = Vec::new(); 58 | let mut last = None; 59 | loop { 60 | match term { 61 | Struct(id, args) => { 62 | if id == "." && args.len() == 2 { 63 | res.push(args[0].clone()); 64 | term = &args[1]; 65 | } 66 | } 67 | Nil => break, 68 | other => { 69 | last = Some(other.clone()); 70 | break; 71 | } 72 | } 73 | } 74 | (res, last) 75 | } 76 | 77 | pub(crate) fn join(seq: &[T]) -> String 78 | where 79 | T: fmt::Display, 80 | { 81 | seq.iter() 82 | .map(|t| t.to_string()) 83 | .reduce(|acc, x| format!("{},{}", acc, x)) 84 | .unwrap_or_default() 85 | } 86 | 87 | /// Iterate over dotted pairs (lists). 88 | pub struct ConsIter { 89 | term: Option, 90 | } 91 | 92 | impl From for ConsIter { 93 | fn from(value: Term) -> Self { 94 | Self { term: Some(value) } 95 | } 96 | } 97 | 98 | impl Iterator for ConsIter { 99 | type Item = Term; 100 | 101 | fn next(&mut self) -> Option { 102 | use Term::{Nil, Struct}; 103 | match self.term.clone()? { 104 | Struct(id, args) if args.len() == 2 && id == "." => { 105 | self.term = match &args[1] { 106 | Nil => None, 107 | other => Some(other.clone()), 108 | }; 109 | Some(args[0].clone()) 110 | } 111 | other => { 112 | self.term = None; 113 | Some(other) 114 | } 115 | } 116 | } 117 | } 118 | 119 | #[macro_export] 120 | macro_rules! var { 121 | ( $id:expr ) => { 122 | Variable($id.to_string(), 0) 123 | }; 124 | } 125 | 126 | #[macro_export] 127 | macro_rules! atom { 128 | ( $id:expr ) => { 129 | Atom($id.to_string()) 130 | }; 131 | } 132 | 133 | #[macro_export] 134 | macro_rules! structure { 135 | ( $id:expr , $($x:expr),+ $(,)? ) => { 136 | Struct($id.to_string(), vec![$($x),+]) 137 | }; 138 | } 139 | 140 | #[cfg(test)] 141 | mod tests { 142 | use super::Term::{self, *}; 143 | use test_case::test_case; 144 | 145 | #[test_case( 146 | Number(42), 147 | "42"; 148 | "number" 149 | )] 150 | #[test_case( 151 | atom!("true"), 152 | "true"; 153 | "atom" 154 | )] 155 | #[test_case( 156 | Nil, 157 | "[]"; 158 | "empty list" 159 | )] 160 | #[test_case( 161 | Any, 162 | "_"; 163 | "wildcard" 164 | )] 165 | #[test_case( 166 | var!("Foo"), 167 | "Foo"; 168 | "variable" 169 | )] 170 | #[test_case( 171 | structure!("foo", atom!("a"), Number(-5)), 172 | "foo(a,-5)"; 173 | "simple struct" 174 | )] 175 | #[test_case( 176 | structure!("+", Number(1), structure!("*", Number(2), Number(-5))), 177 | "1+2*-5"; 178 | "operators" 179 | )] 180 | #[test_case( 181 | structure!("is", var!("X"), structure!("+", Number(2), Number(1))), 182 | "X is 2+1"; 183 | "operators with spaces" 184 | )] 185 | fn fmt(input: Term, expected: &str) { 186 | assert_eq!(input.to_string(), expected); 187 | } 188 | 189 | #[test] 190 | fn macros_expansion() { 191 | let tt = [ 192 | (atom!("foo"), Atom("foo".to_string())), 193 | (var!("Bar"), Variable("Bar".to_string(), 0)), 194 | ( 195 | structure!("foo", Number(1)), 196 | Struct("foo".to_string(), vec![Number(1)]), 197 | ), 198 | ( 199 | structure!("bar", Number(1), structure!("foo", Number(2), var!("X"))), 200 | Struct( 201 | "bar".to_string(), 202 | vec![ 203 | Number(1), 204 | Struct( 205 | "foo".to_string(), 206 | vec![Number(2), Variable("X".to_string(), 0)], 207 | ), 208 | ], 209 | ), 210 | ), 211 | ( 212 | structure!(".", Number(1), Nil), 213 | Struct(".".to_string(), vec![Number(1), Nil]), 214 | ), 215 | ]; 216 | for (input, expected) in tt { 217 | assert_eq!(input, expected) 218 | } 219 | } 220 | } 221 | --------------------------------------------------------------------------------