;; An init file for guile for SICP .
;; Jim Mahoney | September 2021
;; Use this with guile version 2.2
;;
;; See https://www.gnu.org/software/guile/manual/html_node/System-Commands.html
;; and reddit.com/r/guile/comments/94wdtk/
;; how_to_suppress_repetitive_and_unhelpful_guile
;;
;; high level traps : 
;; see gnu.org/software/guile/docs/docs-2.0/guile-ref/High_002dLevel-Traps.html
;;
;; time/date
;; https://www.gnu.org/software/guile/manual/html_node/SRFI_002d19.html

(use-modules (ice-9 pretty-print)
             (ice-9 readline)
             (ice-9 format)              ; and don't load srfi 
             (system vm trap-state)
             ;(srfi srfi-19)             ; time/date
             (srfi srfi-41)              ; stream primitives
             (system repl common))

;; set cons-stream (used in sicp) as an alias for stream-cons (in srfi-41)
(define-syntax cons-stream
  (syntax-rules ()
    ((_ object ...)
     (stream-cons object ...))))

;; set trace! as an alias for trace-calls-to-procedure!
(define-syntax trace!
  (syntax-rules ()
    ((_ proc)                                ; pattern
     (add-trace-at-procedure-call! proc))))  ; template

;; However, this trace! does unfortunately not behave
;; the same as the REPLY ,trace does, and in particular
;; does *not* show tail recursive procedures without indentation.
;; I'm guessing that's because it modifies the procedure
;; (by putting in a trap)  in such a way that that it
;; isn't tail-recursive any more.
;; Example:
;;
;; > (define (foo-iter i n) (if (zero? n) i) (foo-iter (1+ i) (1- n)))
;; > ,trace (foo-iter 3)
;; trace: (foo-iter 0 3)
;; trace: (foo-iter 1 2)
;; trace: (foo-iter 2 1)
;; trace: (foo-iter 3 0)
;; trace: 3
;; >
;; > (trace! foo-iter)
;;0
;; > (foo-iter 0 3)
;; Trap 0: (foo-iter 0 3)
;; Trap 0: |  (foo-iter 1 2)
;; Trap 0: |  |  (foo-iter 2 1)
;; Trap 0: |  |  |  (foo-iter 3 0)
;; Trap 0: |  |  |  3
;; Trap 0: |  |  3
;; Trap 0: |  3
;; Trap 0: 3
;; 3

;; I tried using (trace-calls-to-procedure <procedure>)
;; as described at
;; gnu.org/software/guile/docs/docs-2.0/guile-ref/Tracing-Traps.html
;; but couldn't get it to do what I expected.
;; Googling some of this, I'm seeing several recent bug
;; reports on various aspects of tracing in guile ...
;; I guess tracing just isn't robust in guile.

;; set trap! as an alias for trap-calls-to-procedure!
(define-syntax trap!
  (syntax-rules ()
    ((_ proc)                                ; pattern
     (add-trap-at-procedure-call! proc))))  ; template

;; set pp as an alias for pretty-print
;; see https://www.gnu.org/software/guile/manual/html_node/Pretty-Printing.html
(define-syntax pp
  (syntax-rules ()
    ((_ body)                         ; pattern
     (pretty-print body))))           ; template

;; turn on bouncing paren in interactive REPL
;; see https://www.gnu.org/software/guile/manual/html_node/Readline.html
(activate-readline)

