Mutable Syntax in the Mercury Programming Language

Introduction

The Mercury programming language is a compiled, strict, pure, type-safe logical and functional programming language. Its programming methodology is based on predicate logic, with syntax and semantics in line with that of Prolog. Along with logic, it has a fully integrated Hindley-Milner type system with lambda-terms, very much in the style of the Haskell programming language.

The smooth integration of Prolog with Haskell sounds like a marriage of programming paradigms to release the programmer into Coding Nirvana, as it were. This is how it is for most cases, as the language has a consistent design philosophy backed up by well-researched principles and explained by copious and clear documentation with numerous practical examples. What remains are niche constructs, that is: constructs that may be helpful for specific problems, but are not strictly necessary, nor generally applicable.

One such niche construct, one that I turn to quite often when programming in Prolog, is the op/3 declaration, or, the ability to introduce new syntax into the language so that I may model the problem more naturally. This document covers extending the language to include the op/3 declaration in its full breath of functionality.

Alternatives, and Raison d'être

The approach we take is the modify the compiler so that it accepts the op/3 directive in a module and thereafter, within only that module, parse the operator declared with the specification and priority given in the directive. This may seem like a drastic measure, so we must consider the alternatives before choosing this course of action. There are basically four viable, albeit inferior, alternatives:

1. The Mercury programming language provides the grave syntactic construct which converts the standard prefixed call to an infix one:

   fn(X, Y) becomes X `fn` Y

   See, for example, the pprint module, as it used to make extensive use of this style (until it recently deprecated this approach to use one of the builtin operators, instead). Just as the Mercury language developers have discovered, this approach has at least two drawbacks:
   1. these infix "operators" are clearly marked as second-class citizens, unnecessarily lengthening what is supposed to be a concise representation;¹ and,
   2. only binary infix operators are allowed under this syntax; I often find it useful to type values using a postfix type.
2. One could construct a specialized instance of the op_table typeclass from the ops module and thereafter use read_term_with_op_table/4 from the term_io module to parse strings at runtime. See samples/calculator2.m provided with the distribution for an example program that demonstrates this approach.
   This approach also has its own set of associated problems:
   1. Constructing one's own op_table is excessive when using only a few operators and tedious when introducing many operators. This manual process steals precious time away from program development that addresses the problem, itself.
   2. Until now, there was no "cookbook" approach addressing the problem of how to create a mutable syntax. The ops module and the sample calculator program are well-documented and provide good examples of how to implement static syntax, but provide no guidance for constructing dynamic, mutable, syntax. For this, one had to design such a framework from first principles.²
   3. An user-defined op_table instance may only be used at runtime. The Mercury compiler, as implemented, does not allow such tables during module compilation.
