Skip to content

Commit 177da3c

Browse files
pavpanchekhapavpanchekha
committed
Refactor egglog-send to not need the list wrapper
1 parent c81e6a3 commit 177da3c

File tree

2 files changed

+83
-83
lines changed

2 files changed

+83
-83
lines changed

‎src/core/egglog-herbie.rkt‎

Lines changed: 71 additions & 71 deletions
Original file line numberDiff line numberDiff line change
@@ -134,19 +134,19 @@
134134
(egglog-add-exprs insert-batch insert-brfs (egglog-runner-ctx runner) subproc))
135135

136136
(egglog-send subproc
137-
(list `(ruleset run-extract-commands)
138-
`(rule () (,@all-bindings) :ruleset run-extract-commands)
139-
`(run-schedule (repeat 1 run-extract-commands))))
137+
`(ruleset run-extract-commands)
138+
`(rule () (,@all-bindings) :ruleset run-extract-commands)
139+
`(run-schedule (repeat 1 run-extract-commands)))
140140

141141
;; 4. Running the schedule : having code inside to emulate egraph-run-rules
142142

143143
(for ([step (in-list (egglog-runner-schedule runner))])
144144
(match step
145-
['lift (egglog-send subproc (list '(run-schedule (saturate lift))))]
145+
['lift (egglog-send subproc '(run-schedule (saturate lift)))]
146146

147-
['lower (egglog-send subproc (list '(run-schedule (saturate lower))))]
147+
['lower (egglog-send subproc '(run-schedule (saturate lower)))]
148148

149-
['unsound (egglog-send subproc (list '(run-schedule (saturate unsound))))]
149+
['unsound (egglog-send subproc '(run-schedule (saturate unsound)))]
150150

