all the added crap removed. reconstruct is rolled back

Author: AYadrov

src/core/batch.rkt

@@ -9,7 +9,6 @@
          (struct-out batch)
          (struct-out batchref) ; temporarily for patch.rkt
          (struct-out mutable-batch) ; temporarily for patch.rkt
-         expr-recurse ; Expr -> (Expr -> ?) -> Expr
          batch-length ; Batch -> Integer
          batch-ref ; Batch -> Idx -> Expr
          deref ; Batchref -> Expr
@@ -20,10 +19,8 @@
          mutable-batch-munge! ; Mutable-batch -> Root
          mutable-batch->batch ; Mutable-batch -> Batch
          make-mutable-batch ; Mutable-batch
-         make-batch ; Batch
          mutable-batch-devour-batchref! ; Mutable-batch -> Batchref -> Idx
          batch->mutable-batch ; Batch -> Mutable-batch
-         batch-copy-mutable-nodes! ; Batch -> Mutable-batch -> Void
          batch-push!) ; Mutable-batch -> Expr -> Idx
 
 ;; This function defines the recursive structure of expressions
@@ -47,9 +44,6 @@
 (define (make-mutable-batch)
   (mutable-batch '() (make-hash) '()))
 
-(define (make-batch)
-  (batch (vector) (vector) '()))
-
 (define (batch-push! b term)
   (define hashcons (mutable-batch-index b))
   (hash-ref! hashcons
@@ -70,9 +64,6 @@
                  (batch-restore-index b)
                  (reverse (batch-vars b))))
 
-(define (batch-copy-mutable-nodes! b mb)
-  (set-batch-nodes! b (list->vector (reverse (mutable-batch-nodes mb)))))
-
 (struct batchref (batch idx))
 
 (define (deref x)

src/core/mainloop.rkt

@@ -221,52 +221,15 @@
 
 ;; Converts a patch to full alt with valid history
 (define (reconstruct! alts)
-  (define reconstruct-batch (make-batch))
-  (define reconstruct-batch-mutable (make-mutable-batch))
-
+  (define reconstruct-batch (make-mutable-batch))
   ;; extracts the base expressions of a patch as a batchref
   (define (get-starting-expr altn)
     (match* ((alt-event altn) (alt-prevs altn))
-      [((list 'patch expr _) _) expr]
+      [((list 'patch expr _) _) expr] ; here original Expr can be pulled as well
       [(_ (list prev)) (get-starting-expr prev)]
       [(_ _) (error 'get-starting-spec "unexpected: ~a" altn)]))
 
   ;; takes a patch and converts it to a full alt
-  (define (reconstruct-alt-batch altn loc0 orig)
-    (let loop ([altn altn])
-      (match-define (alt _ event prevs _) altn)
-      (match event
-        [(list 'patch _ _) orig]
-        [_
-         (define event*
-           (match event
-             [(list 'taylor name var) (list 'taylor loc0 name var)]
-             [(list 'rr input proof soundiness) (list 'rr loc0 input proof soundiness)]
-             [(list 'simplify input proof soundiness) (list 'simplify loc0 input proof soundiness)]))
-         (define idx
-           (location-do-batch loc0 reconstruct-batch-mutable (alt-expr orig) (alt-expr altn)))
-         (define expr* (batchref reconstruct-batch idx))
-         (alt expr* event* (list (loop (first prevs))) (alt-preprocessing orig))])))
-
-  (define batchified-out
-    (reap [sow]
-          (for ([altn (in-list alts)]) ;; does not have preproc
-            (define start-expr (get-starting-expr altn)) ; batchref
-            (for ([full-altn (in-list (^next-alts^))])
-              (define expr (alt-expr full-altn))
-              (for ([loc (in-list (get-locations expr start-expr))])
-                (sow (reconstruct-alt-batch altn loc full-altn)))))))
-  (batch-copy-mutable-nodes! reconstruct-batch reconstruct-batch-mutable)
-
-  (define (rebuild-alts x)
-    (match-define (alt expr event prevs preprocessing) x)
-    (match (batchref? expr)
-      [#t (alt (batchref->expr expr) event (map rebuild-alts prevs) preprocessing)]
-      [#f (alt expr event (map rebuild-alts prevs) preprocessing)]))
-  (set! batchified-out (map rebuild-alts batchified-out))
-
-  ;; takes a patch and converts it to a full alt
-  #;
   (define (reconstruct-alt altn loc0 orig)
     (let loop ([altn altn])
       (match-define (alt _ event prevs _) altn)
@@ -281,23 +244,13 @@
          (define expr* (location-do loc0 (alt-expr orig) (const (batchref->expr (alt-expr altn)))))
          (alt expr* event* (list (loop (first prevs))) (alt-preprocessing orig))])))
 
-  #;(define out
-      (reap [sow]
-            (for ([altn (in-list alts)]) ;; does not have preproc
-              (define start-expr (get-starting-expr altn))
-              (if start-expr
-                  (for ([full-altn (in-list (^next-alts^))])
-                    (define expr (alt-expr full-altn))
-                    (for ([loc (in-list (get-locations expr start-expr))])
-                      (sow (reconstruct-alt altn loc full-altn))))
-                  ; altn is a full alt (probably iter 0 simplify)
-                  (sow altn)))))
-
-  (^patched^ batchified-out)
-  #;(for ([p (in-list out)]
-          [p* (in-list batchified-out)])
-      (printf "\tp=~a\n" p)
-      (printf "\tp*=~a\n\n" p*))
+  (^patched^ (reap [sow]
+                   (for ([altn (in-list alts)]) ;; does not have preproc
+                     (define start-expr (get-starting-expr altn))
+                     (for ([full-altn (in-list (^next-alts^))])
+                       (define expr (alt-expr full-altn))
+                       (for ([loc (in-list (get-locations expr start-expr))])
+                         (sow (reconstruct-alt altn loc full-altn)))))))
 
   (void))
 

src/core/patch.rkt

@@ -71,7 +71,7 @@
               (sow (alt (batchref global-batch idx) `(simplify ,runner #f #f) (list altn) '()))))))
 
   ; Commit changes to global-batch
-  (batch-copy-mutable-nodes! global-batch global-batch-mutable)
+  (set-batch-nodes! global-batch (list->vector (reverse (mutable-batch-nodes global-batch-mutable))))
   ; End of global-batch modification
   ; ---------------------------------
 
@@ -121,7 +121,7 @@
             (timeline-stop!))))
 
   ; Commit changes to global-batch
-  (batch-copy-mutable-nodes! global-batch global-batch-mutable)
+  (set-batch-nodes! global-batch (list->vector (reverse (mutable-batch-nodes global-batch-mutable))))
   ; End of global-batch modification
   ; ----------------------------------
 

src/core/programs.rkt

@@ -3,7 +3,7 @@
 (require "../syntax/syntax.rkt"
          "../syntax/types.rkt"
          "../utils/common.rkt"
-         "batch.rkt")
+         (only-in "batch.rkt" batch-nodes))
 
 (provide expr?
          expr-contains?
@@ -15,7 +15,6 @@
          repr-of
          repr-of-node
          location-do
-         location-do-batch
          location-get
          free-variables
          replace-expression
@@ -41,8 +40,7 @@
   (match node
     [(? literal?) (get-representation (literal-precision node))]
     [(? variable?) (context-lookup ctx node)]
-    [(list '$approx _ impl)
-     (repr-of-node batch impl ctx)] ; this is ugly, but egraph-add-exprs relies on this match
+    [(approx _ impl) (repr-of-node batch impl ctx)]
     [(list 'if cond ift iff) (repr-of-node batch ift ctx)]
     [(list op args ...) (impl-info op 'otype)]))
 
@@ -181,28 +179,6 @@
            [else (cons (car elts) (seek (cdr elts) (sub1 idx)))]))]
       [(_ _) (invalid! prog loc)])))
 
-(define/contract (location-do-batch loc mbatch prog replace-batchref)
-  (-> location? mutable-batch? expr? batchref? number?)
-  (define (invalid! where loc)
-    (error 'location-do "invalid location `~a` for `~a` in `~a`" loc where prog))
-
-  (define (rewrite prog loc)
-    (match* (prog loc)
-      [(_ (? null?)) (mutable-batch-devour-batchref! mbatch replace-batchref)]
-      [((or (? literal?) (? number?) (? symbol?)) _) (invalid! prog loc)]
-      [((approx spec impl) (cons idx rest))
-       (case idx
-         [(2) (batch-push! mbatch (approx (mutable-batch-munge! mbatch spec) (rewrite impl rest)))]
-         [else (invalid! prog loc)])]
-      [((list op args ...) (cons idx rest))
-       (define args*
-         (for/list ([arg (in-list args)]
-                    [n (in-naturals 1)])
-           (if (equal? n idx) (rewrite arg rest) (mutable-batch-munge! mbatch arg))))
-       (batch-push! mbatch (cons op args*))]
-      [(_ _) (invalid! prog loc)]))
-  (rewrite prog loc))
-
 (define/contract (location-get loc prog)
   (-> location? expr? expr?)
   ; Clever continuation usage to early-return