#lang racket

(require "opcodes.rkt")
(provide make-stack-machine)
(provide run-stack-machine)
(provide get-stack)
(provide get-varnames)
(provide get-consts)
(provide get-names)
(provide get-code)
(provide get-IC)
(provide empty-stack)
(provide make-stack)
(provide push)
(provide pop)
(provide top)


;; TODO 1:
;; Alegeți metoda de reprezentarea a unei stive.
;; Implementați:
(define empty-stack '())
(define (make-stack) empty-stack)

(define (push value stack)
  (cons value stack))

(define (top stack)
  (if (null? stack)
      '()
      (car stack)))

(define (pop stack)
  (if (null? stack)
      '()
      (cdr stack)))

;; TODO 2:
;; Alegeți metoda de reprezentare a unei mașini stivă.
;; Definiți make-stack-machine, acesta trebuie sa primeasca cele 4 segmente de date
;; Veți avea nevoie de o stivă pentru execuție și un counter ca să stiți
;; la ce instrucțiune sunteți.
(define (make-stack-machine stack co-varnames co-consts co-names co-code IC)
  (cons stack (cons co-varnames (cons co-consts (cons co-names (cons co-code IC))))))

;; Definiți funcțiile `get-varnames`, `get-consts`, `get-names`,
;; `get-code`, `get-stack`, `get-IC` care primesc o mașina stivă și întorc
;; componenta respectivă

;; ex:
;; > (get-varnames (make-stack-machine empty-stack 'dummy-co-varnames (hash) (hash) (list) 0))
;; 'dummy-co-varnames
(define (get-varnames stack-machine)
  (cadr stack-machine))

;; ex:
;; > (get-consts (make-stack-machine empty-stack (hash) 'dummy-co-consts (hash) (list) 0))
;; 'dummy-co-consts
(define (get-consts stack-machine)
  (caddr stack-machine))

;; ex:
;; > (get-names (make-stack-machine empty-stack (hash) (hash) 'dummy-co-names (list) 0))
;; 'dummy-co-names
(define (get-names stack-machine)
  (cadddr stack-machine))

;; ex:
;; > (get-code (make-stack-machine empty-stack (hash) (hash) (hash) 'dummy-co-code 0))
;; dummy-co-code
(define (get-code stack-machine)
  (cadddr (cdr stack-machine)))

;; Întoarce stiva de execuție.
;; ex:
;; > (get-code (make-stack-machine 'dummy-exec-stack (hash) (hash) (hash) (list) 0))
;; dummy-exec-stack
(define (get-stack stack-machine)
  (car stack-machine))

;; Întoarce instruction counterul.
;; ex:
;; > (get-code (make-stack-machine empty-stack (hash) (hash) (hash) (list) 0))
;; 0
(define (get-IC stack-machine)
  (cdr (cdr (cdr (cdr (cdr  stack-machine))))))

;; Definiți funcția push-exec-stack care primește o masină stivă și o valoare
;; și intoarce o noua mașina unde valoarea este pusă pe stiva de execuție
(define (push-exec-stack value stack-machine)
  (make-stack-machine
   (push value (get-stack stack-machine))
   (get-varnames stack-machine)
   (get-consts stack-machine)
   (get-names stack-machine)
   (get-code stack-machine)
   (+ (get-IC stack-machine) 1)))

;; TODO 4:
;; Definiți funcția run-stack-machine care execută operații pană epuizează co-code.
(define (run-stack-machine stack-machine)
  (let* ((current-IC (get-IC stack-machine))
         (code (get-code stack-machine))
         (code-length (length code)))
    (if (>= current-IC code-length)
            stack-machine
            (run-stack-machine (execute (get current-IC code) stack-machine)))))

(define (execute command stack-machine)
  (case (car command)
    ('LOAD_CONST (push-exec-stack (hash-ref (get-consts stack-machine) (cdr command)) stack-machine))
    ('LOAD_FAST (push-exec-stack (hash-ref (get-varnames stack-machine) (cdr command)) stack-machine))
    ('LOAD_GLOBAL (push-exec-stack (hash-ref (get-names stack-machine) (cdr command)) stack-machine))
    ('STORE_FAST (do-store-fast (cdr command) stack-machine))
    ('BINARY_ADD (do-add-binary stack-machine))
    ('BINARY_SUBTRACT (do-subtract-binary stack-machine))
    ('BINARY_MODULO (do-modulo-binary stack-machine))
    ('INPLACE_ADD (do-add-binary stack-machine))
    ('INPLACE_SUBTRACT (do-subtract-binary stack-machine))
    ('INPLACE_MODULO (do-modulo-binary stack-machine))
    ('COMPARE_OP (do-compare-op (cdr command) stack-machine))
    ('JUMP_ABSOLUT (do-jump-absolute (cdr command) stack-machine))
    ('POP_JUMP_IF_TRUE (do-jump-if-true (cdr command) stack-machine))
    ('POP_JUMP_IF_FALSE (do-jump-if-false (cdr command) stack-machine))
    ('GET_ITER (do-nothing stack-machine))
    ('POP_TOP (do-pop stack-machine))
    ('FOR_ITER (do-for-iter (cdr command) stack-machine))
    ('CALL_FUNCTION (do-call-function (cdr command) stack-machine))
    (else (do-nothing stack-machine))))

(define (do-call-function number stack-machine)
  (let* ((stack (get-stack stack-machine))
         (arguments (take stack number))
         (new-stack (drop stack number))
         (function (top stack))
         (result (case function
                   (("print") (writeln (car arguments)))
                   (("sqrt") (sqrt (car arguments)))
                   (("prod") (apply * arguments)))))
    (make-stack-machine
     (push result new-stack)
     (get-varnames stack-machine)
     (get-consts stack-machine)
     (get-names stack-machine)
     (get-code stack-machine)
     (+ (get-IC stack-machine) 1))))

(define (do-for-iter delta stack-machine)
  (let* ((stack (get-stack stack-machine))
         (first-element (top stack))
         (current-IC (get-IC stack-machine)))
    (if (null? first-element)
        (make-stack-machine
         stack
         (get-varnames stack-machine)
         (get-consts stack-machine)
         (get-names stack-machine)
         (get-code stack-machine)
         (+ current-IC (quotient (+ delta 2) 2)))
        (make-stack-machine
         (push (car first-element) (push (cdr first-element) stack))
         (get-varnames stack-machine)
         (get-consts stack-machine)
         (get-names stack-machine)
         (get-code stack-machine)
         (+ current-IC 1)))))

(define (do-pop stack-machine)
  (make-stack-machine
     (pop (get-stack stack-machine))
     (get-varnames stack-machine)
     (get-consts stack-machine)
     (get-names stack-machine)
     (get-code stack-machine)
     (+ (get-IC stack-machine) 1)))


(define (do-jump-if-false target stack-machine)
  (let* ((stack (get-stack stack-machine)) (val (top stack)) (IC (get-IC stack-machine)))
    (make-stack-machine
     stack
     (get-varnames stack-machine)
     (get-consts stack-machine)
     (get-names stack-machine)
     (get-code stack-machine)
     (if (eq? val #f) (quotient target 2) (+ IC 1)))))


(define (do-jump-if-true target stack-machine)
  (let* ((stack (get-stack stack-machine)) (val (top stack)) (IC (get-IC stack-machine)))
    (make-stack-machine
     stack
     (get-varnames stack-machine)
     (get-consts stack-machine)
     (get-names stack-machine)
     (get-code stack-machine)
     (if (eq? val #t) (quotient target 2) (+ IC 1)))))

(define (do-compare-op op-index stack-machine)
  (let* ((stack (get-stack stack-machine)) (first-element (top stack)) (second-element (top (pop stack))) (operator (get op-index cmpcodes)))
    (make-stack-machine
     (push (operator second-element first-element) (pop (pop stack)))
     (get-varnames stack-machine)
     (get-consts stack-machine)
     (get-names stack-machine)
     (get-code stack-machine)
     (+ (get-IC stack-machine) 1))))

(define (do-jump-absolute target stack-machine)
  (make-stack-machine
     (get-stack stack-machine)
     (get-varnames stack-machine)
     (get-consts stack-machine)
     (get-names stack-machine)
     (get-code stack-machine)
     (quotient target 2)))


(define (do-add-binary stack-machine)
  (let* ((stack (get-stack stack-machine)) (first-element (top stack)) (second-element (top (pop stack))) (sum (+ second-element first-element)))
    (make-stack-machine
     (push sum (pop (pop stack)))
     (get-varnames stack-machine)
     (get-consts stack-machine)
     (get-names stack-machine)
     (get-code stack-machine)
     (+ (get-IC stack-machine) 1))))

(define (do-subtract-binary stack-machine)
  (let* ((stack (get-stack stack-machine)) (first-element (top stack)) (second-element (top (pop stack))) (dif (- second-element first-element)))
    (make-stack-machine
     (push dif (pop (pop stack)))
     (get-varnames stack-machine)
     (get-consts stack-machine)
     (get-names stack-machine)
     (get-code stack-machine)
     (+ (get-IC stack-machine) 1))))

(define (do-modulo-binary stack-machine)
  (let* ((stack (get-stack stack-machine)) (first-element (top stack)) (second-element (top (pop stack))) (mod (modulo second-element first-element)))
    (make-stack-machine
     (push mod (pop (pop stack)))
     (get-varnames stack-machine)
     (get-consts stack-machine)
     (get-names stack-machine)
     (get-code stack-machine)
     (+ (get-IC stack-machine) 1))))

(define (do-nothing stack-machine)
  (make-stack-machine
   (get-stack stack-machine)
   (get-varnames stack-machine)
   (get-consts stack-machine)
   (get-names stack-machine)
   (get-code stack-machine)
   (+ (get-IC stack-machine) 1)))

(define (do-store-fast key stack-machine)
  (let ((current-IC (get-IC stack-machine))
        (varnames (get-varnames stack-machine))
        (stack (get-stack stack-machine)))
    (make-stack-machine
     (pop stack)
     (hash-set varnames key (top stack))
     (get-consts stack-machine)
     (get-names stack-machine)
     (get-code stack-machine)
     (+ current-IC 1))))

(define (get nth L)
  (if (= nth 0)
      (car L)
      (get (- nth 1) (cdr L))))

(define cmpcodes (list < <= eq? (compose not eq?) > >= member (compose not member)))