Hi,

I just wanted to share some ideas that come to my mind to churn the prolog
into something more useful.

So I have been trying to rework Shins hygienic version if ice-9 match so that
it can be used as a backbone for it.

I currently have two matchers, one a fast and severely insecure that I'm 
playing with. and a prompt based version that only needs a slight change to
guile sources. Now, there is many other ways to do backtracking. Two things
come to my mind. 1) based on returning a backtrack symbol or based on closures
now Shins code has a local variable that represents the next continuation and
one can easally hook in code to make that variable explicit and pass it as an
appropriate Cut closure. So in principle making the prolog engine work with
this system is a no brainer and this is where I'm heading now. But there is 
some 
extra work still needed to add to the matcher. E.g. we need to replace
car,cdr,pair? null? equal? with appropriate versions of it and then just go
from there. Oh well I have another extension. I want to improve the prolog 
compiler to be more user friendly giving some better clues of parse errors and
the next discussion will be inline with that.

So here is the extension match, (see match-phd.scm attached to this file).

the prototype is exemplified like this

(match abstractions ((<a> a1 a2 a3) (<b>) (<c> c1 c2) ...)
       phd          ((*car *cdr *pair? null? equal?)         ;;default 
functions
                     (+ (*car *cdr *pair? null? equal?))     ;;+ uses 
functions
                     (- ( car  cdr  pair? null? equal?)))    ;;- uses ordinary 
                                                                 match 

       ... usual match stuff here)

So for this example
(- <a> <a> <b> . L)  will match the sequence of subpattern where reault data
will be stored in variables a1, a2, void and standard matching (-) will be
used.

Let's see an interesting code. You can execute this after putting the matcher
following this mail in ice-9 directory!

(use-modules (ice-9 match-phd))

;; Setting up the xmatch environment
;; We will work with elements of the form (List Row Column Depth) here
(define (*car      x) (match x (((h . l) r c d) `(,h ,r ,c       ,d))))
(define (*cdr      x) (match x (((h . l) r c d) `(,l ,r ,(+ c 1) ,d))))
(define (*pair?    x) (match x ((x       r c d) (pair? x))))
(define (*null?    x) (match x ((x       r c d) (null? x))))
(define (*equal? x y) (match x ((x       r c d) (equal? x y))))

;; defining xmatch utility - this just will use match but automatically fill 
in
;; the header and make sure to use correct syntactic environment.
;; (make-phd-matcher name phd abs)
;; defaults is to use (*car ...), - means usual match will be done by (car 
...)
;; we also tell the matcher to use a set of abstractions with appropriate
;; variables to bind to. xmatch will be anaphoric though.

(make-phd-matcher xmatch
                  ((*car *cdr *pair? *null? *equal?)
                   (  (+ (*car *cdr *pair? *null? *equal?))
                      (- ( car  cdr  pair?  null?  equal?))))
                  ((<ws>              ) 
                   (<up>              )
                   (<down>            )
                   (<npar?>           )
                   (<pk>              )
                   (<+>          plus )
                   (<atom>       atom )                   
                   (<statement>  st   )
                   (<statements*> sts  )
                   (<statements> sts  )))

