WIP

tests/debug/find-known-lambdas.scm

@@ -8,65 +8,88 @@
 )
 
 (define (analyze:find-known-lambdas exp)
-TODO: scan for well-known lambdas:
+;TODO: scan for well-known lambdas:
-- app of a lambda is well-known, that's easy
+;- app of a lambda is well-known, that's easy
-- lambda can be passed as a cont. If we can identify all the places the cont is called (?) and it is not used for anything but calls, then I suppose that also qualifies as well-known.
+;- lambda can be passed as a cont. If we can identify all the places the cont is called (?) and it is not used for anything but calls, then I suppose that also qualifies as well-known.
-  this is more problematic to generate code for, though.
+;  this is more problematic to generate code for, though.
-  may need a lookup table of symbol to well-known function (if any)
+;  may need a lookup table of symbol to well-known function (if any)
-- ?? must be other cases
+;- ?? must be other cases
+
+  (define (found exp)
+    (write `(found known lambda with id ,(ast:lambda-id exp)))
+    (newline))
 
   (define (scan exp)
     (cond
      ((ast:lambda? exp)
       (for-each
         (lambda (e)
-          (scan e def-sym))
+          (scan e))
         (ast:lambda-body exp)))
      ((quote? exp) exp)
      ((const? exp) exp)
      ((ref? exp) 
       exp)
-     ((define? exp) #f) ;; TODO ??
+     ((define? exp) 
-     ((set!? exp) #f) ;; TODO ??
+      (for-each
+        (lambda (e)
+          (scan e))
+        (define->exp exp)))
+     ;((set!? exp) #f) ;; TODO ??
      ((if? exp)       
-      (scan (if->condition exp) def-sym)
+      (scan (if->condition exp))
-      (scan (if->then exp) def-sym)
+      (scan (if->then exp))
-      (scan (if->else exp) def-sym))
+      (scan (if->else exp)))
      ((app? exp)
-     )
+      (cond
+        ((ast:lambda? (car exp))
+         (found (car exp))
+         ;; Scan the rest of the args
+         (for-each
+           (lambda (e)
+             (scan e))
+           exp))
+        (else 
+          (for-each
+            (lambda (e)
+              (scan e))
+            exp))))
      (else #f)))
 
 ;(trace:error `(update-lambda-atv! ,syms ,value))
   (scan exp))
 
 ;; TEST code:
+
+;TODO: this is no good, would need to strip out lamdba AST info. maybe we can print it out or something
+;so we can correlate everything back
 (define sexp '(
- (define my-iota
+; (define my-iota
-   (lambda-11-cont
+;   (lambda-11-cont
-     (k$361 n$1$243)
+;     (k$361 n$1$243)
-     ((lambda-9
+;     ((lambda-9
-        (n$5$244 list$6$245)
+;        (n$5$244 list$6$245)
-        ((lambda-8
+;        ((lambda-8
-           (lp$2$7$246)
+;           (lp$2$7$246)
-           ((lambda-389
+;           ((lambda-389
-              (lp$2$7$246)
+;              (lp$2$7$246)
-              ((lambda-1
+;              ((lambda-1
-                 (r$363)
+;                 (r$363)
-                 ((cell-get lp$2$7$246) k$361 n$5$244 list$6$245))
+;                 ((cell-get lp$2$7$246) k$361 n$5$244 list$6$245))
-               (set-cell!
+;               (set-cell!
-                 lp$2$7$246
+;                 lp$2$7$246
-                 (lambda-7-cont
+;                 (lambda-7-cont
-                   (k$365 n$8$247 list$9$248)
+;                   (k$365 n$8$247 list$9$248)
-                   (if (zero?__inline__ n$8$247)
+;                   (if (zero?__inline__ n$8$247)
-                     (k$365 list$9$248)
+;                     (k$365 list$9$248)
-                     ((cell-get lp$2$7$246)
+;                     ((cell-get lp$2$7$246)
-                      k$365
+;                      k$365
-                      (Cyc-fast-sub n$8$247 1)
+;                      (Cyc-fast-sub n$8$247 1)
-                      (cons (Cyc-fast-sub n$8$247 1) list$9$248)))))))
+;                      (cons (Cyc-fast-sub n$8$247 1) list$9$248)))))))
-            (cell lp$2$7$246)))
+;            (cell lp$2$7$246)))
-         #f))
+;         #f))
-      n$1$243
+;      n$1$243
-      '())))
+;      '())))
  (define *size* 511)
  (define classmax 3)
  (define typemax 12)
@@ -79,22 +102,22 @@ TODO: scan for well-known lambdas:
  (define *puzzle* #f)
  (define *p* #f)
  (define fit
-   (lambda-27-cont
+   (lambda
      (k$394 i$10$249 j$11$250)
-     ((lambda-25
+     ((lambda
         (end$12$251)
-        ((lambda-23
+        ((lambda
            (lp$13$17$253)
-           ((lambda-390
+           ((lambda
               (lp$13$17$253)
-              ((lambda-12
+              ((lambda
                  (r$396)
                  ((cell-get lp$13$17$253) k$394 0))
                (set-cell!
                  lp$13$17$253
-                 (lambda-22-cont
+                 (lambda
                    (k$398 k$18$254)
-                   ((lambda-19-cont
+                   ((lambda
                       (k$402)
                       (if (Cyc-fast-gt k$18$254 end$12$251)
                         (k$402 (Cyc-fast-gt k$18$254 end$12$251))
@@ -103,7 +126,7 @@ TODO: scan for well-known lambdas:
                                    *puzzle*
                                    (Cyc-fast-plus j$11$250 k$18$254)))
                           (k$402 #f))))
-                    (lambda-15
+                    (lambda
                       (r$399)
                       (if r$399
                         (k$398 (Cyc-fast-gt k$18$254 end$12$251))
@@ -115,5 +138,7 @@ TODO: scan for well-known lambdas:
       (vector-ref *piecemax* i$10$249))))
 ))
 
-(analyze:find-known-lambdas
+(let ((ast-sexp (ast:sexp->ast sexp)))
-  (ast:sexp->ast sexp))
+  (pretty-print (ast:ast->pp-sexp ast-sexp))
+  (analyze:find-known-lambdas ast-sexp))
+;    (ast:sexp->ast sexp))