151151
;; Run the rewrite ruleset interleaved with const-fold until the best iteration
152152
['rewrite (egglog-unsound-detected-subprocess step subproc)]))
@@ -156,8 +156,7 @@
156156
(for/list ([constructor-name extract-bindings])
157157
`(extract (,constructor-name) ,(*egglog-variants-limit*))))
158158

159-
(define stdout-content
160-
(egglog-send subproc extract-commands #:num-extracts (length extract-commands)))
159+
(define stdout-content (egglog-extract subproc extract-commands))
161160

162161
;; (Listof (Listof exprs))
163162
(define herbie-exprss
@@ -206,40 +205,39 @@
206205
(define (prelude subproc #:mixed-egraph? [mixed-egraph? #t])
207206
(define pform (*active-platform*))
208207

209-
(egglog-send subproc
210-
(list `(datatype M
211-
(Num BigRat :cost 4294967295)
212-
(Var String :cost 4294967295)
213-
,@(platform-spec-nodes))))
214-
215-
(egglog-send subproc
216-
(append (list `(datatype MTy
217-
,@(num-typed-nodes pform)
218-
,@(var-typed-nodes pform)
219-
(Approx M MTy)
220-
,@(platform-impl-nodes pform))
221-
`(constructor do-lower (M String) MTy :unextractable)
222-
`(constructor do-lift (MTy) M :unextractable)
223-
`(ruleset const-fold)
224-
`(ruleset lower)
225-
`(ruleset lift)
226-
`(ruleset unsound)
227-
`(function bad-merge? () bool :merge (or old new))
228-
`(ruleset bad-merge-rule)
229-
`(set (bad-merge?) false)
230-
`(rule ((= (Num c1) (Num c2)) (!= c1 c2))
231-
((set (bad-merge?) true))
232-
:ruleset
233-
bad-merge-rule))
234-
const-fold
235-
(impl-lowering-rules pform)
236-
(impl-lifting-rules pform)
237-
(num-lowering-rules)
238-
(num-lifting-rules)
239-
(list (approx-lifting-rule))
240-
(egglog-rewrite-rules (*sound-removal-rules*) 'unsound)
241-
(list `(ruleset rewrite))
242-
(egglog-rewrite-rules (*rules*) 'rewrite)))
208+
(egglog-send
209+
subproc
210+
`(datatype M (Num BigRat :cost 4294967295) (Var String :cost 4294967295) ,@(platform-spec-nodes)))
211+
212+
(apply egglog-send
213+
subproc
214+
(append (list `(datatype MTy
215+
,@(num-typed-nodes pform)
216+
,@(var-typed-nodes pform)
217+
(Approx M MTy)
218+
,@(platform-impl-nodes pform))
219+
`(constructor do-lower (M String) MTy :unextractable)
220+
`(constructor do-lift (MTy) M :unextractable)
221+
`(ruleset const-fold)
222+
`(ruleset lower)
223+
`(ruleset lift)
224+
`(ruleset unsound)
225+
`(function bad-merge? () bool :merge (or old new))
226+
`(ruleset bad-merge-rule)
227+
`(set (bad-merge?) false)
228+
`(rule ((= (Num c1) (Num c2)) (!= c1 c2))
229+
((set (bad-merge?) true))
230+
:ruleset
231+
bad-merge-rule))
232+
const-fold
233+
(impl-lowering-rules pform)
234+
(impl-lifting-rules pform)
235+
(num-lowering-rules)
236+
(num-lifting-rules)
237+
(list (approx-lifting-rule))
238+
(egglog-rewrite-rules (*sound-removal-rules*) 'unsound)
239+
(list `(ruleset rewrite))
240+
(egglog-rewrite-rules (*rules*) 'rewrite)))
243241

244242
(void))
245243

@@ -545,30 +543,32 @@
545543
(set! root-bindings (cons (vector-ref mappings n) root-bindings))))
546544

547545
; Var-lowering-rules
548-
(egglog-send subproc
549-
(for/list ([var (in-list (context-vars ctx))]
550-
[repr (in-list (context-var-reprs ctx))])
551-
`(rule ((= e (Var ,(symbol->string var))))
552-
((let ty ,(symbol->string (representation-name repr))
553-
)
554-
(let ety (,(typed-var-id (representation-name repr))
555-
,(symbol->string var))
556-
)
557-
(union (do-lower e ty) ety))
558-
:ruleset
559-
lower)))
546+
(apply egglog-send
547+
subproc
548+
(for/list ([var (in-list (context-vars ctx))]
549+
[repr (in-list (context-var-reprs ctx))])
550+
`(rule ((= e (Var ,(symbol->string var))))
551+
((let ty ,(symbol->string (representation-name repr))
552+
)
553+
(let ety (,(typed-var-id (representation-name repr))
554+
,(symbol->string var))
555+
)
556+
(union (do-lower e ty) ety))
557+
:ruleset
558+
lower)))
560559

561560
; Var-lifting-rules
562-
(egglog-send subproc
563-
(for/list ([var (in-list (context-vars ctx))]
564-
[repr (in-list (context-var-reprs ctx))])
565-
`(rule ((= e (,(typed-var-id (representation-name repr)) ,(symbol->string var))))
566-
((let se (Var
567-
,(symbol->string var))
568-
)
569-
(union (do-lift e) se))
570-
:ruleset
571-
lift)))
561+
(apply egglog-send
562+
subproc
563+
(for/list ([var (in-list (context-vars ctx))]
564+
[repr (in-list (context-var-reprs ctx))])
565+
`(rule ((= e (,(typed-var-id (representation-name repr)) ,(symbol->string var))))
566+
((let se (Var
567+
,(symbol->string var))
568+
)
569+
(union (do-lift e) se))
570+
:ruleset
571+
lift)))
572572

573573
(define all-bindings '())
574574
(define binding->constructor (make-hash)) ; map from binding name to constructor name
@@ -586,7 +586,7 @@
586586
(define curr-var-spec-binding `(let ,binding-name (Var ,(symbol->string var))))
587587

588588
; Send the constructor definition
589-
(egglog-send subproc (list `(constructor ,constructor-name () M :unextractable)))
589+
(egglog-send subproc `(constructor ,constructor-name () M :unextractable))
590590

591591
; Add the binding and constructor set to all-bindings for the future rule
592592
(set! all-bindings (cons curr-var-spec-binding all-bindings))
@@ -607,7 +607,7 @@
607607
`(let ,binding-name (,(typed-var-id (representation-name repr)) ,(symbol->string var))))
608608

609609
; Send the constructor definition
610-
(egglog-send subproc (list `(constructor ,constructor-name () MTy :unextractable)))
610+
(egglog-send subproc `(constructor ,constructor-name () MTy :unextractable))
611611

612612
; Add the binding and constructor set to all-bindings for the future rule
613613
(set! all-bindings (cons curr-var-typed-binding all-bindings))
@@ -640,7 +640,7 @@
640640

641641
(define curr-binding-exprs `(let ,binding-name ,actual-binding))
642642

643-
(egglog-send subproc (list `(constructor ,constructor-name () ,curr-datatype :unextractable)))
643+
(egglog-send subproc `(constructor ,constructor-name () ,curr-datatype :unextractable))
644644

645645
(set! all-bindings (cons curr-binding-exprs all-bindings))
646646
(set! all-bindings (cons `(set (,constructor-name) ,binding-name) all-bindings))
@@ -729,14 +729,14 @@
729729
;; e-graph while extracting. For now, popping provides a smaller e-graph and gives
730730
;; performance comparable to Egg-Herbie, thought it doesn't affect correctness too much
731731
[math-node-limit?
732-
(egglog-send subproc (list '(pop)))
732+
(egglog-send subproc '(pop))
733733
(values (sub1 curr-iter) #t)]
734734

735735
;; If Unsoundness detected or node-limit reached, then return the
736736
;; optimal iter limit (one less than current) and run (pop)
737737
[math-unsound?
738738
;; Pop once at the end since the egraph isn't valid
739-
(egglog-send subproc (list '(pop)))
739+
(egglog-send subproc '(pop))
740740

741741
;; Return one less than current iteration and indicate that we need to run again because pop
742742
(values (sub1 curr-iter) #t)]
@@ -761,11 +761,11 @@
761761
;; TODO: See the TODO from above
762762
[(equal? const-total-nodes prev-number-nodes) (values curr-iter #f)]
763763
[const-node-limit?
764-
(egglog-send subproc (list '(pop)))
764+
(egglog-send subproc '(pop))
765765
(values (sub1 curr-iter) #t)]
766766

767767
[const-unsound?
768-
(egglog-send subproc (list '(pop)))
768+
(egglog-send subproc '(pop))
769769
(values (sub1 curr-iter) #t)]
770770

771771
[else

‎src/core/egglog-subprocess.rkt‎

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55
(provide (struct-out egglog-subprocess)
66
create-new-egglog-subprocess
77
egglog-send
8+
egglog-extract
89
egglog-send-unsound-detection
910
egglog-subprocess-close)
1011

@@ -47,7 +48,7 @@
4748

4849
(egglog-subprocess egglog-process egglog-output egglog-in err dump-file))
4950

50-
(define (egglog-send subproc commands #:num-extracts [num-extracts 0])
51+
(define (egglog-send subproc . commands)
5152
(match-define (egglog-subprocess egglog-process egglog-output egglog-in err dump-file) subproc)
5253

5354
(define egglog-program (apply ~s #:separator "\n" commands))
@@ -73,11 +74,14 @@
7374
(raise exn))])
7475

7576
(displayln egglog-program egglog-in)
76-
(flush-output egglog-in)
77+
(flush-output egglog-in)))
7778

78-
;; Return each S-expr based on the numer of extractions
79-
(for/list ([i (in-range num-extracts)])
80-
(read egglog-output))))
79+
;; Send extract commands and read results
80+
(define (egglog-extract subproc extract-commands)
81+
(apply egglog-send subproc extract-commands)
82+
(match-define (egglog-subprocess egglog-process egglog-output egglog-in err dump-file) subproc)
83+
(for/list ([i (in-range (length extract-commands))])
84+
(read egglog-output)))
8185

8286
(define (egglog-send-unsound-detection subproc commands)
8387
(match-define (egglog-subprocess egglog-process egglog-output egglog-in err dump-file) subproc)
@@ -159,12 +163,10 @@
159163
'(run init 1)))
160164

161165
; Nothing to output
162-
(egglog-send subproc first-commands)
166+
(apply egglog-send subproc first-commands)
163167

164168
; Has extract 1 thing
165-
(define second-commands (list '(extract (const1))))
166-
167-
(define lines1 (egglog-send subproc second-commands #:num-extracts 1))
169+
(define lines1 (egglog-extract subproc (list '(extract (const1)))))
168170
(printf "\noutput-vals1 : ~a\n\n" lines1)
169171

170172
;; Print size
@@ -182,9 +184,7 @@
182184
(printf "num-nodes : ~a\n" (calculate-nodes node-values))
183185

184186
;; last two
185-
(define third-commands (list '(extract (const2)) '(extract (const3))))
186-
187-
(define lines2 (egglog-send subproc third-commands #:num-extracts 2))
187+
(define lines2 (egglog-extract subproc (list '(extract (const2)) '(extract (const3)))))
188188
(printf "\noutput-vals2 : ~a\n\n" lines2)
189189

190190
(egglog-subprocess-close subproc)))

0 commit comments

Comments
 (0)