Paste # 24770
2020-07-23 19:40:26

Fork as a new paste.

Paste viewed 392 times.


#lang racket

(define-syntax-rule (def x type) (define x (type 'x)))
(define-syntax-rule (defs type x ...) (begin (def x type) ...))

(struct sentence (content) #:transparent
  #:property prop:procedure
  (λ (self conj . args)
      [(conjunction? conj) (sentence (list* conj self args))]
      [else (raise-argument-error 'sentence "conjunction?" conj)])))
(struct conjunction (content) #:transparent)
(struct adjective (content) #:transparent
  #:property prop:procedure
  (λ (self arg) (noun (list self arg))))
(struct verb (content) #:transparent)
(struct relative-pronoun (content) #:transparent)
(struct noun (content) #:transparent
  #:property prop:procedure
  (λ (self thing . args)
      [(verb? thing) (sentence (list* thing self args))]
      [(relative-pronoun? thing) (error 'not-implemented)]
      [(conjunction? thing) (noun (list* thing self args))]
      [(noun? thing) (noun (list* self thing args))]
      [else (raise-argument-error 'noun "not supported" thing)])))

(defs verb dislike love)
(defs noun people syntax cake ice cream)
(defs adjective some unambiguous delicious other)
(defs relative-pronoun which that who whom whose)
(defs conjunction and or but)

(((some people) dislike ((unambiguous syntax) and (delicious cake)))
 but ((some (other people)) love ((unambiguous syntax) and (ice cream))))