Operator parser in guile-log

[Stefan Israelsson Tampe]

Hi all,

One of the peculiarities of prolog is it's ability to redefine it's
parsing operators. prolog code is really basically one expression
and a configurable operator parser id let loose on it. In a paper 
referenced in previous mail they describe the parser implemented in
prolog and I ported and tested it just now on guile-log. It's a fun
exercise and it helps in understanding how well the guile-log framework
work. So, to show it off, let's construct a little calculator 
parser.

The operators are in precedence groups

  postfix application "(expr)"

  prefix -

  binary *
  binary /

  binary +
  binary -

  binary =

  binary ,

atoms are:
   C-identifiers and integers.

The requisite to make it work is the following,

  (use-modules (ice-9 match))
  (use-modules (ice-9 pretty-print))
  (use-modules (logic guile-log))
  (use-modules (logic guile-log parser))
  (use-modules (logic guile-log parsing operator-parser))

We will use p-term as the expression matcher, it will be bound later,
also an application is '(' expr ')' or '(' p-term ')' now a matcher
operator will need a prefix to work and a matcher to implement
advanced matcher operators, '(' is the prefix we will enter later, so

  (define p-term #f)
  (define application (s-and! (s-seq p-term (s-char #\)))))

No we define the operator table,

  (define ops (make-opdata))
  (add-operator ops 'xfy "," 6 s-ws*)
  (add-operator ops 'xfy '=  5 s-ws*)
  (add-operator ops 'xfy '+  4 s-ws*)
  (add-operator ops 'xfy '-  4 s-ws*)
  (add-operator ops 'xfy '/  3 s-ws*)
  (add-operator ops 'xfy '*  3 s-ws*)
  (add-operator ops 'fy  '-  2 s-ws*)
  (add-operator ops 'yf  "(" 1 application)

To note here ise
  0) ,(6) us the loosest bound operator and application(1) the tightest
     bounded operator

  1) s-ws* and 'application' is what will be matched after the prefix
     s-ws* is just possible whitespace removal

  2) xfy = lr binary operator, fy is prefix and yf is postfix also
  note that the matching head pattern for the operator is added.

Over to designing the atoms and produce the expression matcher,

(define op-match
  (letrec (
           ;; numbers
           (num-token (s-seq
                       s-ws*
                       (mk-simple-token #:number 
                                        (s+ (s-reg! "[0-9]")))
                       s-ws*))
           ;; C identifiers
           (id-tok (s-seq 
                    s-ws*
                    (mk-simple-token 
                     #:identifier 
                     (s-seq (s-reg! "[_a-zA-Z]")
                            (s* (s-reg! "[_a-zA-Z0-9]"))))
                    s-ws*))

           ;; subexpresions in paranthesis
           (par-token (s-seq (s-char #\() s-term (s-char #\))))

           ;; And the actual atom
           (atom      (s-or (s-and! par-token) 
                            (s-and! id-tok)
                            (s-and! num-token)))
      
           ;; The raw output operator term
           (term      (mk-operator-expression atom ops))

           ;; Make it more convinient to use
           (s-term    (s-seq s-ws*
                             (<p-lambda> (c) (.. (term end-level)))
                             s-ws*))

           ;; the returned matcher will make sure to match the end
           (op-match  (s-seq s-term s-eof)))

    (set! p-term s-term)  ;; set the p-term (used in the added operator)
    op-match))
  

So op-match will be the thing to match for, The output is not as nice
yet, let's make it nicer,


(define (show x)
  (match x
    ((#:identifier a) (string->symbol a))
    ((#:number     n) (string->number n))
    ((('yf _ "(" val) x . _)
     (list #:application (show x) (show val)))
    ((((or 'xfy 'yfx 'xfx) _ op . _) x y . _)
     `(,op ,(show x) ,(show y)))
    ((((or 'xf 'yf 'fx 'fy) _ op . _) x . _)
     `(,op ,(show x)))
    ((_ . _)
     (map show x))
    (x x)))

Write a run macro,

(define (p-calc str) 
  (let ((p (parse str op-match)))
    (pretty-print (show (car p)))
    (if #f #f)))

And we can have a try,

scheme@(guile-user) [10]> (p-calc "((b * 4 * c(2))+ (4 * a(1)))")
(+ (* b (* 4 (#:application c 2)))
   (* 4 (#:application a 1)))

scheme@(guile-user) [10]> (p-calc "((b * 4 + c(2))+ (4 - - a(1)))")
(+ (+ (* b 4) (#:application c 2))
   (- 4 (- (#:application a 1))))

scheme@(guile-user) [10]> (p-calc "(c = (b * 4 + c(2))+ (4 - - a(1)), 
a*b+c)")
(","
 (= c
    (+ (+ (* b 4) (#:application c 2))
       (- 4 (- (#:application a 1)))))
 (+ (* a b) c))


There sill remain som buggs not shown here but this is a pretty good
start.

Have fun!