-
-
Notifications
You must be signed in to change notification settings - Fork 68
/
consequence.cljc
152 lines (126 loc) · 5.28 KB
/
consequence.cljc
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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
;;
;; Copyright © 2021 Sam Ritchie.
;; This work is based on the Scmutils system of MIT/GNU Scheme:
;; Copyright © 2002 Massachusetts Institute of Technology
;;
;; This is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3 of the License, or (at
;; your option) any later version.
;;
;; This software is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this code; if not, see <http://www.gnu.org/licenses/>.
;;
(ns pattern.consequence
"Code for defining and compiling 'consequence' functions, ie, functions from a
binding map generated by a [[[pattern.match]]] to some successful
transformation (or a failure!).
See [[pattern.rule]] for a detailed treatment."
(:require [pattern.syntax :as ps]
[sicmutils.util :as u]))
;; ## Consequence Functions
;;
;; A consequence is a function from a binding dictionary (produced by a matcher)
;; to a successful result or a failure. A "rule" (see `pattern.rule`) is built
;; out of a matcher (from `pattern.match`) and a consequence function.
;;
;; The contract for a "consequence" function is that it can return `false`,
;; `nil` or [[pattern.match/failure]] to signal failure. But what if the
;; function wants to succeed with `false` or `nil`?
;;
;; Wrapping a return value with [[succeed]] will allow a successful return of
;; `false` or `nil`; a rule using a consequence function uses [[unwrap]] to
;; retrieve the value before returning it.
(defn succeed
"Wraps the argument `x` in a form that will always successfully return from a
consequence function, whatever its value.
Use [[succeed]] to return `nil` or `false` from a consequence function. For
all other return values, returning `(succeed x)` is identical to returning
`x`"
[x]
{::succeed x})
(defn unwrap
"Given a form returned by a consequence function, unwraps the top level
`succeed` wrapper if present to return the final value."
[x]
(if (map? x)
(::succeed x x)
x))
;; ### Consequence Skeletons
;;
;; A Skeleton is a template of the form that we'd like to return from a
;; consequence function, with pattern-matching variables like `?x` and `??x` in
;; place of binding map lookups.
;;
;; [[compile-skeleton]] transforms an expression like
(comment
(let [cake 10]
(+ ?x ?y ~cake (? (fn [m] (m '?z))))))
;; Into a form like the following, meant to be evaluated in an environment where
;; `m` is bound to some map of bindings (the user provides this symbol):
(comment
(let [cake 10]
(list '+ (m '?x) (m '?y) cake ((fn [m] (m '?z)) m))))
;; See [[compile-skeleton]] for the full set of transformation rules.
(defn- apply-form
"Given symbols `f` representing a function and `x` representing its argument,
returns a form that represents function application.
- Symbols are quoted
- [[unquote?]] forms are included without quote
- all other forms are left untouched."
[f x]
(let [f (cond (simple-symbol? f) `(quote ~f)
(ps/unquote? f) (ps/unquoted-form f)
:else f)]
(list f x)))
(defn compile-skeleton
"Takes:
- a symbol `frame-sym` meant to reference a map of bindings
- a skeleton expression `skel`
and returns an unevaluated body that, when evaluated, will produce a form
structure of identical shape to `skel`, with:
- all variable binding forms replaced by forms that look up the binding in a
map bound to `frame-sym`
- same with any segment binding form, with the added note that these should
be spliced in
- any `unquote` or `unquote-splicing` forms respected."
[frame-sym skel]
(letfn [(compile-sequential [xs]
(let [acc (ps/splice-reduce (some-fn ps/segment?
ps/reverse-segment?
ps/unquote-splice?)
compile xs)]
(cond (empty? acc) ()
(= 1 (count acc)) (first acc)
:else `(concat ~@acc))))
(compile [form]
(cond (or (ps/binding? form)
(ps/segment? form))
(let [v (ps/variable-name form)]
(apply-form v frame-sym))
(ps/reverse-segment? form)
(let [v (ps/reverse-segment-name form)]
(list `rseq (apply-form v frame-sym)))
(symbol? form) (list 'quote form)
(ps/unquote? form)
(ps/unquoted-form form)
(ps/unquote-splice? form)
(into [] (ps/unquoted-form form))
(map? form)
(u/map-vals compile form)
(vector? form)
`(vec ~(compile-sequential form))
(sequential? form)
(if (empty? form)
form
`(seq ~(compile-sequential form)))
:else form))]
(if skel
`(let [r# ~(compile skel)]
(or r# (succeed r#)))
`(succeed ~skel))))