הכנה לבחינה

(define-datatype expression expression?עץ התחביר לכל הפקודות בשפת LET
  (const-exp (num number?))
  (diff-exp (exp1 expression?) (exp2 expression?))
  (zero?-exp (exp1 expression?))
  (if-exp (exp1 expression?) (exp2 expression?) (exp3 expression?))
  (var-exp (var symbol?))
  (let-exp (var symbol?) (exp1 expression?) (body expression?)))

(define-datatype expval expval?ערך מבוטא יכול להיות מספר או בוליאני
  (num-val (num number?))
  (bool-val (bool boolean?)))

(define expval->numחילץ המספר מתוך ערך מבוטא (או זריקת שגיאה)
  (lambda (val)
    (cases expval val
      (num-val (num) num)
      (else (report-expval-extractor-error 'num val)))))

(define expval->boolחילץ הבוליאני מתוך ערך מבוטא (או זריקת שגיאה)
  (lambda (val)
    (cases expval val
      (bool-val (bool) bool)
      (else (report-expval-extractor-error 'bool val)))))

(define runנקודת הכניסה. מפרסרת מחרוזת ל-AST, ומריצה את התוכנית.
  (lambda (string)
    (value-of-program (scan&parse string))))

(define value-of-programמריצה תוכנית (שמכילה ביטוי ראשי אחד) על סביבה התחלתית (init-env).
  (lambda (pgm)
    (cases program pgm
      (a-program (exp1)
        (value-of exp1 (init-env))))))

(define-datatype proc proc?סגור (Closure) - מכיל את שם המשתנה, גוף הפונקציה, והכי חשוב: הסביבה שבה הוגדרה הפונקציה.
  (procedure
    (bvar symbol?)
    (body expression?)
    (saved-env environment?)))

(define apply-procedureאיך מפעילים פונקציה?
  (lambda (proc1 val)
    (cases proc proc1
      (procedure (var body saved-env)
        (value-of body (extend-env var val saved-env))))))מריצים את גוף הפונקציה (body) עם סביבה מורחבת (saved-env ביחד עם המשתנה החדש).

(define-datatype expval expval?
  (num-val (value number?))
  (bool-val (boolean boolean?))
  (proc-val (proc proc?))הוספת פרוצדורה כסוג ערך לגיטימי בשפה)

(define expval->proc
  (lambda (v)
    (cases expval v
      (proc-val (proc) proc)
      (else (expval-extractor-error 'proc v)))))

(define-datatype environment environment?
  (empty-env)
  (extend-env 
    (bvar symbol?)
    (bval expval?)
    (saved-env environment?))
  (extend-env-rec
    (p-name symbol?)
    (b-var symbol?)
    (p-body expression?)
    (saved-env environment?))סביבה רקורסיבית מיוחדת ששומרת פונקציה!)

Expression ::= %lexref number
               nameless-var-exp (num)משתנה חסר שם שמיוצג על ידי עומק השיוך (Lexical Address) שלו בסביבה.
               
Expression ::= %let Expression in Expression
               nameless-let-exp (exp1 body)בלוק let חסר שם, לא צריך לדעת את שם המשתנה המקומי כי המשתנים בפנים מתייחסים אליו דרך ה-Lexical Address.

Expression ::= %lexproc Expression
               nameless-proc-exp (body)הגדרת פרוצדורה ללא ציון שם הפרמטר שלה. הארגומנט שיוזן לה ימוקם באינדקס 0.

(define translation-of
  (lambda (exp senv)
    (cases expression exp
      (const-exp (num) (const-exp num))
      (var-exp (var)
        (nameless-var-exp
          (apply-senv senv var)))ממירים משתנה שמי למשתנה חסר שם שמכיל את אינדקס המרחק שלו (de Bruijn Index).
      (zero?-exp (exp1)
        (zero?-exp (translation-of exp1 senv)))
      (let-exp (var exp1 body)
        (nameless-let-exp
          (translation-of exp1 senv)
          (translation-of body (extend-senv var senv))))מתרגמים את הגוף תחת סביבה סטטית מורחבת המכילה את שם המשתנה החדש (var) בעמדה 0.
      (proc-exp (var body)
        (nameless-proc-exp
          (translation-of body (extend-senv var senv))))בדומה ל-let, מתרגמים את הפונקציה כאשר הארגומנט שלה מעשיר את הסביבה הסטטית. שמה של הפונקציה נשמט!
      ...)))

(define nameless-environment?
  (lambda (x)
    ((list-of expval?) x)))הסביבה היא רשימת ערכים פשוטה.

(define apply-nameless-env
  (lambda (nenv n)
    (list-ref nenv n)))גישה ישירה לאינדקס באמצעות list-ref המובנה של Scheme! פשוט ויעיל.

(define apply-procedure
  (lambda (proc1 val)
    (cases proc proc1
      (procedure (body saved-env)
        (value-of body (extend-nameless-env val saved-env)))הארגומנט נדחף למקום ה-0 ברשימת הערכים השמורה.))))

Expression ::= begin Expression {; Expression}* end
               begin-exp (exp1 exps)מבנה השלם (AST) של begin הכולל את הביטוי הראשון ורשימה של שאר הביטויים.

Expression ::= newref (Expression)
               newref-exp (exp1)יצירת תא חדש.

Expression ::= deref (Expression)
               deref-exp (exp1)קריאה מתא קיים.

Expression ::= setref (Expression , Expression)
               setref-exp (exp1 exp2)כתיבה לתא קיים (exp1 מכיל את ההפניה, exp2 מכיל את הערך החדש).

(define empty-store
  (lambda () '()))

(define the-store 'uninitialized)משתנה גלובלי שמייצג את החנות לאורך כל זמן הריצה.

(define get-store
  (lambda () the-store))

(define initialize-store!
  (lambda ()
    (set! the-store (empty-store))))שימוש ב-set! פנימי של Scheme כדי לשנות את מצב החנות לרשימה ריקה.

(define reference?
  (lambda (v)
    (integer? v)))מצביע בזיכרון מיוצג באופן פשוט וקומפקטי על ידי מספר שלם (האינדקס ברשימה).

(define newref
  (lambda (val)
    (let ((next-ref (length the-store)))האינדקס הבא הוא בדיוק אורך הרשימה הנוכחי.
      (set! the-store (append the-store (list val)))מוסיפים את הערך החדש לסוף הזיכרון.
      next-ref)))

(define deref
  (lambda (ref)
    (list-ref the-store ref)))

(define setref!
  (lambda (ref val)
    (set! the-store
      (letrec
        ((setref-inner
           (lambda (store1 ref1)
             (cond
               ((null? store1)
                (report-invalid-reference ref the-store))
               ((zero? ref1)
                (cons val (cdr store1)))הגענו למיקום המבוקש: מחליפים את ראש הרשימה (car) בערך החדש (val) ומחברים להמשך (cdr).
               (else
                (cons
                  (car store1)
                  (setref-inner
                    (cdr store1) (- ref1 1))))))))
        (setref-inner the-store ref)))))

(cases expression exp
  ...
  (newref-exp (exp1)
    (let ((v1 (value-of exp1 env)))
      (ref-val (newref v1))))יוצרים הצבעה חדשה בזיכרון ועוטפים אותה בסוג ref-val המוגדר כ-ExpVal.

  (deref-exp (exp1)
    (let ((v1 (value-of exp1 env)))
      (let ((ref1 (expval->ref v1)))
        (deref ref1))))מחלצים את מיקום ההצבעה מהערך, ושולפים מתוכו את המידע דרך deref.

  (setref-exp (exp1 exp2)
    (let ((ref (expval->ref (value-of exp1 env))))
      (let ((val2 (value-of exp2 env)))
        (begin
          (setref! ref val2)קריאה ל-setref! שמעדכנת את הזיכרון הגלובלי באמצעות set! פנימי.
          (num-val 23))))))החזרת ערך סרק מכיוון שפקודת השמה לא אמורה לשמש כביטוי המחזיר מידע.

Expression ::= set Identifier = Expression
               assign-exp (var exp1)ביטוי AST מסוג assign-exp. הוא יאתר את מיקום המשתנה בזיכרון, ויכתוב לתוכו את ערך הביטוי.

(value-of (assign-exp var exp1) ρ σ)
  = let (val, σ1) = (value-of exp1 ρ σ)
    in let l = (apply-env ρ var)מוצאים את המיקום l של המשתנה var.
       in (num-val(27), (setref σ1 l val)כותבים לחנות את הערך המחושב באותו מיקום l בדיוק.)

(value-of (call-exp rator rand) ρ σ)
  = let (proc, σ1) = (value-of rator ρ σ)
    in let (val, σ2) = (value-of rand ρ σ1)
       in let (l, σ3) = (newref σ2 val)ב-Call-by-Value אנו מקצים מיקום *חדש* l עבור הארגומנט בזיכרון (העותק המקומי), ומעבירים אותו פנימה לפרוצדורה.
          in (apply-procedure proc l σ3)

(let-exp (var exp1 body)
  (let ((v1 (value-of exp1 env)))
    (value-of body
      (extend-env var (newref v1) env))))מרחיבים את הסביבה כך שהשם var יצביע למיקום החדש שהוקצה ב-Store!

(define apply-procedure
  (lambda (proc1 val)
    (cases proc proc1
      (procedure (var body saved-env)
        (value-of body
          (extend-env var (newref val) saved-env))))))באופן דומה, משתנה הפונקציה (var) מוצמד להקצאת זיכרון טרייה המכילה את הארגומנט (val) - מודל ה-Call-by-Value בשיאו.

ExpVal = Int + Bool + Proc + MutPair
MutPair = Ref(ExpVal) x Ref(ExpVal)צמד שמורכב משתי כתובות בזיכרון.
DenVal  = Ref(ExpVal)

(define value-of-operand
  (lambda (exp env)
    (cases expression exp
      (var-exp (var) (apply-env env var))מפתח ההבדל! במידה והארגומנט הוא משתנה קיים, מחזירים רק את ה-Ref שלו מהסביבה, ללא יצירת עותק.
      (else
       (newref (value-of exp env))))))אם הארגומנט הוא ביטוי רגיל (נניח 5+3), מחשבים אותו ומקצים עבורו תא חדש.

(define apply-procedure
  (lambda (proc1 val)
    (cases proc proc1
      (procedure (var body saved-env)
        (value-of body
          (extend-env var val saved-env))))))כעת val הוא תמיד מיקום (Ref), בין אם מצביע מקורי או חדש. אנחנו מכניסים אותו ישירות ל-Environment.

ExpVal = Int + Bool + Proc
DenVal = Ref(ExpVal + Thunk)שימו לב: הסביבה ממפה כעת לתאים בזיכרון שיכולים להכיל או ערך ממשי (ExpVal) או ביטוי מוקפא שממתין לחישוב (Thunk).
Thunk  = Exp x EnvThunk שקול מבחינה מתמטית למכפלה הקרטזית של ביטוי וסביבה. זהו בדיוק המידע הדרוש כדי לחשב אותו בעתיד.

(cases expression exp
  ...
  (var-exp (var)
    (let ((ref1 (apply-env env var)))
      (let ((w (deref ref1)))
        (if (expval? w)
            w
            (value-of-thunk w))בודק מה הוצאנו מהזיכרון. אם זה ערך מוגמר (למשל כי ביצענו השמה), פשוט מחזיר. אחרת, מעריך את ה-Thunk בעזרת value-of-thunk!)))

(cases expression exp
  ...
  (var-exp (var)
    (let ((ref1 (apply-env env var)))
      (let ((w (deref ref1)))
        (if (expval? w)
            w
            (let ((val1 (value-of-thunk w)))
              (begin
                (setref! ref1 val1)
                val1))זהירות: Memoization! חישבנו את ה-thunk לערך (val1), שמרנו אותו בחזרה לתא הזיכרון (ref1), והחזרנו. בפעם הבאה שנקרא למשתנה var, הוא יחזיר את הערך ישירות מ-(expval? w) ולא יגיע לכאן!)))))

(define value-of
  (lambda (exp env)
    (cases expression exp
      (const-exp (num) (num-val num))
      (var-exp (var) (apply-env env var))
      (proc-exp (var body)
        (proc-val (procedure var body env)))
      (letrec-exp (p-name b-var p-body letrec-body)
        (value-of letrec-body (extend-env-rec p-name b-var p-body env)))
      (zero?-exp (exp1)
        (let ((val1 (value-of exp1 env)))קריאה "עמוקה" המייצרת תלות והמתנה. המפרש ממתין לתוצאה כדי להמשיך בשורות הבאות.
          (let ((num1 (expval->num val1)))
            (if (zero? num1) (bool-val #t) (bool-val #f)))))
      ...)))

(define value-of/k
  (lambda (exp env cont)
    (cases expression exp
      (const-exp (num) (apply-cont cont (num-val num))אין המתנה. לוקחים את ההמשכיות 'cont' ומפעילים אותה מיד על הערך 'num-val num'.)
      (var-exp (var) (apply-cont cont (apply-env env var)))
      (proc-exp (var body)
        (apply-cont cont (proc-val (procedure var body env))))
      ...)))

(define value-of/k
  (lambda (exp env cont)
    (cases expression exp
      ...
      (letrec-exp (p-name b-var p-body letrec-body)
        (value-of/k letrec-body
          (extend-env-rec p-name b-var p-body env)
          cont)קריאת זנב: אנחנו מעבירים לביטוי הפנימי את 'cont' בשלמותו. המפרש לא צריך לחכות לתוצאה כאן.)
      ...)))

(define value-of/k
  (lambda (exp env cont)
    (cases expression exp
      ...
      (let-exp (var exp1 body)
        (value-of/k exp1 env
          (let-exp-cont var body env cont))חשב את exp1, וכשתסיים - תפעיל את 'let-exp-cont' שבו שמרנו את 'var', את 'body', את הסביבה הנוכחית ואת ה-cont המקורי.)
      ...)))

(define apply-cont
  (lambda (cont val)
    (cases continuation cont
      ...
      (let-exp-cont (var body saved-env saved-cont)
        (value-of/k body
          (extend-env var val saved-env)
          saved-cont)מחשב את ה-body עם הסביבה המורחבת. הקריאה הזו מחליפה את ההמתנה הקודמת שהייתה למפרש!)
      ...)))

(define-datatype continuation continuation?
  (a-cont
    (procedure procedure?)))

(define apply-cont
  (lambda (cont val)
    (cases continuation cont
      (a-cont (procedure)
        (procedure val)פשוט מפעילים את הפונקציה (ששמורה בתוך המבנה) עם הערך שסופק!))))

(define end-cont
  (lambda ()
    (a-cont
      (lambda (val)
        (begin
          (eopl:printf "End of computation.~%")
          val))פונקציה זו היא ה-"המשכיות העליונה". כשהיא רצה, היא מסיקה את הריצה.)))

(define zero1-cont
  (lambda (saved-cont)
    (a-cont
      (lambda (val)
        (apply-cont saved-cont
          (bool-val
            (zero? (expval->num val))))))))

(define-datatype continuation continuation?
  (end-cont)
  (zero1-cont
    (saved-cont continuation?))
  (let-exp-cont
    (var identifier?)
    (body expression?)
    (saved-env environment?)
    (saved-cont continuation?))
  (if-test-cont
    (exp2 expression?)
    (exp3 expression?)
    (saved-env environment?)
    (saved-cont continuation?)כל המשכיות מחזיקה מצביע ל-saved-cont. זהו בעצם "רשימה מקושרת" של משימות עתידיות שמהוות את ה-Call Stack המפורש שלנו!))

(define value-of/k
  (lambda (exp env cont)
    (cases expression exp
      ...
      (call-exp (rator rand)
        (value-of/k rator env
          (rator-cont rand env cont))שלח את הפונקציה (rator) לחישוב. כשהיא תחזור, נטפל ב-rand.)
      ...)))

(define apply-cont
  (lambda (cont val)
    (cases continuation cont
      ...
      (rator-cont (rand saved-env saved-cont)
        (value-of/k rand saved-env
          (rand-cont val saved-cont))הפונקציה חזרה (כעת שמורה ב-val). נשלח את rand לחישוב, ונעביר את 'val' להמשכיות.)
      ...)))

(define apply-cont
  (lambda (cont val)
    (cases continuation cont
      ...
      (rand-cont (val1 saved-cont)
        (let ((proc (expval->proc val1)))
          (apply-procedure/k proc val saved-cont)שולחים את הפונקציה לריצה, ואומרים לה: "העבירי את התוצאה הסופית ישירות ל-saved-cont המקורי!". זוהי ליבת ה-Tail Call Optimization האוטומטית.))
      ...)))

(define apply-procedure/k
  (lambda (proc1 val cont)
    (cases proc proc1
      (procedure (var body saved-env)
        (value-of/k body
          (extend-env var val saved-env)
          cont)))))

letrec
  index (n, lst) =
    if null?(lst)
    then raise 99עוצר מיד את הריצה, זורק את כל ההמשכיות הנוכחית ומחפש באופן דינמי את ה-try שעטף את הריצה.
    else if zero?(-(car(lst), n))
         then 0
         else -((index n cdr(lst)), -1)
in try (index 5 list(2, 7, 1, 9, 5, 8))
   catch (x) -1מגדיר "המשכיות הצלה" (handler). אם מישהו יזרוק שגיאה בתוך ה-try, הערך שלו ייכנס ל-x ויוחזר -1.

(define value-of/k
  (lambda (exp env cont)
    (cases expression exp
      ...
      (try-exp (exp1 var handler-exp)
        (value-of/k exp1 env
          (try-cont var handler-exp env cont))מחשב את הקוד הרגיל. ההמשכיות try-cont 'זוכרת' שאם הכל בסדר, פשוט ממשיכים רגיל. אם תהיה שגיאה, נחזור לפה.)
      (raise-exp (exp1)
        (value-of/k exp1 env
          (raise1-cont cont))מחשב את הערך שצריך לזרוק כשגיאה.)
      ...)))

(define apply-cont
  (lambda (cont val)
    (cases continuation cont
      ...
      (try-cont (var handler-exp saved-env saved-cont)
        (apply-cont saved-cont val)סיום תקין של ה-try! הכל עבר בשלום. מתעלמים לחלוטין מה-handler וממשיכים ל-saved-cont עם התוצאה שיצאה (val).)
      (raise1-cont (saved-cont)
        (apply-handler val saved-cont)ערך השגיאה (val) מחושב ומוכן. עכשיו אנחנו זורקים אותו לאוויר, ושולחים את apply-handler לחטט אחורה ב-Call Stack (saved-cont) ולמצוא לו Handler!)
      ...)))

let x = 2
in letrec
     foo(n) = if zero?(n)
              then x
              else -((foo -(n,1)), -2)
   in spawn(foo(4))יוצר תהליכון חדש שיחשב את (foo 4), ומוסיף אותו לתור הסדרן. ה-Main Thread ממשיך הלאה מיד!

letrec
  wait(k) = if zero?(k) then 0 else (wait -(k, 1))פונקציית 'בזבוז זמן'. סופרת אחורה כדי לבזבז פעולות חישוב.
  producer(n) =
    if zero?(n)
    then print("producer finished")
    else begin
           print(n);
           (wait 5);גורמת לסדרן לבצע החלפת הקשר (Context Switch) אל הצרכן.
           (producer -(n, 1))
         end
  consumer(n) =
    if zero?(n)
    then print("consumer finished")
    else begin
           print(-(-(n, 0)));
           (wait 14);
           (consumer -(n, 1))
         end
in begin
     spawn((producer 4));מייצר תהליכון משנה עבור המפיק.
     (consumer 4)מריץ את הצרכן בתהליכון הראשי במקביל.
   end

(define apply-cont
  (lambda (cont val)
    (if (time-expired?)
        (begin
          (place-on-ready-queue!
            (lambda () (apply-cont cont val)))נגמר הזמן! מקפיאים את הריצה לתוך Thunk שדוחף את ה-cont וה-val, ושמים בתור. זהו לב ה-Context Switch המקדים (Preemptive).
          (run-next-thread)מעבירים את השליטה לסדרן.)
        (begin
          (decrement-timer!)כל צעד חישוב (apply-cont) עולה "טיק" אחד.
          (cases continuation cont
            (end-main-thread-cont ()
              (set-final-answer! val)
              (run-next-thread))
            (end-subthread-cont ()
              (run-next-thread)אם תהליכון משנה סיים את משימתו (מבלי שנגמר זמנו), מיד מריצים את הבא בתור.)
            ...)))))

let m = newmutex()יצירת אובייקט מנעול חדש במערכת.
in let x = 0
   in letrec
        wait(k) = if zero?(k) then 0 else (wait -(k, 1))
        incr_x(id) =
          begin
            wait-for-mutex(m);נעילת המיוטקס. אם תהליכון אחר תפס אותו, התהליכון הזה יכנס לתור המתנה בתוך המיוטקס.
            set x = -(x, -1);
            print(x);
            signal-mutex(m)שחרור המיוטקס. יעיר את התהליכון הראשון שמחכה בתור שלו.
          end
      in begin
           spawn((incr_x 100));
           spawn((incr_x 200));
           spawn((incr_x 300))
         end

(define fact
  (lambda (n)
    (fact/k n (lambda (val) val))קריאה התחלתית עם המשכיות הזהות (מחזירה פשוט את הערך).))

(define fact/k
  (lambda (n cont)
    (if (zero? n)
        (cont 1)תנאי העצירה קורא להמשכיות עם הערך 1.
        (fact/k (- n 1)
          (lambda (val)
            (cont (* n val)))ההמשכיות העתידית: "כשתסיים את (- n 1) ותחזיר val, תכפיל את n ב-val ותקרא להמשכיות המקורית".))))

(define-datatype continuation continuation?
  (end-cont)
  (fact1-cont
    (n integer?)
    (cont continuation?)))

(define apply-cont
  (lambda (cont val)
    (cases continuation cont
      (end-cont ()
        (begin
          (eopl:printf "End of computation.~%")
          val))
      (fact1-cont (saved-n saved-cont)
        (apply-cont saved-cont
          (* saved-n val))מבצע את הפעולה (הכפלה ב-n) ועובר להמשכיות הבאה.))))

(define n 'uninitialized)
(define cont 'uninitialized)
(define val 'uninitialized)

(define fact/k
  (lambda ()
    (if (zero? n)
        (begin
          (set! val 1)מכניס את התוצאה לאוגר val.
          (apply-cont)קופץ להמשכיות (שלוקחת את הערכים מהאוגרים).)
        (begin
          (set! cont (fact1-cont n cont))
          (set! n (- n 1))
          (fact/k)הקריאה הרקורסיבית היא קריאה ללא ארגומנטים!))))

(define fact/k
  (lambda ()
    (if (zero? n)
        (begin
          (set! val 1)
          apply-cont)
        (begin
          (set! cont (fact1-cont n cont))
          (set! n (- n 1))
          fact/kמחזיר את הפונקציה עצמה (ללא סוגריים), כך שה-Trampoline יפעיל אותה מבחוץ.))))

(define trampoline
  (lambda (bounce)
    (if (procedure? bounce)
        (trampoline (bounce))מפעיל את התהליכון/פונקציה, ותופס את ה-Bounce הבא שחוזר.
        bounce)))

(define fib/k
  (lambda (n cont)
    (if (< n 2)
        (cont 1)
        (fib/k (- n 1)
          (lambda (val1)
            (fib/k (- n 2)
              (lambda (val2)
                (cont (+ val1 val2))))))שרשור (Nesting) של המשכיות: חכה ל-fib(n-1), ואז חכה ל-fib(n-2), ואז חבר אותם!)))

;; Source:
(define f
  (lambda (x y)
    (cond
      ((zero? x) 0)
      ((zero? y) (f (- x 1) (- y 1)))
      (else (f x (- y 1))))))

;; CPS:
(define f/k
  (lambda (x y k)
    (cond
      ((zero? x) (k 0)עטוף את הפלט בהמשכיות.)
      ((zero? y) (f/k (- x 1) (- y 1) k)העבר את k כארגומנט לפונקציה המומרת הבאה.)
      (else (f/k x (- y 1) k)))))

(define value-of-cps
  (lambda (exp env)
    (cases cps-out-exp exp
      (cps-simple-exp->exp (simple)
        (value-of-simple-exp simple env))
      (cps-let-exp (var exp1 body)
        (let ((val (value-of-simple-exp exp1 env)))
          (value-of-cps body
            (extend-env var val env))))
      (cps-call-exp (rator rands)
        (let ((rator-proc
                (expval->proc (value-of-simple-exp rator env)))
              (rand-vals
                (map
                  (lambda (simple)
                    (value-of-simple-exp simple env))
                  rands)))
          (apply-procedure rator-proc rand-vals)קריאה ללא כל חזרה (Tail call טהור).))
      ...)))

(define make-send-to-cont
  (lambda (k-exp simple-exp)
    (cps-call-exp k-exp (list simple-exp))יוצר קריאה אסטית המייצגת הפעלה של k על הפלט.))

(define cps-of-exp
  (lambda (exp cont-exp)
    (cases expression exp
      ...
      (proc-exp (vars body)
        (make-send-to-cont cont-exp
          (cps-proc-exp (append vars (list 'k%00))מוסיף פרמטר קסם "k%00" לכל פונקציה!
            (cps-of-exp body (cps-var-exp 'k%00)))))
      (call-exp (rator rands)
        (cps-of-call-exp rator rands cont-exp))
      ...)))

(define cps-of-call-exp
  (lambda (rator rands cont-exp)
    (cps-of-exps (cons rator rands)מחשב מראש (על ידי בניית מבני CPS מקוננים) את ה-rator וה-rands כדי שכולם יהיו אטומים.
      (lambda (simples)
        (cps-call-exp
          (car simples)
          (append (cdr simples) (list cont-exp))מרכיב את הקריאה הסופית עם cont-exp בתור הארגומנט האחרון!)))))

(define cps-of-exps
  (lambda (exps builder)
    (let cps-of-rest ((exps exps))
      (let ((pos (list-index
                   (lambda (exp)
                     (not (inp-exp-simple? exp))מוצאת את הביטוי הראשון שאינו "אטום" (שדורש חישוב מורכב).)
                   exps)))
        (if (not pos)
            (builder (map cps-of-simple-exp exps))
            (let ((var (fresh-identifier 'var)))
              (cps-of-exp
                (list-ref exps pos)
                (cps-proc-exp (list var)
                  (cps-of-rest
                    (list-set exps pos (var-exp var))))יוצרת המשכיות שתתפוס את התוצאה למשתנה "var", ומחליפה את הביטוי המסובך במשתנה זה להמשך הסריקה.)))))))

(define cps-of-simple-exp
  (lambda (exp)
    (cases expression exp
      (const-exp (num) (cps-const-exp num))
      (var-exp (var) (cps-var-exp var))
      (diff-exp (exp1 exp2)
        (cps-diff-exp
          (cps-of-simple-exp exp1)
          (cps-of-simple-exp exp2)))
      (zero?-exp (exp1)
        (cps-zero?-exp
          (cps-of-simple-exp exp1)))
      (proc-exp (ids exp)
        (cps-proc-exp (append ids (list 'k%00))
          (cps-of-exp exp (cps-var-exp 'k%00))))
      (sum-exp (exps)
        (cps-sum-exp
          (map cps-of-simple-exp exps)))
      (else
        (report-invalid-exp-to-cps-of-simple-exp exp)))))

(define cps-of-exp
  (lambda (exp cont-exp)
    (cases expression exp
      (const-exp (num) (make-send-to-cont cont-exp (cps-const-exp num))שולח את המספר להמשכיות. קריאת CPS פשוטה.)
      (var-exp (var) (make-send-to-cont cont-exp (cps-var-exp var)))
      (proc-exp (vars body)
        (make-send-to-cont cont-exp
          (cps-proc-exp (append vars (list 'k%00))
            (cps-of-exp body (cps-var-exp 'k%00)))))
      (zero?-exp (exp1)
        (cps-of-zero?-exp exp1 cont-exp))
      (diff-exp (exp1 exp2)
        (cps-of-diff-exp exp1 exp2 cont-exp))
      (sum-exp (exps)
        (cps-of-sum-exp exps cont-exp))
      ...)))

      ... ; continuation of cps-of-exp
      (if-exp (exp1 exp2 exp3)
        (cps-of-if-exp exp1 exp2 exp3 cont-exp))
      (let-exp (var exp1 body)
        (cps-of-let-exp var exp1 body cont-exp))
      (letrec-exp (p-names b-varss p-bodies letrec-body)
        (cps-of-letrec-exp
          p-names b-varss p-bodies letrec-body cont-exp))
      (call-exp (rator rands)
        (cps-of-call-exp rator rands cont-exp)))))

(define cps-of-program
  (lambda (pgm)
    (cases program pgm
      (a-program (exp1)
        (cps-a-program
          (cps-of-exps (list exp1)
            (lambda (new-args)
              (simple-exp->exp (car new-args))))התוכנית הראשית לא נשלחת להמשכיות, אלא הערך המוחזר שלה מוצג ישירות.)))))

(define-datatype type type?
  (int-type)
  (bool-type)
  (proc-type
    (arg-type type?)
    (result-type type?))טיפוס פונקציה. למשל: פונקציה שמקבלת int ומחזירה bool (int -> bool).)

(define check-equal-type!
  (lambda (ty1 ty2 exp)
    (if (not (equal? ty1 ty2))בודק שוויון עמוק - אם הם לא זהים לחלוטין, זו שגיאה!
        (report-unequal-types ty1 ty2 exp)
        #t)))

(define report-unequal-types
  (lambda (ty1 ty2 exp)
    (eopl:error 'check-equal-type!
      "Types didn't match: ~s != ~a in~%~a"
      (type-to-external-form ty1)ממיר את הטיפוס לתצוגה קריאה.
      (type-to-external-form ty2)
      exp)))

(define type-to-external-form
  (lambda (ty)
    (cases type ty
      (int-type () 'int)
      (bool-type () 'bool)
      (proc-type (arg-type result-type)
        (list
          (type-to-external-form arg-type)
          '->מדפיס את החץ המסורתי שמייצג פונקציות.
          (type-to-external-form result-type))))))

(define type-of
  (lambda (exp tenv)
    (cases expression exp
      (const-exp (num) (int-type))
      (var-exp (var) (apply-tenv tenv var))סביבת Type Environment (TENV) שומרת טיפוסים, לא ערכים!
      (diff-exp (exp1 exp2)
        (let ((ty1 (type-of exp1 tenv))
              (ty2 (type-of exp2 tenv)))
          (check-equal-type! ty1 (int-type) exp1)וידוא שהצד השמאלי הוא מספר!
          (check-equal-type! ty2 (int-type) exp2)
          (int-type)))
      (zero?-exp (exp1)
        (let ((ty1 (type-of exp1 tenv)))
          (check-equal-type! ty1 (int-type) exp1)
          (bool-type)בדיקת אפס מחזירה בוליאני.))
      (if-exp (exp1 exp2 exp3)
        (let ((ty1 (type-of exp1 tenv))
              (ty2 (type-of exp2 tenv))
              (ty3 (type-of exp3 tenv)))
          (check-equal-type! ty1 (bool-type) exp1)
          (check-equal-type! ty2 ty3 exp)וידוא קריטי ששני ענפי ה-if מחזירים טיפוס זהה (למשל לא יכול להיות שאחד מחזיר int והשני bool).
          ty2))
      ...)))

      ... ; type-of continued
      (let-exp (var exp1 body)
        (let ((exp1-type (type-of exp1 tenv)))
          (type-of body
            (extend-tenv var exp1-type tenv))))
      (proc-exp (var var-type body)
        (let ((result-type
                (type-of body
                  (extend-tenv var var-type tenv))מוסיפים את המשתנה לסביבת הטיפוסים ומחשבים את טיפוס הפלט של הגוף.))
          (proc-type var-type result-type)מרכיבים את הטיפוס השלם של הפונקציה (arg -> result).))
      (call-exp (rator rands)
        (let ((rator-type (type-of rator tenv))
              (rand-type (type-of (car rands) tenv)))
          (cases type rator-type
            (proc-type (arg-type result-type)
              (begin
                (check-equal-type! arg-type rand-type (car rands))החלק החשוב ביותר: וידוא שסוג הארגומנט בקריאה מתאים בדיוק לסוג שהפונקציה מצפה לו.
                result-type))
            (else
              (report-rator-not-a-proc-type rator-type rator)))))
      (letrec-exp (p-result-type p-name b-var b-var-type p-body letrec-body)
        (let ((tenv-for-letrec-body
                (extend-tenv p-name
                  (proc-type b-var-type p-result-type)
                  tenv)מוסיפים לסביבה את הפונקציה הרקורסיבית עצמה עם הטיפוס המוצהר שלה, כדי שיהיה אפשר לקרוא לה בתוך הגוף שלה.))
          (let ((p-body-type
                  (type-of p-body
                    (extend-tenv b-var b-var-type tenv-for-letrec-body))))
            (check-equal-type! p-body-type p-result-type p-body)מוודאים שהגוף של הפונקציה באמת תואם להבטחה שהמתכנת הצהיר עליה ב-p-result-type.
            (type-of letrec-body tenv-for-letrec-body)))))))

(define-datatype type type?
  ...
  (tvar-type
    (serial-number integer?))טיפוס חדש המייצג נעלם שטרם נפתר, מיוצג ע"י מספר סידורי.)

;; When we encounter a '?' (no-type), we generate a fresh type variable:
(define fresh-tvar-type
  (let ((sn 0))
    (lambda ()
      (set! sn (+ sn 1))מייצר משתנים חדשים באופן ייחודי (tvar1, tvar2, tvar3...).
      (tvar-type sn))))

;; Replaces all occurrences of tvar (like tvar15) with a specific type ty0.
(define apply-one-subst
  (lambda (ty0 tvar ty)
    (cases type ty
      (int-type () (int-type))
      (bool-type () (bool-type))
      (proc-type (arg-type result-type)
        (proc-type
          (apply-one-subst ty0 tvar arg-type)מבצע את ההצבה באופן רקורסיבי על צד שמאל של הפונקציה (ארגומנט).
          (apply-one-subst ty0 tvar result-type)))
      (tvar-type (sn)
        (if (equal? ty (tvar-type tvar))אם מצאנו בדיוק את המשתנה שאנו מחפשים...
            ty0נחליף אותו בטיפוס החדש (ty0)!
            ty)))))

;; A substitution is a list of pairs: ((tvar1 . type1) (tvar2 . type2) ...)
(define apply-subst-to-type
  (lambda (ty subst)
    (cases type ty
      (int-type () (int-type))
      (bool-type () (bool-type))
      (proc-type (t1 t2)
        (proc-type
          (apply-subst-to-type t1 subst)
          (apply-subst-to-type t2 subst)))
      (tvar-type (sn)
        (let ((tmp (assoc ty subst)חיפוש המשתנה במילון ההצבות כדי לראות אם יש לו כבר פתרון ידוע.))
          (if tmp
              (cdr tmp)אם יש פתרון - נחזיר את הפתרון.
              ty))))))

(define empty-subst (lambda () '()))

(define extend-subst
  (lambda (subst tvar ty)
    (cons
      (cons tvar ty)הוספת הזוג החדש (ההצבה החדשה) לראש המילון.
      (map
        (lambda (p)
          (let ((oldlhs (car p))
                (oldrhs (cdr p)))
            (cons oldlhs
                  (apply-one-subst ty tvar oldrhs)קריטי: החלפת המשתנה החדש שהתגלה בכל צדדי ה"ימין" של שאר המשוואות הקיימות.)))
        subst))))

(define unifier
  (lambda (ty1 ty2 subst exp)
    (let ((ty1 (apply-subst-to-type ty1 subst))
          (ty2 (apply-subst-to-type ty2 subst)))
      (cond
        ((equal? ty1 ty2) subst)
        ((tvar-type? ty1)
         (if (no-occurrence? ty1 ty2)בדיקת Occurrence: אי אפשר לפתור משוואה כמו X = X -> int, כי X מכיל את עצמו! זה נקרא רקורסיית טיפוסים אלא אם יש לנו Recursive Types.
             (extend-subst subst ty1 ty2)
             (report-no-occurrence-violation ty1 ty2 exp)))
        ((tvar-type? ty2)
         (if (no-occurrence? ty2 ty1)
             (extend-subst subst ty2 ty1)
             (report-no-occurrence-violation ty2 ty1 exp)))
        ((and (proc-type? ty1) (proc-type? ty2))
         (let ((subst (unifier
                        (proc-type->arg-type ty1)
                        (proc-type->arg-type ty2)
                        subst exp)קודם משווים (ומעדכנים הצבות) של הארגומנטים...))
           (let ((subst (unifier
                          (proc-type->result-type ty1)
                          (proc-type->result-type ty2)
                          subst exp)...ואז משווים את טיפוסי ההחזרה בעזרת ההצבות החדשות שהתקבלו!))
             subst)))
        (else (report-unification-failure ty1 ty2 exp))))))

;; Checks if 'tvar' appears anywhere inside 'ty'.
(define no-occurrence?
  (lambda (tvar ty)
    (cases type ty
      (int-type () #t)
      (bool-type () #t)
      (proc-type (arg-type result-type)
        (and
          (no-occurrence? tvar arg-type)בודק באופן רקורסיבי על צד הארגומנט.
          (no-occurrence? tvar result-type)))
      (tvar-type (sn)
        (not (equal? tvar ty))אם מצאנו את המשתנה עצמו - מחזירים שקר (כלומר יש מופע - אסור לעשות Unify).))))

;; If the user provided a type, use it. If not, generate a fresh variable!
(define otype->type
  (lambda (otype)
    (cases optional-type otype
      (no-type () (fresh-tvar-type)מייצר tvar חדש במקרה של "?".)
      (a-type (ty) tyמחזיר את הטיפוס המפורש שהמתכנת רשם.))))

;; We can display type variables as either their raw ID or a readable letter like "t23".
(define type-to-external-form
  (lambda (ty)
    (cases type ty
      ... ; int-type, bool-type, proc-type as before
      (tvar-type (sn)
        (string->symbol
          (string-append
            "tvar"
            (number->string sn))הופך את המספר 15 לסימבול 'tvar15.)))))

;; In INFERRED, type-of returns TWO things: the Type, and the updated Substitution dictionary!
;; We simulate this by having type-of return an 'answer' datatype containing both.

(define-datatype answer answer?
  (an-answer
    (type type?)
    (subst substitution?)))כך אנחנו מחזירים "שני ערכים" יחד בתוך אובייקט אחד.

(define type-of
  (lambda (exp tenv subst)
    (cases expression exp
      (const-exp (num) (an-answer (int-type) subst))
      (zero?-exp (exp1)
        (cases answer (type-of exp1 tenv subst)
          (an-answer (ty1 subst1)
            (let ((subst2 (unifier ty1 (int-type) subst1 exp)מבקשים מה-unifier להשוות את ty1 ל-int-type, מה שייתכן ויוליד משוואות חדשות ל-subst2!))
              (an-answer (bool-type) subst2)))))
      ...)))

      ... ; type-of continued
      (diff-exp (exp1 exp2)
        (cases answer (type-of exp1 tenv subst)
          (an-answer (ty1 subst1)
            (let ((subst1.5 (unifier ty1 (int-type) subst1 exp1)מכריחים את צד שמאל להיות int ומעדכנים את המילון))
              (cases answer (type-of exp2 tenv subst1.5)קריטי: משתמשים במילון המעודכן subst1.5 כדי שחישוב exp2 יכיר את ההצבות החדשות שנוצרו!
                (an-answer (ty2 subst2)
                  (let ((subst2.5 (unifier ty2 (int-type) subst2 exp2)))
                    (an-answer (int-type) subst2.5))))))))
      (if-exp (exp1 exp2 exp3)
        (cases answer (type-of exp1 tenv subst)
          (an-answer (ty1 subst1)
            (let ((subst2 (unifier ty1 (bool-type) subst1 exp1)))
              (cases answer (type-of exp2 tenv subst2)
                (an-answer (ty2 subst3)
                  (cases answer (type-of exp3 tenv subst3)
                    (an-answer (ty3 subst4)
                      (let ((subst5 (unifier ty2 ty3 subst4 exp)כאן אנחנו מייצרים משוואה חדשה: הטיפוס של ענף אז חייב להיות שווה לטיפוס של ענף אחרת!))
                        (an-answer ty2 subst5))))))))))

      ... ; type-of continued
      (var-exp (var)
        (an-answer (apply-tenv tenv var) subst))
      (let-exp (var exp1 body)
        (cases answer (type-of exp1 tenv subst)
          (an-answer (ty1 subst1)
            (type-of body (extend-tenv var ty1 tenv) subst1))))
      (proc-exp (var otype body)
        (let ((arg-type (otype->type otype)מכניס משתנה חדש במידה ולא נרשם טיפוס))
          (cases answer (type-of body
                                 (extend-tenv var arg-type tenv)מוסיף ל-TENV את הארגומנט בטיפוס שלו (שיכול להיות גם Tvar!)
                                 subst)
            (an-answer (result-type subst1)
              (an-answer
                (proc-type arg-type result-type)
                subst1)))))

      ... ; type-of continued
      (call-exp (rator rands)
        (let ((result-type (fresh-tvar-type)אנחנו לא יודעים מה הפונקציה תחזיר, אז אנחנו "ממציאים" משתנה שייצג את התוצאה שלה!))
          (cases answer (type-of rator tenv subst)
            (an-answer (rator-type subst1)
              (cases answer (type-of (car rands) tenv subst1)
                (an-answer (rand-type subst2)
                  ;; דורשים שסוג הפונקציה יהיה תואם למבנה (arg -> result-type)
                  (let ((subst3
                          (unifier rator-type
                            (proc-type rand-type result-type)
                            subst2 exp)מאלצים את rator-type להתאים לתבנית (rand-type -> result-type). כך יתגלה מהו הטיפוס האמיתי של הפונקציה!))
                    (an-answer result-type subst3))))))))
      (letrec-exp (p-result-otype p-name b-var b-var-otype p-body letrec-body)
        (let ((p-result-type (otype->type p-result-otype))
              (p-arg-type (otype->type b-var-otype)))
          (let ((tenv-for-letrec-body
                  (extend-tenv p-name
                    (proc-type p-arg-type p-result-type)
                    tenv)))
            (cases answer (type-of p-body
                                   (extend-tenv b-var p-arg-type tenv-for-letrec-body)
                                   subst)
              (an-answer (p-body-type subst1)
                (let ((subst2 (unifier p-body-type p-result-type subst1 p-body)מוודאים שהטיפוס בפועל של הגוף תואם לטיפוס המוצהר של הרקורסיה.))
                  (type-of letrec-body tenv-for-letrec-body subst2))))))))))

;; A typed module is just an environment containing its internal bindings
(define-datatype typed-module typed-module?
  (simple-module
    (bindings environment?)))

;; The environment can now hold both standard variables (val) and modules!
(define-datatype environment environment?
  (empty-env)
  (extend-env
    (bvar symbol?)
    (bval expval?)
    (saved-env environment?))
  (extend-env-with-module
    (m-name symbol?)
    (m-val typed-module?)
    (saved-env environment?))הרחבת הסביבה הכללית עם מודול שלם, כך ששם המודול (למשל m1) יצביע לאובייקט ה-module.)

(define lookup-module-name-in-env
  (lambda (m-name env)
    (cases environment env
      (empty-env ()
        (eopl:error 'lookup-module-name-in-env
          "No binding for module ~s" m-name))
      (extend-env (bvar bval saved-env)
        (lookup-module-name-in-env m-name saved-env)מתעלם ממשתנה רגיל וממשיך לחפש בשרשרת הסביבות.)
      (extend-env-with-module (m-name1 m-val saved-env)
        (if (eqv? m-name1 m-name)
            m-val
            (lookup-module-name-in-env m-name saved-env))))))

(define lookup-qualified-var-in-env
  (lambda (m-name var-name env)
    (let ((m-val (lookup-module-name-in-env m-name env)שלב א': שולף את המודול מהסביבה הכללית))
      (cases typed-module m-val
        (simple-module (bindings)
          (apply-env bindings var-name)שלב ב': שולף את המשתנה מתוך הסביבה הפנימית של המודול!)))))

(define value-of-program
  (lambda (pgm)
    (cases program pgm
      (a-program (m-defs body)
        (let ((env (add-module-defns-to-env m-defs (empty-env))בונה סביבה גלובלית שכוללת את כל המודולים (וכל מודול מכיר את המודולים שהוגדרו לפניו!).))
          (value-of body env))))))

(define add-module-defns-to-env
  (lambda (defns env)
    (if (null? defns)
        env
        (cases module-definition (car defns)
          (a-module-definition (m-name iface m-body)
            (add-module-defns-to-env
              (cdr defns)
              (extend-env-with-module
                m-name
                (value-of-module-body m-body env)
                env))מעריך את המודול הנוכחי, שומר אותו בסביבה, וממשיך ברקורסיה למודול הבא!)))))

;; Runs the code inside the module to generate its environment
(define value-of-module-body
  (lambda (m-body env)
    (cases module-body m-body
      (defns-module-body (defns)
        (simple-module
          (defns-to-env defns env))))))

;; Evaluates all definitions inside the module one by one
(define defns-to-env
  (lambda (defns env)
    (if (null? defns)
        (empty-env)
        (cases definition (car defns)
          (val-defn (var exp)
            (let ((val (value-of exp env)))
              (let ((new-env (extend-env var val env)))
                ;; Recursive call builds the nested environment!
                (extend-env var val
                  (defns-to-env (cdr defns) new-env))סביבה שמכילה את הערך החדש, ובתוכה את שאר הערכים שיחושבו אחריה!)))))))

;; The Type Checker also needs its own environment for Modules!
(define-datatype type-environment type-environment?
  (empty-tenv)
  (extend-tenv
    (bvar symbol?)
    (bval type?)
    (saved-tenv type-environment?))
  (extend-tenv-with-module
    (name symbol?)
    (interface interface?)
    (saved-tenv type-environment?))סביבת טיפוסים של מודול = הממשק (Interface) שלו!)

(define lookup-qualified-var-in-tenv
  (lambda (m-name var-name tenv)
    (let ((iface (lookup-module-name-in-tenv tenv m-name)))
      (cases interface iface
        (simple-iface (decls)
          (lookup-variable-name-in-decls var-name decls)מחפש את הטיפוס של המשתנה בתוך ההצהרות של ה-Interface.)))))

;; The Type Checker evaluates the module declarations and bodies, making sure everything matches!
(define type-of-program
  (lambda (pgm)
    (cases program pgm
      (a-program (module-defns body)
        (type-of body
          (add-module-defns-to-tenv module-defns (empty-tenv)))))))

(define add-module-defns-to-tenv
  (lambda (defns tenv)
    (if (null? defns)
        tenv
        (cases module-definition (car defns)
          (a-module-definition (m-name expected-iface m-body)
            (let ((actual-iface (interface-of m-body tenv)מסיק לבד מה הממשק האמיתי של המודול מהקוד שלו))
              (if (<:-iface actual-iface expected-iface tenv)בודק אם הממשק האמיתי עומד בדרישות של הממשק המוצהר. האם actual מתנהג כמו expected? ; Does actual satisfy expected?
                  ;; If yes, add the EXPECTED interface to the TENV, not the actual one! (Encapsulation)
                  (let ((new-tenv (extend-tenv-with-module m-name expected-iface tenv)הכנסת הממשק *המוצהר* לסביבה, מה שמסתיר פונקציות עזר פנימיות.))
                    (add-module-defns-to-tenv (cdr defns) new-tenv))
                  (report-module-doesnt-satisfy-iface m-name expected-iface actual-iface))))))))

(define interface-of
  (lambda (m-body tenv)
    (cases module-body m-body
      (defns-module-body (defns)
        (simple-iface
          (defns-to-decls defns tenv))))))

;; Goes through each definition, finds its type, and adds it as a declaration (val-decl) to the interface.
(define defns-to-decls
  (lambda (defns tenv)
    (if (null? defns)
        '()
        (cases definition (car defns)
          (val-defn (var-name exp)
            (let ((ty (type-of exp tenv)מחשב את הטיפוס של משתנה בתוך המודול))
              (let ((new-env (extend-tenv var-name ty tenv)))
                (cons
                  (val-decl var-name ty)יוצר Declaration חדש לממשק: השם והטיפוס.
                  (defns-to-decls (cdr defns) new-env)))))))))

;; <:-iface checks if 'iface1' (actual) is a subtype of 'iface2' (expected)
(define <:-iface
  (lambda (iface1 iface2 tenv)
    (cases interface iface1
      (simple-iface (decls1)
        (cases interface iface2
          (simple-iface (decls2)
            (<:-decls decls1 decls2 tenv)))))))

;; We iterate over decls2 (the expected declarations).
;; For every expected declaration, it MUST exist in decls1 (actual), and the types MUST match.
;; It's okay if decls1 has EXTRA declarations that decls2 doesn't mention!
(define <:-decls
  (lambda (decls1 decls2 tenv)
    (cond
      ((null? decls2) #t) ; All expected decls were satisfied
      ((null? decls1) #f) ; Expected decls left, but actual is empty (Missing binding)
      (else
        (let ((name1 (decl->name (car decls1)))
              (name2 (decl->name (car decls2)))
              (type1 (decl->type (car decls1)))
              (type2 (decl->type (car decls2))))
          (if (eqv? name1 name2)
              (and
                (equal? type1 type2)
                (<:-decls (cdr decls1) (cdr decls2) tenv))
              (<:-decls (cdr decls1) decls2 tenv)אם השמות שונים, פשוט מדלגים ובודקים את המשתנה הבא ב-decls1! כך מאפשרים ש-decls1 יכיל דברים שאין ב-decls2.))))))

;; OPAQUE-TYPES introduces defining custom types inside modules!
Type ::= Identifier
         named-type (name)
Type ::= from Identifier take Identifier
         qualified-type (m-name t-name)לדוגמה: (from mybool take t) כדי לגשת לטיפוס שמוגדר במודול אחר.

Declaration ::= transparent Identifier = Typeשקוף: אומר למשתמש שמדובר בכינוי (Alias) לטיפוס הקיים.
                transparent-type-decl (name ty)
Declaration ::= opaque Identifierאטום: מסתיר את המימוש! אם נשתמש בו, לא נוכל לעשות עליו פעולות של int למרות שמתחת לפני השטח הוא int.
                opaque-type-decl (name)

Definition ::= type Identifier = Type
               type-defn (name ty)

;; Because a type 't' can just be an alias for 'int', we need a function that 'unfolds' the type until it hits a primitive type or an opaque type.
(define expand-type
  (lambda (ty tenv)
    (cases type ty
      (int-type () (int-type))
      (bool-type () (bool-type))
      (proc-type (arg-type result-type)
        (proc-type
          (expand-type arg-type tenv)אם זה proc, מרחיבים גם את הארגומנטים...
          (expand-type result-type tenv)))
      (named-type (name)
        (lookup-type-name-in-tenv tenv name)מסתכל ב-TENV מה הטיפוס שמוסתר מאחורי השם.)
      (qualified-type (m-name t-name)
        (lookup-qualified-type-in-tenv m-name t-name tenv)))))

;; We use expand-type in <:-decls!
;; When comparing two types in an interface (like expected vs actual), we expand them FIRST to see what they really mean.
(define <:-decls
  (lambda (decls1 decls2 tenv)
    (cond
      ...
      (else
        (let ((name1 (decl->name (car decls1)))
              (name2 (decl->name (car decls2))))
          (if (eqv? name1 name2)
              (and
                ;; Compare expanded types instead of raw types!
                (equiv-type? (decl->type (car decls1))
                             (decl->type (car decls2))
                             tenv)שימוש ב-equiv-type? שמרחיב את שניהם ואז משווה.
                (<:-decls (cdr decls1) (cdr decls2)
                          ;; Must extend tenv with the actual declaration before continuing
                          (extend-tenv-with-decl (car decls1) tenv)קריטי: משתנים בהמשך הרשימה עשויים להיות תלויים במשתנה שכעת בדקנו (למשל הגדרנו טיפוס t ואז משתנה מטיפוס t).))
              (<:-decls (cdr decls1) decls2 tenv)))))))

;; equiv-type? checks if two types are actually the same after expansion
(define equiv-type?
  (lambda (ty1 ty2 tenv)
    (equal?
      (expand-type ty1 tenv)
      (expand-type ty2 tenv))))

;; defns-to-decls now handles `type` definitions!
(define defns-to-decls
  (lambda (defns tenv)
    (if (null? defns)
        '()
        (cases definition (car defns)
          ...
          (type-defn (name ty)
            (let ((new-env (extend-tenv-with-type name (expand-type ty tenv) tenv)))
              (cons
                ;; A 'type' definition in the body ALWAYS becomes a 'transparent' declaration in the interface!
                (transparent-type-decl name ty)מבפנים - כל טיפוס הוא תמיד שקוף עבור הקוד שבתוך המודול!
                (defns-to-decls (cdr defns) new-env))))))))

;; <:-decl checks if actual declaration satisfies expected declaration
(define <:-decl
  (lambda (decl1 decl2 tenv)
    (or
      (and
        (val-decl? decl1)
        (val-decl? decl2)
        (equiv-type? (decl->type decl1) (decl->type decl2) tenv))
      (and
        (transparent-type-decl? decl1)
        (transparent-type-decl? decl2)
        (equiv-type? (decl->type decl1) (decl->type decl2) tenv))
      (and
        (transparent-type-decl? decl1)
        (opaque-type-decl? decl2)המודול משקף את הטיפוס, אבל ה-interface דורש שיהיה אטום - זה תקין! המודול פשוט "מתלבש" בחליפה אטומה.) ; A transparent type can satisfy an opaque requirement!
      (and
        (opaque-type-decl? decl1)
        (opaque-type-decl? decl2)))))

;; A parameterized module (Functor) takes a module as input and returns a module!
Interface ::= ((Identifier : Interface) => Interface)
              proc-iface (param-name param-iface result-iface)ממשק (A => B) כמו פונקציה רגילה, אבל עובד על מודולים שלמים.

;; Expanding a functor's interface just means expanding its parameter's interface and its result's interface.
(define expand-iface
  (lambda (m-name iface tenv)
    (cases interface iface
      (simple-iface (decls)
        (simple-iface
          (expand-decls m-name decls tenv)))
      (proc-iface (param-name param-iface result-iface)
        (proc-iface
          param-name
          (expand-iface param-name param-iface tenv)מרחיב את הממשק של הפרמטר המבוקש
          (expand-iface m-name result-iface
            (extend-tenv-with-module
              param-name
              (expand-iface param-name param-iface tenv)
              tenv)מרחיב את הממשק של התוצאה, כשהפרמטר כבר ידוע וקיים בסביבה (למשל, כדי להשתמש בטיפוס t שהמודול-פרמטר מספק)))))))

ModuleBody ::= module-proc (Identifier : Interface) ModuleBody
               proc-module-body (m-name m-type m-body)

ModuleBody ::= Identifier
               var-module-body (m-name)

ModuleBody ::= (Identifier Identifier)
               app-module-body (rator rand)לדוגמה: module M = (F X), מפעיל את פונקציית המודול F על המודול X.

;; In memory, a functor is a 'proc-module' containing the parameter name, its expected body, and the environment it was defined in (Lexical Scoping!).
(define-datatype typed-module typed-module?
  (simple-module (bindings environment?))
  (proc-module
    (bvar symbol?)
    (body module-body?)
    (saved-env environment?))בדיוק כמו proc רגיל בשפה: סוגר (Closure) שמחכה שיפעילו אותו!)

;; How do we run module code that defines or uses functors?
(define value-of-module-body
  (lambda (m-body env)
    (cases module-body m-body
      (defns-module-body (defns)
        (simple-module
          (defns-to-env defns env)))
      (var-module-body (m-name)
        (lookup-module-name-in-env m-name env))
      (proc-module-body (m-name m-type m-body)
        (proc-module m-name m-body env)יצירת ה-Closure. הגוף עדיין לא מורץ!) ; Returns the functor (Closure)
      (app-module-body (rator rand)
        (let ((rator-val (lookup-module-name-in-env rator env))
              (rand-val (lookup-module-name-in-env rand env)))
          (cases typed-module rator-val
            (proc-module (bvar body saved-env)
              ;; To apply the functor, we run its body, extending its saved environment with the argument module!
              (value-of-module-body body
                (extend-env-with-module bvar rand-val saved-env))הרצת גוף הפונקציה (המודול) תחת הסביבה שנשמרה עם תוספת הארגומנט שסופק!)
            (else
              (eopl:error 'value-of-module-body
                "Attempt to apply non-parameterized module ~s" rator))))))))

;; Type-checking Functors is just like type-checking regular procs!
(define interface-of
  (lambda (m-body tenv)
    (cases module-body m-body
      (defns-module-body (defns)
        (simple-iface
          (defns-to-decls defns tenv)))
      (var-module-body (m-name)
        (lookup-module-name-in-tenv tenv m-name))
      (proc-module-body (m-name m-type m-body)
        (let ((expanded-m-type (expand-iface m-name m-type tenv)))
          (let ((new-tenv (extend-tenv-with-module m-name expanded-m-type tenv)מוסיפים את הפרמטר לסביבה כדי שיהיה זמין בזמן הבדיקה של הגוף.))
            (let ((result-iface (interface-of m-body new-tenv)מסיקים מה הממשק שיוחזר כתוצאה מהרצת המודול הזה.))
              ;; Returns a proc-iface (A => B)
              (proc-iface m-name expanded-m-type result-iface)החזרת ממשק מסוג Functor))))
      ...

      ... ; interface-of continued
      (app-module-body (rator rand)
        (let ((rator-iface (lookup-module-name-in-tenv tenv rator))
              (rand-iface (lookup-module-name-in-tenv tenv rand)))
          (cases interface rator-iface
            (simple-iface (decls)
              (eopl:error 'interface-of
                "Attempt to apply non-parameterized module ~s" rator))
            (proc-iface (param-name param-iface result-iface)
              ;; Does the argument module satisfy the parameter requirements?
              (if (<:-iface rand-iface param-iface tenv)בודק אם המודול שסיפקנו עונה על הדרישות של ה-Functor!
                  (rename-in-iface result-iface param-name rand)משנה בתוך התוצאה את שם הפרמטר לשם של המודול האמיתי שסיפקנו, כדי שהטיפוסים יהיו מדויקים בממשק המוחזר! ; Yes! Return the result interface (with the param name swapped out)
                  (report-module-doesnt-satisfy-iface rand param-iface rand-iface)))))))))

;; A program now contains a list of class declarations followed by an expression.
Program ::= (ARBITRARY-NUMBER-OF ClassDecl) Expression

;; A class has a name, inherits from a superclass (or 'object'), defines fields, and methods.
ClassDecl ::= class Identifier extends Identifier
              (ARBITRARY-NUMBER-OF field Identifier)
              (ARBITRARY-NUMBER-OF MethodDecl)
              a-class-decl (class-name super-name field-names method-decls)

;; Methods have a name, parameters, and a body.
MethodDecl ::= method Identifier (COMMA-SEPARATED-LIST-OF Identifier) Expression
               a-method-decl (method-name vars body)

;; Object-oriented expressions
Expression ::= new Identifier (COMMA-SEPARATED-LIST-OF Expression)
               new-object-exp (class-name rands)יצירת אובייקט והפעלת מתודת initialize.

Expression ::= send Expression Identifier (COMMA-SEPARATED-LIST-OF Expression)
               method-call-exp (obj-exp method-name rands)קריאה למתודה (שליחת הודעה). מפעיל Dynamic Dispatch.

Expression ::= super Identifier (COMMA-SEPARATED-LIST-OF Expression)
               super-call-exp (method-name rands)קריאה למתודה ממחלקת האב כדי למנוע דריסה.

Expression ::= self
               self-exp ()התייחסות לאובייקט הנוכחי.

;; How we evaluate the new OOP constructs:
(define value-of
  (lambda (exp env)
    (cases expression exp
      ...
      (self-exp ()
        (apply-env env '%self)'self' is just a hidden variable in the environment!) 

      (method-call-exp (obj-exp method-name rands)
        (let ((args (eval-rands rands env))
              (obj (value-of obj-exp env)))
          (apply-method (find-method (object->class-name obj) method-name)מתחיל לחפש את המתודה החל מהמחלקה שאליה שייך האובייקט (מתחיל מלמטה). זה ה-Dynamic Dispatch!
                        obj
                        args)))

      (super-call-exp (method-name rands)
        (let ((args (eval-rands rands env))
              (obj (apply-env env '%self)))
          (apply-method (find-method (apply-env env '%super) method-name)מתחיל לחפש את המתודה החל מהסופר-קלאס שנשמר בסביבה.
                        obj
                        args)))

      (new-object-exp (class-name rands)
        (let ((args (eval-rands rands env))
              (obj (new-object class-name)))
          ;; Call 'initialize' method on the newly created object
          (apply-method (find-method class-name 'initialize)
                        obj
                        args)כל אובייקט מריץ את מתודת ה-initialize מיד לאחר יצירתו.
          obj))))) ; Return the created object

;; An object in memory is remarkably simple:
;; It just needs to know its class name (so we can find its methods)
;; and it needs a list of memory references to its fields.
;; Methods are NOT stored inside the object! They are stored in the class.
(define-datatype object object?
  (an-object
    (class-name symbol?)מזהה לאיזו מחלקה שייך. זה מאפשר את ה-Dynamic Dispatch!
    (fields (list-of reference?))מערך השדות של האובייקט (כולל שדות שהורשו ממחלקות האב).))

;; Helper to get the class name from an object
(define object->class-name
  (lambda (obj)
    (cases object obj
      (an-object (class-name fields)
        class-name))))

;; new-object allocates the object and its fields in memory
(define new-object
  (lambda (class-name)
    (an-object
      class-name
      (map
        (lambda (field-name)
          (newref (list 'uninitialized-field field-name))מייצר תא זיכרון ריק (לפני ה-initialize) עבור כל שדה (Field) של המחלקה.)
        (class->field-names (lookup-class class-name))))))

;; apply-method executes the method body
(define apply-method
  (lambda (m self args)
    (cases method m
      (a-method (vars body super-name field-names)
        (value-of body
          ;; The method runs in an environment containing the arguments...
          (extend-env vars args
            ;; ...and the object's fields...
            (extend-env-refs field-names (object->fields self)מחבר את שמות השדות שמופיעים בקוד (מחלקה א') להפניות הזיכרון האמיתיות שקיימות באובייקט self!
              ;; ...and 'super'...
              (extend-env (list '%super) (list super-name)
                ;; ...and 'self'.
                (extend-env (list '%self) (list self)
                  (empty-env)מתודות רצות בסביבה ריקה למעט מה שהוגדר למעלה! כלומר אין "Lexical Scope" אל מחוץ למחלקה.)))))))))

;; The global class environment stores all class definitions.
(define the-class-env '())

(define add-to-class-env!
  (lambda (class-name class)
    (set! the-class-env
      (cons (list class-name class) the-class-env))))

;; A class holds everything needed to create objects and find methods.
;; It stores its superclass name, its accumulated field names, and its methods.
(define-datatype class class?
  (a-class
    (super-name (maybe symbol?))
    (field-names (list-of symbol?))שומר את כל השדות - גם אלו שהורשו.
    (method-env method-environment?)סביבה שממפה שמות מתודות לגופי המתודות (Closures).))

;; When we see a class declaration, we create the class and add it to the environment.
(define initialize-class-decl!
  (lambda (c-decl)
    (cases class-decl c-decl
      (a-class-decl (class-name super-name field-names method-decls)
        (let ((f-names
                ;; Inheritance of fields: we append our new fields to the superclass's fields!
                (append-field-names
                  (class->field-names (lookup-class super-name))
                  field-names)שדות מורשים נוספים בתחילת הרשימה (מיקומם הפיזי בזיכרון נשמר!)))
          (add-to-class-env!
            class-name
            (a-class
              super-name
              f-names
              ;; Inheritance of methods: we merge our methods with the superclass's methods.
              (merge-method-envs
                (method-decls->method-env method-decls super-name f-names)
                (class->method-env (lookup-class super-name)))מיזוג מתודות - דריסה קורית כאן אם יש התנגשות שמות.)))))))

;; finding a method is simple because merge-method-envs already put them all in the class's method-env!
(define find-method
  (lambda (c-name name)
    (let ((m-env (class->method-env (lookup-class c-name))))
      (let ((maybe-pair (assq name m-env)))
        (if (pair? maybe-pair)
            (cadr maybe-pair)
            (report-method-not-found name))))))

;; TYPED-OO adds Interfaces and Types to OOP.
;; A program now starts with interfaces, then classes, then the expression.
Program ::= (ARBITRARY-NUMBER-OF InterfaceDecl)
            (ARBITRARY-NUMBER-OF ClassDecl)
            Expression

;; Interfaces declare what methods a class must implement, and their types.
InterfaceDecl ::= interface Identifier (ARBITRARY-NUMBER-OF MethodDecl)
                  an-interface-decl (iface-name method-decls)

;; Classes can implement multiple interfaces!
ClassDecl ::= class Identifier extends Identifier
              implements (ARBITRARY-NUMBER-OF Identifier)
              ...

;; Methods now have type signatures
MethodDecl ::= method Type Identifier (COMMA-SEPARATED-LIST-OF Identifier : Type) Expression

;; Types include class types and interface types (which are just identifiers)
Type ::= Identifier (class-type or interface-type)

;; Casting and type checking (Dynamic Typing within a Static system)
Expression ::= cast Expression Identifier
               cast-exp (exp class-name)

Expression ::= instanceof Expression Identifier
               instanceof-exp (exp class-name)

;; The scanner breaks a string of characters into meaningful "tokens" (words).
;; We define a scanner specification in SLLGEN:
(define scanner-spec-a
  '(
    ;; Ignore whitespace completely!
    (white-sp (whitespace) skip)skip אומר ל-SLLGEN לזרוק את התוכן הזה ולא להעביר אותו לשלב הבא.

    ;; A comment starts with '%' and goes until the end of the line. Ignore it!
    (comment ("%" (arbno (not #\newline))) skip)

    ;; An identifier starts with a letter, followed by letters or digits.
    (identifier (letter (arbno (or letter digit))) symbol)הגדרת ביטוי רגולרי בסיסי המומר ל-symbol סכים (Scheme).

    ;; A number is a sequence of digits.
    (number (digit (arbno digit)) number)
   ))

;; By ignoring whitespace and comments, the parser never even sees them!

;; The grammar defines the structure of the language, and tells SLLGEN how to build the Abstract Syntax Tree (AST) using define-datatype!
(define grammar-a1
  '(
    ;; A Statement can be an assignment: Identifier = Expression
    (statement (identifier "=" expression) assign-stat)assign-stat הוא השם של התבנית (Variant) בתוך ה-datatype statement.

    ;; Or a print statement: print Expression
    (statement ("print" expression) print-stat)

    ;; An Expression can be an identifier
    (expression (identifier) var-exp)

    ;; Or a number
    (expression (number) num-exp)
   ))

;; We use SLLGEN to generate a parsing function for us!
;; It takes a string, runs the scanner, runs the parser, and outputs an AST node (e.g. an 'assign-stat').
(define scan&parse1
  (sllgen:make-string-parser scanner-spec-a grammar-a1))פונקציית קסם שלוכדת את המחרוזת ומחזירה AST מוכן לעבודה!

;; What if we want a block of multiple statements? We use 'arbno' (Arbitrary Number)!
(define grammar-a2
  '(
    ;; A compound statement is '{' followed by zero or more statements, and '}'
    (statement ("{" (arbno statement) "}") compound-stat)מייצר רשימה של statements ב-AST.
    ...
   ))
;; The AST for compound-stat will automatically receive a (list-of statement?) as its argument!

;; What if we want a list separated by commas? We use 'separated-list'!
(define grammar-a4
  '(
    ;; A block is '{' followed by statements separated by ';', and '}'
    (statement ("{" (separated-list statement ";") "}") block-stat)מייצר גם הוא רשימה של statements ב-AST, אך דורש ; בין הפקודות בקוד.
    ...
   ))
;; The AST for block-stat will ALSO receive a (list-of statement?) as its argument.
;; The parser automatically throws away the ';' separators!