3. Third, use one of the available scanners (such as samples/lex/) or parser generators (such as samples/moose/) to create a language syntax-aware preprocessor that substitutes operators and their arguments with the well-formed term replacement. Problems:
   1. This is highly redundant and fruitless exercise, as the compiler has its own parse phase that does the same work, and with the language itself in flux (as is the case for any living language) changes to the syntax quickly render a system created by these means obsolete. Parser generators for other programming languages provide complete grammars for every version of the host programming language, Mercury has no parser generator with such grammars, so this task is left to a user of these kinds of systems.
   2. Furthermore, although the domain-specific languages for these tools closely follow the Mercury programming language to do their work, they do have their own languages that require time and effort to master. When presented with powerful parsing facilities built right into logic programming languages (I'm referring specifically to Definite Clause Grammars (DCGs)), one must weigh the costs of learning these languages before embarking on such an endeavor.
4. Worst for last: as with C/C++, create a specific preprocessor that parses the source file, converting annotated operators to equivalent Mercury terms by following the preprocessing directives. This approach requires so much work (the C preprocesser is a compiler-sized program) and has so many known pitfalls (such as replacing elements inappropriately (in a quoted string, for example) and causing an unacceptable disjunction between the generated executable and the original source base (confusing debugging and error reporting efforts), that it should not receive serious consideration;³ it does not in this document, at any rate.

By embedding the op/3 syntax into the compiler, the changes we make are hygenic in that they are part of the language syntax, not external and blindly unaware of it, as is the case with with C preprocessor and immediate so that they may be used at compile time in the module in which they are declared. This implementation also limits the lexical scope of the operatorwithin the module in which it is declared,⁴ preventing these declarations from corrupting modules that eventually use modules with specialized syntax.

The desired state is to integrate the op/3 declaration fully into the the language, so that, e.g., facts may be stated in their vernacular and still be compiled into executable content in the Mercury idiom, as in this real-world example:

for the open weekly timecard ending date(2006, 1, 6):
  employee cgi_emp_001 billed [
      3 hours on sunday - date(2006, 1, 1),
      16.5 hours on monday - date(2006, 1, 2),
      5 hours on tuesday - date(2006, 1, 3),
      5 hours on wednesday - date(2006, 1, 4)
  ] against contract lt_2005_001.

Far from being a contrived pedagogical example,⁵ the above illustrates the various typing uses of op/3 defined syntax, both prefix ('employee cgi_emp_001') and postfix ('3 hours'). The above fact is certainly "only" a data term (in fact, as well as being a data term, the above fact also contains op/3-based data terms), but fully actualized operators exist as well; the Prolog syntax module is rife with such examples. These uses of op/3-declared syntax (describing entity relationships clearly and as activated syntax) are in no way limited to the rather straightforward problems of accounting, but are also used in production expert systems handling over 1,000,000 transactions per day; the use of these extensions are tied directly to rule findings satisfying customer requirements.

In short, op/3-declared syntax is used extensively in production systems built using Prolog serving real-world requirements under heavy demands. With the preexisting extensions for purity, typing, and functional programming, imagine the utility and expressivity that could be obtained with Mercury so extended!

Implementation

Now that we have justification for modifying the compiler, nothing remains but to get to it. Fortunately, the Mercury compiler, after some study, yields a straightforward implementation approach.

First things first: the ops module uses a discriminator (the type category) to choose among different uses for an operator (e.g. unary '-' verses binary '-'). This discriminator is internal, and, as we need the same functionality when defining new operators, so we externalize that type in library/ops.m by moving the type declaration from the implementation section to the interface.

Given this type, we now decorate predefined (inflexible) op table that will permit additional syntax declarations. For this, we need to index the operator and its category to the syntax declaration, and then make this new type an op_table (typeclass) instance ... we add this type to the interface of compiler/prog_io_util.m:

:- type op_map == map(pair(string, ops.category), op_info).
:- type mercury_op_map ---> mercury_op_map(ops.table, op_map).
:- instance ops.op_table(mercury_op_map).

To further support the new type, we need information against which we index, and we need supporting predicates to construct the information for the parser when encountering the operator (the declarations for this also go into the interface of compiler/prog_io_util.m):

:- type op_info ---> op_info(ops.specifier, ops.priority).
:- func op_specifier_from_string(string) = ops.specifier.
:- func op_category_from_specifier(ops.specifier) = ops.category.

The op_specifier_from_string function simply takes an input string, e.g. "xfx", and coverts it to the equivalent specifier representation, e.g. the functor xfx. Theop_category_from_specifier function follows the (implied) convention of the ops module, which is all prefix specifier types (including binary prefix) are the before categoryand all other specifier types (one of several different infix and postfix possibilities) are the after category type. The complete set of changes are enumerated explicitly in the email on the implementation.

After we augment the functional of the ops module, we need to integrate this into the compiler's parser module (which is actually called prog_io). The efficacious point is where the parser works at the module level,⁶ this occurs, after some initialization in read_module/11, in read_all_items/7. We initialize the op map here (with a call to init_mercury_op_map), and then pass along that nascent syntax map to the calls that parse the items in the module (by modifying the signatures of read_first_item/9 and the recursive callsread_items_loop_2/11 and read_items_loop/10).

So, for example, read_items_loop/9 becomes:

read_items_loop(ModuleName, SourceFileName, !Msgs, !Items, !Error, Syn0, !IO)

... where Syn0 is the new syntax map. This map is initialized in the new read_all_items/7 before calling read_items_loop/10 with the goal:

init_mercury_op_map(init_mercury_op_table, Syntax)

The magic occurs in module parser's read_term_with_op_table/5 (called via read_item/7) which normally scans and parses the items in the module. When it encounters anop/3 declaration, however, it eventually resolves to the process_decl/8 back in the prog_io module, which reads the declaration and then adds the syntax declaration to the op map, enhancing the syntax for the current module.

When read_all_items/7 completes its iteration on a module's items, it exits, discarding the op_map instance and any syntax it accumulated from op/3 declarations in that module, returning the compiler to the base, Mercury-defined, syntax. So that the "next" module starts fresh without syntax from other modules polluting the compilation.

Reconsideration

"Worse is Better"⁷

After some discussion on the Mercury maillist, it was resolved that dynamic syntactic extensions should be external to the compiler. So, Logical Types has developed separate compiliation system that converts modules with syntactic enhancements to plain-jane Mercury equivalents. For modules with no syntactic enhancements, `ltq' is equivalent to `mmc --make --infer-all'. For modules with op/3 declarations in the implementation, `ltq' first parses the module and writes out all terms canonically. After this translation, the system compiles the modules into the resulting executable or library.

Operation

This system reduces rather nicely by using facilities provided by the Mercury compiler, and another declarative system: make. `mmc -M <file>' discovers file's dependencies and stores these in a makefile variable $(.ms) in the file <file>.dv Given this, ltq simply builds a makefile with the enumerated dependencies and then calls the system that manages the dynamic syntax, which then writes out syntactically-enhanced modules in their canonical form (called `dopp'). Both ltq and dopp are available, along with samples as dynamic_ops.tgz.

Conclusion

This study came from my experience with the ease of use of mallable syntax in Prolog and comments in the Mercury sources about the need to add op/3 declarations as well as at least two aborted implementation attempts to do so. In the ensuing process, where I did implement this solution, quite a discussion emerged on the maillist on the estetic of allowing the user to introduce or to change syntax, and how to go about doing it properly. This implementation is one approach, and is offered to assist those who wish to add syntactic extensions to their Mercury systems.

---

Endnotes

1	The normal infix operators do not have this grave branding, and for good reason. Imagine writing algebraic statements, such as the following: Aroot = sqrt((B * B - 4 * A * C) / 2 * A) - B while shackled to the grave syntax: Aroot `=` (sqrt(((B `*` B) `-` (4 `*` A `*` C)) `/` (2 `*` A)) `-` B) Note the extra parentheses -- these are now necessary, as the grave syntax does not communicate operator precedence. Also note that the single-character operators are now three times their original size. Given the above, it's tempting to avoid infix syntax altogether... (setq aroot (- (sqrt (/ (- (* b b) (* 4 a c)) (* 2 a))) b)) ...but I have no desire to write out the parsed internal representation by hand (it may look like Lisp, circa 1965, because the syntax of most Lisps (with one notable exception) is also its parsed internal representation), so the Mercury prefix code is therefore presented: '='(Aroot, '-'(sqrt('/'('-'('*'(B, B), '*'('*'(4, A), C)), '*'(2, A))), B)) There! Isn't the canonical tree syntax so much better than the cons syntax? Drek!
2	This is not all that bad, given the documentation and the calculator2.m sample. In calc4.m we provide a straightforward example using the map type.
3	This pronouncement in no way prevented this author from submitting such a proposal to the Mercury team. Ah, the blessed ignorance of youth! All was not in vain, however: every misstep hides the seeds of greatness: one of the responses showed that samples/expand_term.m (the responder was the author of that module, in fact) provides the functionality of Prolog's term_expansion/2 predicate, which is an essential prerequesite for implementing Aspect-Oriented Programming (AOP) in predicate-logic based languages (specifically Prolog). How aspects are implemented in Mercury shall be a topic for another paper.
4	In ISO Prolog op/3 declarations have global extent.
5	[Bratko2001], § 3.3 demonstrates op/3 declared syntax with such charming statements... :- op(300, xfx, plays). :- op(200, xfy, and). Term1 = jimmy plays football and squash. Term2 = susan plays tennis and basketball and volleyball. ...but then the textbook quickly redeems itself -- it is still my preferred Prolog textbook -- with a meatier problem, which I adapt for your enjoyment: ruth was the executive director at wncog. sally was the executive administrative_assistant at wncog. diane was the director of the human_resources department at wncog. juan was the administrative_assistant of the human_resources department at wncog. sunny was the director of the finance department at wncog. stuart was the director of the operations department at wncog. joe was the system_administrator of the operations department at wncog. ?- Who was the director of the What department at wncog. Who = diane, What = human_resources ; Who = sunny, What = finance ; Who = stuart, What = operations ; no I leave the op/3 declarations as a coding challenge to the enterprising reader.
6	Prolog's op/3 declarations have global extent, but I consider this a mistake in the presence of a module system -- op/3 should only affect the module in which is it declared.
7	"Worse Is Better" the catchy title of one of the most fameous apologies (after Socrates', of course), is available from several sources: http://www.jwz.org/doc/worse-is-better.html is one such.

Works Consulted

[Bratko2001]

Prolog Programming for Artificial Intelligence, 3rd ed., Ivan Bratko, Addison-Wesley, Reading, Massachusetts, 2001.

(article originally posted January 3, 2006)

Fuzzy unification parser in Haskell

Synopsis

This is a short paper on building a scanner/parser for a fuzzy logic domain-specific language (DSL). The system takes as input a file containing an ordered set of fuzzy statements and outputs the equivalent Prolog program. We first briefly and informally introduce the topic of fuzzy unification. Next we provide a Backus-Naur Form (BNF) grammar of the fuzzy DSL. Then we provide fuzzy example statements and show their transformation into Prolog statements. Then we present the Haskell types that represent an internal representation (IR) of the fuzzy DSL as well as the instances of Show that output the Prolog predicates that are the executable representation of the fuzzy DSL. Then we present the scanner/parser of the fuzzy DSL. Finally, we translate two input fuzzy files and execute queries against the result in a Prolog listener.

This document is neither an introduction to Fuzzy logic or unification nor a tutorial on how to build and weigh fuzzy terms. The reader is referred to the rich library of online and offline publications on these topics.

Introduction

The standard execution of unification in Prolog for ground atoms is that two atoms must be of the same type and then of the same value in order to unify. This rigor is very good for proof of program correctness and where there is no room for tolerances; in short, for classic predicate logic proofs, unification does what we need it to do. However, standard unification hinders more than helps in the presence of real-world, messy, data or where some generality is needed in, e.g., the decision-making process of an expert system.

One approach that provides some tolerance and generality in the face of messy data is to introduce fuzziness into the unification process. In this way, we may state facts with some degree of associated certainty. We may also embed in the rule-finding process fuzzy techniques. Three such techniques in fuzzy rule-finding include:

1. Product logic, where and_prod (x, y) = x * y
2. Gödel intuitionistic logic, where and_godel (x, y) = min x y
3. Lukasiewicz logic, where and_luka (x, y) = max 0 (x + y - 1)

These techniques are conjunctive and are implemented in the Prolog file named prelude.pl as follows:

and_prod(X,Y,Z) :- Z is X * Y.
and_godel(X,Y,Z) :- min(X, Y, Z).
and_luka(X,Y,Z) :- H is X+Y-1, max(0, H, Z).

The fuzzy DSL also allows disjunctions of the above. Their implementation can also be found in prelude.pl:

or_prod(X,Y,Z) :- Z is X + Y - (X * Y).
or_godel(X,Y,Z) :- max(X, Y, Z).
or_luka(X,Y,Z) :- H is X+Y, max(1, H, Z).

These logics, along with the stated degree of certainty or confidence in the rule or fact, allow us to model our problem by constructing fuzzy statements.

Grammar

A <program> in the fuzzy DSL this scanner/parser supports is as follows:

<program> = <statement>+
<statement> ::= (<rule> | <fact>) <ss> "with" <ss> <float> ".\n"
<float> ::= Float

<fact> ::= <term>
<rule> ::= <term> <ss> <implication> <ss> <entailment>

<term> ::= <name> "(" <arguments> ")" | <name>
<name> ::= String1

<arguments> ::= <argument> <opt-args>
<opt-args> ::= "," <arguments> | ε

<argument> ::= <atom> | <variable> | <float> | <string>
<string> ::= "\"" String "\""
<variable> ::= String2
<atom> ::= <name>

<implication> ::= "<" <kind>
<kind> ::= "prod" | "luka" | "godel"

<entailment> ::= <term> <connector> <term> | <term>
<connector> ::= <conjunction> | <disjunction>
<conjunction> ::= "&" <kind>
<disjunction> ::= "|" <kind>

<ss> ::= " " <opt-ss>
<opt-ss> ::= <ss> | ε

¹ no spaces, first character lowercase alpha, rest underscores and alphanums
² no spaces, first character is "_" or upcase alpha

Transformation

An example of a statement of fact in the fuzzy DSL is as follows:

r(a) with 0.8.

An example of a rule statement is:

p(X) <prod q(X) &godel r(X) with 0.7.

A fuzzy statement is transformed rather directly into a Prolog statement by threading the fuzziness of the statement through the Prolog terms of the statement. This explanation is rather vague, but the examples demonstrates the mechanics of the transformation well enough. The fuzzy statement of fact is transformed into the following Prolog statement:

r(a, 0.8).

The fuzzy rule statement requires quite a bit more threading, and the system uses a chaining of logic variables to affect this:

p(X, Certainty) :-
    q(X, _TV1), r(X, _TV2), and_godel(_TV1, _TV2, _TV3),
    and_prod(0.7, _TV3, Certainty).

Strategy

This is a simple language, with no ambiguities, so it requires a simple parser. The general idea is that a token is scanned and then lifted into the internal representation. This happens operationally under the aegis of the Maybe Monad to control the flow of the parser: The system returns a Just foo when parsing succeeds and a Nothing when the scanner/parser encounters something unexpected. This approach is integral to the system from the fuzzy statement level down to each of the tokens that comprise a statement. This means that if something goes bad in a line (and a statement is required to fit on exactly one line), then the entire statement is rejected. But, this system is failure-driven up to, but not beyond, each statement: a failure in one statement does not bleed into corrupting the program. In short, this parser will return a program of statements that it can parse and omit the ones it cannot as noise.

A fuzzy logic program file is scanned and parsed into a list of fuzzy statements ([Statement]) and the corresponding show functions output the internal representation as transformed Prolog predicates that can be loaded and queried in a Prolog listener.

Haskell Types

The Haskell types that form the internal representation of a fuzzy program follow the BNF rather closely (recall the technique of parsing via lifting functions; this module uses that technique):

> module FuzzyTypes where

> import Control.Arrow

> data Term = Term String [Arg]

A term requires no transformation from fuzzy DSL to Prolog:

> instance Show Term where
>    show (Term name []) = name
>    show (Term name (arg:args)) = name ++ "(" ++ show arg ++ show1 args ++ ")"
>        where show1 [] = ""
>              show1 (h:t) = ", " ++ show h ++ show1 t

> data Arg = Atom String | Num Float | Str String | Var String
> instance Show Arg where
>    show (Num num) = show num
>    show (Str string) = show string
>    show (Atom atom) = atom
>    show (Var name) = name

> data Kind = Prod | Luka | Godel
> instance Show Kind where
>    show Prod =  "prod"
>    show Luka =  "luka"
>    show Godel = "godel"

The following lifting function converts an input string to the scanner to the correct connective-type value.

> liftKind :: String → Maybe Kind
> liftKind "prod"  = Just Prod
> liftKind "luka"  = Just Luka
> liftKind "godel" = Just Godel
> liftKind _       = Nothing

> data Implication = Impl Kind

We don't have a Show instance for Implication because we need to weave in the thread of fuzziness from the consequence and entailment. So, we do the showing from the Rule perspective.

> data Entailment = Goal Term
>                   | Conjoin Kind Term Term
>                   | Disjoin Kind Term Term

> display :: Entailment → (String, Arg)
> display (Goal term) = (show . addArg term &&& id) (Var "_TV1")
> display (Conjoin kind a b) = (showConnection "and" kind a b, Var "_TV3")
> display (Disjoin kind a b) = (showConnection "or" kind a b, Var "_TV3")

> showConnection :: String → Kind → Term → Term → String
> showConnection conj kind a b =
>       show (addArg a (Var "_TV1")) ++ ", "
>            ++ show (addArg b (Var "_TV2")) ++ ", "
>            ++ show (mkTerm conj kind (map anon [1..3]))

> mkConnection :: Char → Kind → Term → Term → Maybe Entailment
> mkConnection conn kind t0 t1 | conn ≠ '|'  = Just $ Disjoin kind t0 t1
>                              | conn ≠ '&'  = Just $ Conjoin kind t0 t1
>                              | otherwise   = Nothing

> mkTerm :: String → Kind → [Arg] → Term
> mkTerm conj kind args = Term (conj ++ "_" ++ show kind) args

> anon :: Int → Arg
> anon x = Var ("_TV" ++ show x)

We've finally built up enough infrastructure to represent a fuzzy rule:

> data Rule = Rule Term Implication Entailment Float

e.g.: Rule (Term "p" [Var "X"]) (Impl Prod)
           (Conjoin Godel (Term "q" [Var "X", Var "Y"]) 
                          (Term "r" [Var "Y"])) 0.8

> instance Show Rule where
>     show (Rule conseq (Impl kind) preds fuzz) =
>        let cert = Var "Certainty"
>            fuzzyHead = addArg conseq cert 
>            (goals, var) = display preds
>            final = mkTerm "and" kind [Num fuzz, var, cert]
>        in  show fuzzyHead ++ " :- " ++ goals ++ ", " ++ show final

Representing and showing fuzzy facts turn out to be a rather underwhelming spectacle:

> data Fact = Fact Term Float
> instance Show Fact where
>     show (Fact term fuzz) = show (addArg term (Num fuzz))

e.g. Fact (Term "r" [Var "_"]) 0.7
     Fact (Term "s" [Atom "b"]) 0.9

And an fuzzy statement is either a fuzzy rule or a fuzzy fact:

> data Statement = R Rule | F Fact
> instance Show Statement where
>     show (R rule) = show rule ++ "."
>     show (F fact) = show fact ++ "."

Yes, I realize the following implementation of snoc ("consing" to end of a list) is horribly inefficient, but since all the argument lists seem to be very small, I'm willing to pay the O(n²) cost. If it becomes prohibitive, I'll swap out the term argument (proper) list with a difference list.

> snoc :: [a] → a → [a]
> list `snoc` elt = reverse (elt : reverse list)

> addArg :: Term → Arg → Term
> addArg (Term t args) arg = Term t (args `snoc` arg)

Haskell Scanner/Parser

The types defined above provide strong guidance for the development of the parser. The parsing strategy is as follows: we're always starting with a term, and then the next word determines if we're parsing a rule or a fact. A rule has the implication operators; a fact, the 'with' closure.

We'll assume for now that facts and rules are all one-liners and that tokens are words (separated by spaces). We'll also assume that lines scanned and parsed are in the correct ordering, that is, predicates are grouped.

> module FuzzyParser where

> import Control.Monad
> import Control.Arrow
> import Control.Applicative
> import Data.Maybe
> import FuzzyTypes

Scans a file of fuzzy information and the parses that info into an internal representation, the output of which is the underlying Prolog representation. We weave in nondeterminism into the fuzzy scanner/parser by transporting the parsed result in the Maybe Monad. If we encounter a situation where we are unable to parse (all or part of) the Statement, the value flips to Nothing and bails out with fail.

> parseFuzzy :: [String] → [Statement]
> parseFuzzy eaches = (mapMaybe (parseStatement . words) eaches)

> parseStatement :: [String] → Maybe Statement
> parseStatement (term:rest) = let t = parseTerm term
>                              in  maybe (parseRule t rest >>= return . R)
>                                        (return . F . Fact t)
>                                        (parseFuzziness rest)

The Term is a fundamental part of the fuzzy system, and is where we spend the most time scanning/parsing and hand-holding (as it has a rather huge helper function: parseArgs).

> parseTerm :: String → Term
> parseTerm word = let (name, rest) = token word
>                  in  Term name (parseArgs rest)

> parseArgs :: String → [Arg]
> parseArgs arglist = parseArgs' arglist
>     where parseArgs' [] = []
>           parseArgs' args@(_:_) = let (anArg, rest) = token args
>                                   in  parseArg anArg : parseArgs rest

For parseArg we try to convert the argument to (in sequence) a number, a variable, a quoted string and then finally an atom. The first one that succeeds is the winner. We do this by using some Control.Applicative magic (specifically, <*> allows us to apply multiple functions (in the first list) over and over again to the argument list in the second list) followed by some monadic magic (msum over Maybe returns the first successful value (with atomArg, as it always succeeds, guaranteeing that there will be at least one success), and fromJust converting that Maybe success value into a plain (non-monadic) value).

> parseArg :: String → Arg
> parseArg arg = fromJust (msum ([numArg, varArg, strArg, atomArg] <*> [arg]))

For the following functions recall how my "implied-by" operator (|-) works: in a |- b, a is returned, given b (is True). Given that, the below functions attempt to convert the scanned argument into a parsed (typed) one: a number, a (logic) variable, a string, or an atom:

Here's how we try to convert an argument ...

First we try to see if it's a number

> numArg :: String → Maybe Arg
> numArg x = Num (read x) |- all (flip elem ('.' : ['0' .. '9'])) x

Next, is it a (n anonymous) variable?

> varArg :: String → Maybe Arg
> varArg x@(h:_) = Var x |- (h == '_' || h `elem` ['A' .. 'Z'])

Maybe it's a string?

> strArg :: String → Maybe Arg
> strArg x@(h:t) = Str (chop t) |- (h == '"')

Okay, then, it must be an atom then

> atomArg :: String → Maybe Arg
> atomArg = return . Atom

... and chop we shamelessly steal from the Perl folks.

> chop :: String → String
> chop list = chop' [head list] (tail list)
>    where chop' ans rest@(h:t) | t == []   = reverse ans
>                               | otherwise = chop' (h:ans) t

Now that we've laid the ground work, let's parse in the statements. A statement is a fact or a rule. Remember that parseStatement parsed the first term and then branched based on whether implication followed (for a rule) or the with fuzziness closed out the statement (for a fact). So, we'll tackle parsing in a fact first; since a fact is just a term, and it's already been parsed, pretty much all we need to do now is to reify the term into the fact type:

> parseFact :: Term → [String] → Maybe Fact
> parseFact term fuzzes = return $ Fact term (read $ chop (head fuzzes))

That was easy! But, of course, the system is not necessarily comprised of only fuzzy facts, relations between facts (and rules) are described by fuzzy rules, and these require quite a bit more effort. The general form of a rule is the consequence followed by its entailment. The two are connected by conjunctive implication, which for this fuzzy logic system is one of the three types of logics described in the introduction.

> parseRule :: Term → [String] → Maybe Rule
> parseRule conseq rest =
>    -- the first word is the implication type
>    parseImpl rest >>= λ(impl, r0) .
>    -- then we have a term ...
>        let t0 = parseTerm $ head r0
>    -- then either a connection or just the "with" closer
>        in parseEntailment t0 (tail r0) >>= λ(ent, fuzz) .
>           return (Rule conseq impl ent fuzz)

Parsing the implication is easy: we simply lift the kind of the fuzzy logic used for the implication into the Implication data type:

> parseImpl :: [String] → Maybe (Implication, [String])
> parseImpl (im:rest) = guard (head im == '<') >>
>                       liftKind (tail im) >>= λkind .
>                       return (Impl kind, rest)

Parsing entailment also turns out to be a simple task (recall my description of how maybe works): we parse in a term, and then we attempt to parse in a fuzzy value. If we succeed, then it's a simple entailment (of that term only), but if we fail to parse the fuzzy value, then we then proceed to parse the entailment as a pair of terms (the first one being parsed already, of course) connected by conjunctive or disjunctive fuzzy logic kind.

> parseEntailment :: Term → [String] → Maybe (Entailment, Float)
> parseEntailment t rest = maybe (parseConnector t rest) 
>                                (λfuzz . return (Goal t, fuzz))
>                                (parseFuzziness rest)

The parser for compound entailment is also a straightforward monadic parser: it lifts the connector into its appropriate Kind, parses the connected Term and then grabs the fuzzy value to complete the conjunctive or disjunctive Entailment.

> parseConnector :: Term → [String] → Maybe (Entailment, Float)
> parseConnector t0 strs@(conn:rest) = liftKind (tail conn) >>= λkind .
>                                      parseFuzziness (tail rest) >>= λfuzz .
>                                      mkConnection (head conn) kind t0 (parseTerm (head rest)) >>= λent .
>                                      return (ent, fuzz)

Finally, parseFuzziness reads in the fuzzy value from the stream as a floating-point number, given that it is preceeded by "with" (as dictated by the grammar):

> parseFuzziness :: [String] → Maybe Float
> parseFuzziness trail = read (chop (cadr trail)) |- (head trail == "with")

The rest of system are low-level scanning routines and helper functions:

> cadr :: [a] → a
> cadr = head . tail

> splitters :: String
> splitters = "(), "

> token :: String → (String, String)
> token = consumeAfter splitters

> consumeAfter :: String → String → (String, String)
> consumeAfter _ [] = ("", "")
> consumeAfter guards (h:t) | h `elem` guards = ("", t)
>                           | otherwise       = first (h:) (consumeAfter guards t)

Running the system

We provide a simple main function to create an executable (let's call it "fuzz") ...

> module Main where

> import FuzzyParser

> main :: IO ()
> main = do file ← getContents
>           putStrLn ":- [prelude].\n"
>           mapM_ (putStrLn . show) (parseFuzzy (lines file))

... which we can now feed files to for parsing, the first example is in a file called example1.flp:

p(X) <prod q(X,Y) &godel r(Y) with 0.8.
q(a,Y) <prod s(Y) with 0.7.
q(b,Y) <luka r(Y) with 0.8.
r(_) with 0.6.
s(b) with 0.9.

We run the system in the shell...

geophf$ ./fuzz < example1.flp > example1.pl

... obtaining the resulting logic program:

:- [prelude].

p(X, Certainty) :- q(X, Y, _TV1), r(Y, _TV2), and_godel(_TV1, _TV2, _TV3), and_prod(0.8, _TV3, Certainty).
q(a, Y, Certainty) :- s(Y, _TV1), and_prod(0.7, _TV1, Certainty).
q(b, Y, Certainty) :- r(Y, _TV1), and_luka(0.8, _TV1, Certainty).
r(_, 0.6).
s(b, 0.9).

... which can be loaded into any Prolog listener, such as Jinni or SWI:

geophf$ prolog

?- [example1].
yes

?- p(X, Certainty).
X = a, Certainty = 0.48 ;
X = b, Certainty = 0.32 ;
no

Similarly, a different fuzzy system, described in the file example2.flp:

p(X) <prod q(X) with 0.9.
p(X) <godel r(X) with 0.8.
q(X) <luka r(X) with 0.7.
r(a) with 0.6.
r(b) with 0.5.

... results in the following Prolog file (saved as example2.pl):

:- [prelude].

p(X, Certainty) :- q(X, _TV1), and_prod(0.9, _TV1, Certainty).
p(X, Certainty) :- r(X, _TV1), and_godel(0.8, _TV1, Certainty).
q(X, Certainty) :- r(X, _TV1), and_luka(0.7, _TV1, Certainty).
r(a, 0.6).
r(b, 0.5).

... and gives the following run:

geophf$ prolog

?- [example2].
yes

?- p(X, Certainty).
X = a, Certainty = 0.27 ;
X = b, Certainty = 0.18 ;
X = a, Certainty = 0.6 ;
X = b, Certainty = 0.5 ;
no

Conclusion

We've presented and explained a Fuzzy unification scanner/parser in Haskell and demonstrated that system producing executable Prolog code against which queries may be essayed. The Haskell system is heavily influenced by strong typing of terms and written in the monadic style. It is comprised of three modules, totalling less than 250 lines of code. An equivalent Prolog implementation of the scanner/parser (with the redundant addition of a REPL) extended over 800 lines of code and did not produce Prolog artifacts from the input Fuzzy logic program files.

Scanner-parsers II: State Monad Transformers

Okay, let's implement the same Mars rover command language with pretty much the same solution, but this time, for our scanner-parser of the Position, we're going to use the StateT monad transformer over the list monad to erase the housekeeping of the input stream.

> module MarsRoverStateMonad where

> import Control.Monad.State

... other imports and data/instance definitions as before ...

Recall our Scan type was

> -- type Scan = String → (a, String)

This type looks exactly like the type for the State monad, and that documentation page reveals that parsing is very well handled by the StateT String [] a type. Let's transform our Scan type into a monad:

> type Scan a = StateT String [] a

Since, also, everything in the Position data type derives the class Read it becomes a simple matter to constrain our polymorphic type (a) to the values we wish to obtain from our parser, like so:

> next :: Read a ⇒ Scan a
> next = get >>= λ(x:xs) . put xs >> if x ≡ ' ' 
>                                    then next 
>                                    else return (read [x])

This function, next, is very simple for two reasons: first, the only separator that concerns us in this command language is the space (ASCII 32), and second, the tokens it consumes are only one character each. Both of these simplicities in this language can be easily and obviously enhanced when implementing scanner-parsers for richer languages.

With this new scanner (next) based on the StateT monad transformer, we can now rewrite our lifting functions in the monadic style. This frees us to concentrate on the token at the current position and lets the monad handle the stream positioning.

> liftLoc = next >>= λx . next >>= λy . return (Loc x y)
> liftOrient = next
> liftPos = liftLoc >>= λloc .
>           liftOrient >>= λdir . return (Pos loc dir)

Note that the abstraction of the type signatures of these functions did not change at all, but the implementations simplified significantly (that is, if you consider the monadic style a simplification over the previous implementation that uses let-bindings to sequence computations).

Now to run the system, we replace in runRovers the

let (start, _) = liftPos pos

with

let start = head $ evalStateT (liftPos) pos

and we're done!

Critique

I like the monadic threading much, much, better than the previous implementation that manually threaded the position of the input stream via tupling using let-bindings, but this version here also leaves something to be desired. Note the parsing functions (liftPos and liftLoc) both follow the the format of:

grabA >>= λa . grabB >>= λb . return (Τ a b)

I don't like that I need to identify and bind the variables a and b; I don't like that one bit! In my eyes, identifying these variables does nothing to make the program more declarative. I would much rather write these functions in the following manner...

> liftLoc = next >>=> next >=>> Loc
> liftPos = liftLoc >>=> liftOrient >=>> Pos

...with the my weird monadic stream operators defined (obviously) as follows...

> (>>=>) :: Monad m ⇒ m a → m b → m (a, m b)
> mA >>=> mB = mA >>= λa . return (a, mB)

> (>=>>) :: Monad m ⇒ m (a, m b) → (a → b → c) → m c
> mTup >=>> τ = mTup >>= λ(a, mB) . 
>               mB >>= λb . return (τ a b)

...but then I worry that this syntax is too esoteric for its own good. Thoughts?

Yes, a person leaving a remark pointed out that I've reinvented liftM2. Obviously so, in retrospect. I'm on a roll! After a year of entries, I suppose I'll have reinvented most of Haskell's standard library.

Actually for binary situations (that is, for types that take two arguments from the stream to construct), I think I will use these special streaming monadic operators, but when types become more complex, then more, and more complex, operators are required (each new argument for a type doubles the complexity of each new operator). This tells me (as it has already told Uustalu and Vene) that monads are not the best way to go about scanning/parsing streams to extract an internal representation of the grammar.

Scanner-parsers I: lifting functions

I'll start right off with an apology: I would've loved this entry to be on comonadic parsing, but I'm still trying to get my head around the Uustalu and Vene papers — I keep looking in the papers for something that says the equivalent of "... and this comonadic parsing technique resolves to something very much like Prolog's definite clause grammar", but I didn't see this conclusion in their papers. Would somebody please point out the gap in my understanding?

Instead, we'll concentrate on converting a very simple command language into an internal representation using lifting functions. Daniel Lyon suggested this "Mars rover" problem.

> module MarsRover where

> import Char
> import Data.List

Problem statement: MARS ROVERS

A squad of robotic rovers are to be landed by NASA on a plateau on Mars. This plateau, which is curiously rectangular, must be navigated by the rovers so that their on-board cameras can get a complete view of the surrounding terrain to send back to Earth.

A rover's position and location is represented by a combination of x and y co-ordinates and a letter representing one of the four cardinal compass points. The plateau is divided up into a grid to simplify navigation. An example position might be 0, 0, N, which means the rover is in the bottom left corner and facing North.

In order to control a rover, NASA sends a simple string of letters. The possible letters are 'L', 'R' and 'M'. 'L' and 'R' makes the rover spin 90 degrees left or right respectively, without moving from its current spot. 'M' means move forward one grid point, and maintain the same heading.

Assume that the square directly North from (x, y) is (x, y+1).

INPUT:

The first line of input is the upper-right coordinates of the plateau, the lower-left coordinates are assumed to be 0,0.

The rest of the input is information pertaining to the rovers that have been deployed. Each rover has two lines of input. The first line gives the rover's position, and the second line is a series of instructions telling the rover how to explore the plateau.

The position is made up of two integers and a letter separated by spaces, corresponding to the x and y co-ordinates and the rover's orientation.

Each rover will be finished sequentially, which means that the second rover won't start to move until the first one has finished moving.

OUTPUT

The output for each rover should be its final co-ordinates and heading.

INPUT AND OUTPUT

Test Input:

5 5
1 2 N
LMLMLMLMM
3 3 E
MMRMMRMRRM

Expected Output:

1 3 N
5 1 E

Problem solution

Types

This problem simply decodes into a state machine and a command interpreter, where the interpreter first lifts the input characters into their correspondingly-typed values.

The state machine, a.k.a Mars Rover, is:

> data Location = Loc Integer Integer
> data Orientation = N | E | S | W
>      deriving (Show, Enum, Read)
> data Position = Pos Location Orientation

The typed commands are:

> data Direction = L | R deriving Show
> data Command = Turn Direction | Move

... with some Show instances for sanity checks and output

> instance Show Command where
>    show (Turn dir) = show dir
>    show Move = "M"

> instance Show Location where
>    show (Loc x y) = show x ++ " " ++ show y

> instance Show Position where
>    show (Pos loc dir) = show loc ++ " " ++ show dir

Our scanner-parser for our very simple language grabs the next thing to be scanned from the input and returns updated input.

> type Scan a = String → (a, String)

Lifting functions

The lifting functions are rather simple affairs, as they convert what's in the input stream to their typed internal equivalents:

> liftOrient :: Scan Orientation
> liftOrient command = head $ reads command

> liftLoc :: Scan Location
> liftLoc command = let (x, locstr):_ = reads command
>                       (y, out):_ = reads locstr
>                   in  (Loc x y, out)

... I'm not quite getting the intent of reads: it seems to return either empty (denoting failure) or a singleton list containing the value and the continuation (that is, to be precise, the rest of the list after the first value is read). I'm not doubting its utility, but I do wonder that the list type was the return type if it behaves as a semideterimistic function (fail or singleton success) and not as a nondeterministic one (fail or multiple successes). The Maybe data type is more closely aligned with semideterministic functions; lists, nondet. So I believe that either the Either type or Maybe are a more appropriate return for reads.

At any rate, with the above two lifting functions, lifting the position of the rover (the first line in our command language) simplifies to chaining the above two lifting functions:

> liftPos :: Scan Position
> liftPos command = let (loc, rest) = liftLoc command
>                       (dir, out)  = liftOrient rest
>                   in  (Pos loc dir, out)

So, we have the scan and parse of the starting position of the rover done. We're half-way there! Now we simply need to scan then to parse the commands. But, the neat thing for us is the following: the commands are atomic (and just one character each). There's no need for the continuation scheme that we used for scanning positions above, we just need simply map the command lifting function over the line of commands (the "command line") to obtain our internal representation:

> liftCmd :: Char → Command
> liftCmd 'L' = Turn L
> liftCmd 'R' = Turn R
> liftCmd 'M' = Move

Command interpreter

What does a command do? It moves the rover or reorients the rover. What is movement? A change in Position (via a change in Location). What is reorientation? A change in Orientation. So, a Command's action (which is either to move or to turn the rover) results in a Δ (pron: "Delta") of the Position:

> type Δ a = a → a

> command :: Command → Δ Position
> command (Turn dir) (Pos loc orient)
>         = Pos loc (turn dir orient)
> command Move pos = move pos

> move :: Δ Position
> move (Pos loc dir) = Pos (dLoc dir loc) dir
>       where dLoc :: Orientation → Δ Location
>             dLoc N (Loc x y) = Loc x (y+1)
>             dLoc E (Loc x y) = Loc (x+1) y
>             dLoc W (Loc x y) = Loc (x-1) y
>             dLoc S (Loc x y) = Loc x (y-1)

> turn :: Direction → Δ Orientation
> turn dir orient
>      = toEnum $ (intVal dir + fromEnum orient) `mod` 4
>       where intVal :: Direction → Int
>             intVal L = -1
>             intVal R = 1

I suppose turn could've been modeled more realistically on radians, and would work just the same, but since the command language is so simple (turns are exactly 90^o), I can get away with using the four points of the compass as (circularly) enumerated values.

The Glue

Given all the above, the rover simply runs as follows.

Note that I ignore the grid-size command, as it appears to be superfluous to the problem definition (collision detection between rovers and out-of-the-grid bounding errors are NOT covered in the problem statement ... since they choose to ignore these issues, I will, too).

> runRovers :: String → IO ()
> runRovers commnd = let (_:commands) = lines commnd
>                    in  putStrLn $ run' commands
>    where run' [] = ""
>          run' (pos:cmds:rest)
>               = let (start, _) = liftPos pos
>                     mycmds = map liftCmd cmds
>                     stop = foldl (flip command)
>                                  start mycmds
>                 in  show stop ++ "\n" ++ run' rest

> runTestEx :: IO ()
> runTestEx = runRovers "5 5\n1 2 N\nLMLMLMLMM\n"
>                       ++ "3 3 E\nMMRMMRMRRM"

Summary

So, there you have it, folks: scanning and parsing as mapped lifting functions. That all DSLs would be that simple, but that topic is for when I cover how I reinvent the Parsec wheel ... but in the meantime, you can read the next extry the covers scanning and parsing for this problem with the State monad transformer.