git @ Cat's Eye Technologies Treacle / master src / syntax.scm
master

Tree @master (Download .tar.gz)

syntax.scm @master — raw · history · blame 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
;
; Provisional Syntax for Treacle Forms
; Chris Pressey, April 2008
;

; SPDX-FileCopyrightText: (c) 2008-2024 Chris Pressey, Cat's Eye Technologies
; This file is distributed under a 2-clause BSD license.  For more information see:
; SPDX-License-Identifier: LicenseRef-BSD-2-Clause-X-Treacle

(load "pattern.scm")

;
; Syntax for atomic terms, including patterns and replacements.
;
(define-syntax term-atom
  (syntax-rules (* ? :i :o @)
    ((term-atom *)
      (mk-wildcard))
    ((term-atom @)
      (mk-newref))
    ((term-atom (? name subterm))
      (mk-named 'name (term-atom subterm)))
    ((term-atom (:i subterm))
      (mk-hole 'innermost (term-atom subterm)))
    ((term-atom (:o subterm))
      (mk-hole 'outermost (term-atom subterm)))
    ((term-atom (inner ...))
      (term-list inner ...))
    ((term-atom other)
      'other)))

;
; Syntax for list terms.
;
(define-syntax term-list
  (syntax-rules ()
    ((term-list)
      '())
    ((term-list atom rest ...)
      (cons (term-atom atom) (term-list rest ...)))))

;
; Syntax for replacements.
;
(define-syntax replacements
  (syntax-rules (:)
    ((replacements)
      '())
    ((replacements name : replacement rest ...)
      (cons (cons 'name (term-atom replacement)) (replacements rest ...)))
  ))

;
; Syntax for rules.
;
(define-syntax rules
  (syntax-rules (->)
    ((rules)
      '())
    ((rules pattern -> (repls ...) rest ...)
      (cons (cons (term-atom pattern) (replacements repls ...)) (rules rest ...)))
  ))