;; disable history - that is, just show value of expression at REPL,
;; not "$0 = value" with a $0 or $1 or ... in each returned line.
;; reddit.com/r/scheme/comments/jwp3mk/how_can_i_disable_valuehistory_in_guile_init_file/
;; "how can I disable value-history in .guile init file?"
(repl-default-option-set! 'value-history #f)


;; --- REPL prompt ---
;; make the REPL prompt just ">" rather than "scheme@(guile-user)> "

;; ----- Here's the default prompt -------
;; see git.savannah.gnu.org/cgit/guile.git/tree/module/system/repl/common.scm
;(define (repl-prompt repl)
;  (cond
;   ((repl-option-ref repl 'prompt)
;    => (lambda (prompt) (prompt repl)))
;   (else
;    (format #f "~A@~A~A> " (language-name (repl-language repl))
;            (module-name (current-module))
;            (let ((level (length (cond
;                                  ((fluid-ref *repl-stack*) => cdr)
;                                  (else '())))))
;              (if (zero? level) "" (format #f " [~a]" level)))))))

(repl-default-option-set!
 'prompt
 (lambda (repl)
   (format "~A> "
           (let ((level (length (cond
                                 ((fluid-ref *repl-stack*) => cdr)
                                 (else '())))))
             (if (zero? level) "" (format "[~A]" level))))))

;; --- startup message ---

;; the startup message is repl-welcome repl-welcome
;; in git.savannah.gnu.org/cgit/guile.git/tree/module/system/repl/common.scm

;; old version
;(define (repl-welcome repl)
;  (display *version*)
;  (newline)
;  (newline)
;  (display "Enter `,help' for help.\n"))

;; -------------------
;; replacing that with mine ...
(set! repl-welcome
      (lambda (repl)
        (display "Guile 2.2.7. Enter ',help' for help.\n")
        (display "Language: scheme for SICP with some extras. \n")))

;; and a few other customizations.

; alias for lambda
(define-syntax λ
  (syntax-rules ()
    ((_ args body ...)          ; pattern
     (lambda args body ...))))  ; template

;; -- evaluation and expressions

; set "evald" to be "eval with default enviroment"
(define-syntax evald
  (syntax-rules ()
    ((_ expression)                                ; pattern 1
     (eval expression (interaction-environment)))  ; template 1
    ((_ expression environment)         ; pattern 2
     (eval expression environment))))   ; template 2

; set "evalq" to be "eval-quote with default environment"
; ... so that at the REPL, typing "(evalq a)" is the same as typing "a"
(define-syntax evalq
  (syntax-rules ()
    ((_ expression) (eval 'expression (interaction-environment)))))

(define (string->expression s)
  ;; (string->expression "(+ 1 2)") => (+ 1 2)
  (eval-string (string-append "'" s)))

(define-syntax expression->string
  ;; (expression->string (+ 1 2))  => "(+ 1 2)"
  (syntax-rules ()
    ((_ expression)
     (format #f "~s" (quote expression)))))

;; also see string->symbol and symbol->string

;; -- time 

(define (runtime)
  ;; time since epoch in microseconds
  ;; for SICP exercise 1.22
  (* 1000000 (/ (tms:clock (times)) internal-time-units-per-second)))

;; -- printing

(define-syntax printf
  ;; note: required 2nd arg of format is #f for guile printing
  (syntax-rules ()
    ((_ args body ...)                       ; pattern
     (display (format #f args body ...)))))  ; template

;; $ schemeg  # supports "f" floating point format with width :
;; > (printf "** ~a ~5f **" "sqrt(5) is" (sqrt 5))
;; ** sqrt(5) is 2.236 **
;;
;; However, racket does not understand "f" in formats.
;; One way to do this with racket uses this sort of construct :
;; $ schemer
;; > (~a (sqrt 5) #:width 5)
;; "2.236"

;; ------------------------------
;; a simple implementation of a pythonic "assert"
;; example :
;;   (assert (equal? (car (list 1 2 ))  1))  ; test is true, so does nothing.
;;   (assert (equal? (car (list 1 2 )) 10))  ; test is false, so throws error.
(define-syntax assert
  (syntax-rules ()                    ;; symbols to match and ignore in pattern
    ((_ boolean-expression)           ;; pattern
     (if (not boolean-expression)     ;; replace with 
         (error (format #f "Oops - assertion error in ~a ."
                           'boolean-expression))))))
;; ---------------------------------------------------------

;; some typical lisp-isms

(define (1+ n) (+ n 1))  ;; some schemes seem to have these built in.
(define (1- n) (- n 1))
(define (inc n) (+ n 1))  ;; ... and some seem to have these built in.
(define (dec n) (- n 1))

;; -- aliases

;; See https://en.wikipedia.org/wiki/Cons

;; Jim's English-ish equivalents
(define true #t)
(define false #f)
(define nil '())
(define pair cons)      ; (pair 1 2)              => (1 . 2)
(define second cadr)    ; (second (list 1 2 3 4)) => 2
(define third caddr)    ; (third (list 1 2 3 4))  => 3
(define fourth cadddr)  ; (fourth (list 1 2 3 4)) => 4
(define (nth n items)   ; (nth 3 '(0 1 2 3 4 5))  => 3
  (if (= 0 n)
      (car items)
      (nth (- n 1) items)))

;; Haskell equivalents
(define fst car)        ; (fst (pair 1 2))        => 1
(define snd cdr)        ; (snd (pair 1 2))        => 2

;; Closure equivalents
(define first car)      ; (first (list 1 2 3 4))  => 1
(define rest cdr)       ; (rest (list 1 2 3 4))   => (2 3 4)

;; -- distinguish between schemeg and schemer

(define guile? #t)
(define racket? #f)