;; sp?  is a predicate for white characters and w? is nonwhite characters and
;; not ( or )
(define (sp?  x) (member (car x) '(#\space #\tab #\newline)))
(define (w?   x) (and (not (member (car x) '(#\( #\)))) (not (sp? x))))


;; first matcher just silintly parse away whities
;; matches 0 or more white characters and make sure to count lines
;; a newline counts here a a white character.
;; note how we turn the matcher into ordinary matching to fetch statistics
(define (<ws> X)
  (xmatch X 
          ( [#\newline . (- L r c d)]   (<ws> `(,L ,(+ r 1) 0 ,d)) )
          ( [(? sp?)   .    L       ]   (<ws>    L)               )
          ( L                           (cons 'ws L)              )))


;; <*> an abstraction that matches 0 or more (? m?) characters.
(define (<*> m?)
  (define (f L X)
    (xmatch X
            ([(? m? M)  . U]   (f (cons M L) U))
            (U                 (cons (reverse L) U))))

  (lambda (X) (f '() X)))

;; <*> an abstraction that matches 1 or more (? m?) characters.
(define (<+> m?)
  (define (f L X)
    (xmatch X
            ([(? m? M) . U]   (f (cons (car M) L) U))
            (U                (cons (reverse L) U))))

  (lambda (X) 
    (xmatch X
            ([(? m? M) . L]   (f (cons (car M) '()) L))
            (_                #f))))

;; debugger, just put it into a macther list to spy :-) on the matching
(define (<pk> X) (begin (pk (car X)) (cons 'ok X)))

;; atoms is just a sequence of 1 or more nonwhite characters.
;; note the use of the <+> abstraction!
(define (<atom> X) 
  (xmatch X 
          ([(<+> w?) . L] (cons `(<atom> ,(list->string plus) ,@(cdr X))   L))
          (_              #f)))


;; <down> and <up> will make sure to handle depth statistics
(define (<down> X) (match X ([L r c d] (cons #t `(,L ,r ,c ,(+ d 1))))))
(define (<up>   X) (match X ([L r c 0] (error (format #f 
                                                      "to many ) parenthesis 
at row ~a column ~a"
                                                      r c)))
                            ([L r c d] (cons #t `(,L ,r ,c ,(- d 1)))))


;; just a check at the end that paranthesis matches.
(define (<npar?> X) (match X 
                           ([L r c 0] (cons #t `(,L ,r ,c 0)))
                           ([L r c d] (error (format #f "~a ) is missing at
			   the end!!" d)))))

;; <statement>  atom or ( 0 or more statements )
(define (<statement> X)
  (xmatch X
          ([<ws> (and H #\() <down> <statements*> <ws> #\) <up> . L]  
           (cons `(list ,(cadr sts) ,@(cdr H)) L))
          ([<ws> <atom>                                        . L]  
           (cons atom L))
          (_ #f)))

;; 0 or more statments inside a paranthesis e.g. need to look for ) pattern
(define (<statements*> X)
  (xmatch X
          ([<ws> #\)                  . L] (cons `(stms (                 ) 
,@(cdr  X )) X))
          ([<statement> <statements*> . L] (cons `(stms (,st  ,@(cadr sts)) 
,@(cddr st)) L))
          (_                               #f)))

;; 1 or more toplevel statements is demanded here
(define (<statements> X)
  (xmatch X
          ([<statement> <statements> . L] (cons `(stms (,st  ,@(cadr sts)) 
,@(cddr st)) L))
          ([<statement>              . L] (cons `(stms (,st             ) 
,@(cddr st)) L))
          (_                              #f)))

;; Oh well here comes a parser primitive, Need to initiate the Matcher.
(define (parse X) (xmatch `(,(string->list X) 0 0 0) ([<statements> <npar?> 
<ws>] sts)))

;; Example (one can improve column numbers slightly here :-))
(parse "
one
big
fat ( hacker eat (cucumber with mustard 
        (pokes the stomache)))
oh well
")

>>>

(stms ( (<atom> "one" 1 0 0) 
        (<atom> "big" 2 0 0) 
	(<atom> "fat" 3 0 0) 
	(list ( (<atom> "hacker" 3 6  1) 
	        (<atom> "eat"    3 13 1) 
		(list  (  (<atom> "cucumber" 3 18 2) 
		          (<atom> "with"     3 27 2) 
			  (<atom> "mustard"  3 32 2) 
			  (list (  (<atom> "pokes"    4 9 3) 
			           (<atom> "the"      4 15 3) 
				   (<atom> "stomache" 4 19 3)) 
				   4 8 2)) 
			   3 17 1)) 
                 3 4 0)
         (<atom> "oh"   5 0 0) 
	 (<atom> "well" 5 3 0)) 
	 1 0 0)





Have fun
/Stefan