pattern-match.rkt - implementation of basic pattern match

pattern-match.rkt

#lang racket
; pattern-match.rkt - implementation of basic pattern match

(define (conbining-cond-and-match-list ls)
  (cons 'cond ls))

(define (convert-match input)
  (define pattern-list (cddr input))
  (cond
    [(not (eq? (car input) 'match)) (error "the head of input is not \"match\". Exit.")]
    [(eq? pattern-list '()) (error "the patterns are not listed.")]
    (else (conbining-cond-and-match-list (convert-match-main pattern-list (list-ref input 1) empty)))))

(define (convert-match-main pattern-list input-var result)
  (let ((head-line-result (convert-match-line input-var (car pattern-list) (cdr pattern-list))))
    (if (eq? (cdr pattern-list) '())
        `(,head-line-result)
        (cons head-line-result (convert-match-main (cdr pattern-list) input-var result)))
  )
)

;; storing match-line result
(struct match-result (LetBindingLst ConstraintLst) #:mutable)

; convert-match-line
(define (convert-match-line input-var match-line rest-match-lines)
  ;(display match-line)
  (define pattern (car match-line))
  (define binding-pattern-and-constraint-list (binding-pattern (cdr pattern) input-var))
  (define binded-variable-pair (match-result-LetBindingLst binding-pattern-and-constraint-list))
  (define constraint-list (match-result-ConstraintLst binding-pattern-and-constraint-list))
  
  ; (id x) = get the struct identifier of the variable x; (const-id x) = get the constructor identifier of the constructor x
  (define type-condition `(eq? (id ,input-var) (const-id ,(car pattern))))
  (if (eq? constraint-list empty)
    `[ ,type-condition ,(append `(let ,binded-variable-pair) (cdr match-line))]
    `[ ,type-condition (if ,(cons 'and constraint-list)
                          ,(append `(let ,binded-variable-pair) (cdr match-line))
                          ,(conbining-cond-and-match-list (convert-match-main rest-match-lines input-var empty)))]
  ))

; binding pattern to variable
(define (binding-pattern list input-var) (binding-pattern-0 list 0 input-var empty empty))
(define (binding-pattern-0 list ctr input-var binding-result constraint-results) ; ctr = counter
  (cond
    ((eq? list empty) (match-result binding-result constraint-results))
    ((not (symbol? (car list)))
          (binding-pattern-0
            (cdr list)
            (+ ctr 1)
            input-var
            binding-result
            (append constraint-results  `((eq? (get-ref ,input-var ,ctr) ,(car list))))))
    (else  (binding-pattern-0
            (cdr list)
            (+ ctr 1)
            input-var
            (append binding-result  `((,(car list) (get-ref ,input-var ,ctr))))
            constraint-results)))
  )

;; example
;;
(define match-example '(match x
  [(list1 p1 p11 p12) body1]
  ;[(list2 p2 p21 p22) body2]
))
;;
;;'(cond ((eq? (id x) (const-id list1))
;;       (let ((p1 (get-ref x 0)) (p11 (get-ref x 1)) (p12 (get-ref x 2))) body1)))
(convert-match match-example)



(define match-example2 '(match x
  [(list1 p1 p11 p12) body1]
  [(list2 p2 p20) body2]
  [(atom3) body3]
))
;;
;;'(cond
;;  ((eq? (id x) (const-id list1)) (let ((p1 (get-ref x 0)) (p11 (get-ref x 1)) (p12 (get-ref x 2))) body1))
;;  ((eq? (id x) (const-id list2)) (let ((p2 (get-ref x 0)) (p20 (get-ref x 1))) body2))
;;  ((eq? (id x) (const-id atom3)) (let () body3)))
(convert-match match-example2)


(define match-example3 '(match y
  [(list1 p1 p11 p12) body1]
  [(list2 p2 x 2) body2]
  [(list3 p3 x y) body3]
  [(atom4) body4]
))

;; '(cond
;;  ((eq? (id y) (const-id list1)) (let ((p1 (get-ref y 0)) (p11 (get-ref y 1)) (p12 (get-ref y 2))) body1))
;;  ((eq? (id y) (const-id list2))
;;   (if (and (eq? (get-ref y 2) 2))
;;     (let ((p2 (get-ref y 0)) (x (get-ref y 1))) body2)
;;     (cond
;;      ((eq? (id y) (const-id list3)) (let ((p3 (get-ref y 0)) (x (get-ref y 1)) (y (get-ref y 2))) body3))
;;      ((eq? (id y) (const-id atom4)) (let () body4)))))
;;  ((eq? (id y) (const-id list3)) (let ((p3 (get-ref y 0)) (x (get-ref y 1)) (y (get-ref y 2))) body3))
;;  ((eq? (id y) (const-id atom4)) (let () body4)))
(convert-match match-example3)