From aef9ae1c8e4c1e256edde5ab842d20d558202ee2 Mon Sep 17 00:00:00 2001
From: shhyou <shu-hung.you@eecs.northwestern.edu>
Date: Thu, 24 Oct 2024 21:08:06 -0500
Subject: [PATCH] Enable the `use-function-output-syntax` option for ISL and
 plus. Fixes #208.

The printer for ISL, ISL+ and ASL relies on use-named/undefined-handler
and named/undefined-handler to correctly print named lambdas.
In particular, use-named/undefined-handler checks whether the option
use-function-output-syntax is set.

If use-function-output-syntax is not enabled, then during module
instantiation, user-written functions like my-add1 would be printed differently.
This also affects the error message from the check-expects.

    #lang htdp/isl+
    (define (my-add1 n) (+ n 1))
    my-add1
    (check-expect my-add1 2)

Output:

    Welcome to DrRacket.
    (lambda (a1) ...)

    Ran 1 test.
    0 tests passed.

    check-expect ... error ... :: first argument of equality cannot
    be a function, given (lambda (a1) ...)

    > my-add1
    my-add1
---
 htdp-lib/htdp/bsl/runtime.rkt                |  5 +++--
 htdp-lib/lang/htdp-langs.rkt                 |  2 ++
 htdp-lib/lang/private/teach-module-begin.rkt |  5 ++++-
 htdp-lib/lang/private/teach.rkt              | 14 ++++++++++++--
 htdp-test/tests/htdp-lang/intm-lam.rktl      |  5 -----
 5 files changed, 21 insertions(+), 10 deletions(-)

diff --git a/htdp-lib/htdp/bsl/runtime.rkt b/htdp-lib/htdp/bsl/runtime.rkt
index 9fe9def4e..39de0f746 100644
--- a/htdp-lib/htdp/bsl/runtime.rkt
+++ b/htdp-lib/htdp/bsl/runtime.rkt
@@ -87,10 +87,11 @@
      (and (sl-runtime-settings-use-function-output-syntax? settings)
           (procedure? x)
           (object-name x))))
+  ;; The ISL case -- sl-runtime-settings-output-function-instead-of-lambda? --
+  ;; is already covered by the current-print-convert-hook above.
   (named/undefined-handler
    (lambda (x)
-     (string->symbol
-      (format "function:~a" (object-name x)))))
+     (object-name x)))
 
   ; sharing done by print-convert
   (show-sharing (sl-runtime-settings-show-sharing? settings))
diff --git a/htdp-lib/lang/htdp-langs.rkt b/htdp-lib/lang/htdp-langs.rkt
index aec0c43a9..6e2fcbac9 100644
--- a/htdp-lib/lang/htdp-langs.rkt
+++ b/htdp-lib/lang/htdp-langs.rkt
@@ -1022,6 +1022,7 @@
          (language-numbers '(-500 -500 5))
          (sharing-printing #t)
          (abbreviate-cons-as-list #t)
+         (use-function-output-syntax? #t)
          (allow-sharing? #t)
          (reader-module '(lib "htdp-advanced-reader.ss" "lang"))
          (debugger:supported #t)
@@ -1051,6 +1052,7 @@
          (language-numbers '(-500 -500 4))
          (sharing-printing #f)
          (abbreviate-cons-as-list #t)
+         (use-function-output-syntax? #t)
          (allow-sharing? #f)
          (reader-module '(lib "htdp-intermediate-lambda-reader.ss" "lang"))
          (stepper:supported #t)
diff --git a/htdp-lib/lang/private/teach-module-begin.rkt b/htdp-lib/lang/private/teach-module-begin.rkt
index 4f6fc4ac3..ab2866f3f 100644
--- a/htdp-lib/lang/private/teach-module-begin.rkt
+++ b/htdp-lib/lang/private/teach-module-begin.rkt
@@ -184,11 +184,14 @@
                         output-function-instead-of-lambda))
      (mk-module-begin '(abbreviate-cons-as-list
                         read-accept-quasiquote
+                        use-function-output-syntax
                         output-function-instead-of-lambda))
      (mk-module-begin '(abbreviate-cons-as-list
-                        read-accept-quasiquote))
+                        read-accept-quasiquote
+                        use-function-output-syntax))
      (mk-module-begin '(abbreviate-cons-as-list
                         read-accept-quasiquote
+                        use-function-output-syntax
                         show-sharing))
 
      ;; module-continue
diff --git a/htdp-lib/lang/private/teach.rkt b/htdp-lib/lang/private/teach.rkt
index c0c377eed..6c7240b16 100644
--- a/htdp-lib/lang/private/teach.rkt
+++ b/htdp-lib/lang/private/teach.rkt
@@ -164,6 +164,14 @@
 (define-for-syntax (stepper-ignore-checker stx)
   (stepper-syntax-property stx 'stepper-skipto '(syntax-e cdr syntax-e cdr car)))
 
+
+;; wrap-lambda-remove-name: syntax? -> syntax?
+;;   Removes source-location names for lambdas by erasing the source location
+;;   Preserves the lexical context, the syntax properties, but removes the source location
+(define-for-syntax (wrap-lambda-remove-name stx)
+  (cond [(syntax-local-name) stx]
+        [else (datum->syntax stx (syntax-e stx) #f stx)]))
+
 (define-for-syntax (map-with-index proc . lists)
   (let loop ([i 0] [lists lists] [rev-result '()])
     (if (null? (car lists))
@@ -2297,7 +2305,8 @@
                                      stx
                                      (syntax->list (syntax (lexpr ...)))
                                      args)
-            (syntax/loc stx (lambda arg-seq lexpr ...)))]
+            (wrap-lambda-remove-name
+             (syntax/loc stx (lambda arg-seq lexpr ...))))]
          ;; Bad lambda because bad args:
          [(_ args . __)
           (teach-syntax-error
@@ -2504,7 +2513,8 @@
                                      stx
                                      (syntax->list (syntax exprs))
                                      names)
-            (syntax/loc stx (lambda (name ...) . exprs)))]
+            (wrap-lambda-remove-name
+             (syntax/loc stx (lambda (name ...) . exprs))))]
          [(_ args . __)
           (teach-syntax-error
            'lambda
diff --git a/htdp-test/tests/htdp-lang/intm-lam.rktl b/htdp-test/tests/htdp-lang/intm-lam.rktl
index c3d301f88..17e3bddfc 100644
--- a/htdp-test/tests/htdp-lang/intm-lam.rktl
+++ b/htdp-test/tests/htdp-lang/intm-lam.rktl
@@ -3,11 +3,6 @@
     exn:fail:contract?
     #rx"map: first argument must be a function that expects one argument"))
 
-(htdp-err/rt-test (map (lambda (x y) (+ x y)) (list 2 3 4))
-  (exn-type-and-msg
-    exn:fail:contract?
-    #rx"intm-lam.rktl"))
-
 (htdp-err/rt-test (foldr (lambda (x y) (+ x y)) 0 (list 2 3 4) (list 2 3 4))
   (exn-type-and-msg
     exn:fail:contract?