(define lexical-spec
'((white-sp (whitespace) skip)
  (comment ("#" (arbno (not #\newline))) skip)
  (identifier ((arbno "@") letter (arbno (or letter digit "_" "?" "=" ))) symbol)
  (number (digit (arbno digit)) number)
  (number ("-" digit (arbno digit)) number)
  (text ("\"" (or letter whitespace)
              (arbno (or letter digit whitespace ":" "?" "=" "'")) "\"") string)
  )
)

(define grammar-spec
  '( ;;Representa un programa de ruby
     (ruby-program ("ruby" exp-batch "end") a-program)
     ;; Parte 2: Ruby con objetos
     ;; cambiar a: (ruby-program ("ruby" (arbno class-decl) exp-batch "end") a-program)

     ;;Exp-batch: Representa una cerradura de expresiones
     (exp-batch (expression (arbno expression)) a-batch)

     ;;Expresión:
     (expression (simple-exp) a-simple-exp)
     ;Declare-exp: al menos uno o más identificadores (deben inicializarse en 'nil)
     (expression ("declare" identifier (arbno "," identifier) ";") declare-exp)
     ;Puts-exp: al menos un valor compuesto para imprimir
     (expression ("puts" (separated-list comp-value ",") ";") puts-exp)

     (expression ("if" comp-value (arbno "then") exp-batch
                       (arbno "elsif" comp-value (arbno "then") exp-batch)
                       (arbno "else" exp-batch) "end") if-exp)

     (expression ("unless" comp-value (arbno "then")
                           exp-batch
                           (arbno "else" exp-batch) "end") unless-exp)

     (expression ("while" comp-value (arbno "do") exp-batch "end") while-exp)
     (expression ("until" comp-value (arbno "do") exp-batch "end") until-exp)

     (expression ("for" identifier "in" comp-value (arbno "do") exp-batch "end") for-exp)

     (expression ("def" identifier "(" (separated-list identifier ",") ")"
                  exp-batch
                  "end") function-exp)
     (expression ("return" comp-value ";") return-exp)

     ;;Expresión simple
     (simple-exp (simple-value complement ";") val-exp)

     ;;Complemento
     (complement ("=" comp-value calls) assign)
     (complement (assign-op comp-value calls) assign-and)
     (complement (calls) comp-calls)

     ;;Calls
     ;; 0 o muchas llamadas
     (calls ((arbno call)) some-calls)

     ;;Call
     (call (arguments) arguments-call)
     ;; (call ("." identifier arguments) a-method-call) ;; Parte 2: Ruby con Objetos

     ;;Argumentos
     ;; llamar una función puede tener 0 argumentos o muchos
     (arguments ("(" (separated-list comp-value ",") ")") some-arguments)
     ;; almenos 1 argumento para llamar acceder a un elemento en un arreglo
     ;; máximo 2, ejemplo: a=[1,2,3]; a[1] #output 2; a[1,2] #output [2,3];
     ;;                    a[1,2,3] #output Error
     (arguments ("[" comp-value (arbno "," comp-value) "]") arr-arguments)

     ;;Valores compuestos
     (comp-value (value) a-value)
     (comp-value (un-op comp-value) unop-value)

     (value (simple-value) a-s-val)
     (value ("(" comp-value val-compl ")") compl-val)

     ;;Complemento para valores
     ;; llamadas a un valor:
     ;; Ejemplo: sirve para ("hola"+(mundo())) donde mundo() retorna "mundo"
     (val-compl (calls) val-call)
     ;; operacion inorden con otro valor
     (val-compl (bin-op comp-value) binop-val)

     ;; Valores simples
     (simple-value (identifier) id-val)
     (simple-value (number) int-val)
     (simple-value (text) str-val) ;; recordar hacer string-trim cuando se evalue
     (simple-value ("true") true-val)
     (simple-value ("false") false-val)
     (simple-value ("nil") nil-val)
     ;; arreglo con 0 o muchos valores
     (simple-value ("["(separated-list comp-value ",")"]") arr-val)

     ;;Operacion Inorden
     (bin-op ("+") add)
     (bin-op ("-") diff)
     (bin-op ("*") mult)
     (bin-op ("/") div)
     (bin-op ("%") mod)
     (bin-op ("**") pow)
     (bin-op (">") great)
     (bin-op (">=") great-eq)
     (bin-op ("<") less)
     (bin-op ("<=") less-eq)
     (bin-op ("==") equal)
     (bin-op ("!=") not-equal)
     (bin-op ("and") and-op)
     (bin-op ("&&") and-op)
     (bin-op ("or") or-op)
     (bin-op ("||") or-op)
     ;;Rangos:
     ;; Solo admite 2 argumentos, no se puede operar más de 1 vez
     ;;Inclusivo: va hasta el limite superior
     (bin-op ("..") in-range)
     ;;Exclusivo: va hasta un step antes del limite superior
     (bin-op ("...") ex-range)
     ;; Ejemplo: (1..5) => (1 2 3 4 5)
     ;; Ejemplo: (1...5) => (1 2 3 4)
     ;; Ejemplo: ((1..5) .. 6) => Error
     (bin-op ("step") st-range)
     ;; Ejemplo: ((1..5) step 2) => (1 3 5)
     ;; Ejemplo: ((1..5) step -1) => Error
     ;; Ejemplo: ((-1..-5) step -2) => (-1 -3 -5)
     ;; Ejemplo: ((1..-5) step 2) => Error

     ;;Operación asignación
     (assign-op ("+=") add-eq)
     (assign-op ("-=") diff-eq)
     (assign-op ("*=") mult-eq)
     (assign-op ("/=") div-eq)
     (assign-op ("**=") pow-eq)

     ;;Operación unitaria
     (un-op ("not") not-op)
     (un-op ("!") not-op)

     ;;##############################################
     ;; Parte 2: Ruby con objetos
     ;(class-decl ("class" identifier
     ;                     (arbno "<" identifier)
     ;                     "attr" (separated-list ":" identifier ",") ";"
     ;                     (arbno method-decl) "end") a-class-decl)

     ;(method-decl ("def" identifier "(" (separated-list identifier ",") ")"
     ;             exp-batch
     ;             "end") a-method-decl)

  )
)

;Construidos automáticamente:


(sllgen:make-define-datatypes lexical-spec grammar-spec)

(define show-the-datatypes
  (lambda () (sllgen:list-define-datatypes lexical-spec grammar-spec)))

;*******************************************************************************************
;Parser, Scanner, Interfaz

;El FrontEnd (Análisis léxico (scanner) y sintáctico (parser) integrados)

(define scan&parse
  (sllgen:make-string-parser lexical-spec grammar-spec))

;El Analizador Léxico (Scanner)

(define scan
  (sllgen:make-string-scanner lexical-spec grammar-spec))

;El Interpretador (FrontEnd + Evaluación + señal para lectura )

(define interpretador
  (sllgen:make-rep-loop  "--> "
    (lambda (pgm) (eval-program pgm))
    (sllgen:make-stream-parser
      lexical-spec
      grammar-spec)))

;*******************************************************************************************
;*******************************************************************************************
;Procedimientos
(define-datatype procval procval?
  (closure
   (ids (list-of symbol?))
   (body exp-batch?)
   (env environment?)
   ))

;apply-procedure: evalua el cuerpo de un procedimientos en el ambiente extendido correspondiente
(define apply-procedure
  (lambda (proc args env)
    (cases procval proc
      (closure (ids body env)
               ; |Evaluar el cuerpo de una función
;;quitar '
               '(eval-exp-batch body (extend-env ids args env))
               )
      )
    )
  )
;*******************************************************************************************

(define (eval-program pgm)
  (cases ruby-program pgm
    (a-program (a-batch) (eval-exp-batch a-batch (empty-env)))
    )
  )

(define (eval-exp-batch batch env)
  (cases exp-batch batch
    (a-batch (exp exps) (eval-expressions exp exps env))
    )
  )
; eval-a-batch: exp exps env
(define (eval-expressions exp exps env)
  (let loop ((acc (eval-expression exp env))
                             (exps exps))
                    (if (null? exps)
                        acc
                        (loop (eval-expression (car exps)
                                               env)
                              (cdr exps)))))

(define (eval-expression exp env)
  (cases expression exp
    (puts-exp (vals)
              ;TO-DO;
              ; map: evaluar valores en la lista | for-each: imprimir valores evaluados
              (eopl:pretty-print vals))
    (else "TO DO")
    ;simple-exp
    ;declare-exp
    ;if-exp
    ;unless-exp
    ;while-exp
    ;until-exp
    ;for-exp
    ;function-exp
    ;return-exp
    )
  )

; eval-comp-value c-value env => (cases comp-value c-value (a-value ...) (unop-value ...))
;   evalúa un valor compuesto,
;     1) si es a-value llamaría eval-value,
;     2) si es unop-value: evaluaría la un-op y aplicaría sobre el llamado recursivo de eval-comp-value
(define (eval-comp-value c-value env)
  (cases comp-value c-value
    (a-value (value) (eval-value value env))
    (unop-value (un-op comp-value) (eval-comp-value (eval-value un-op env) env))))


; eval-value a-value env => (cases value a-value (simple-val ...) (compl-val ...))
;   evalúa un valor, tiene 2 casos:
;     1) un valor simple que se evaluaría con eval-simple-value
;     2) un valor con complemento, se llama eval-val-compl con c-val evaluado y
;        a-val-compl (c-val es un comp-value, a-val-compl es un val-compl)

; eval-val-compl a-val a-val-compl env => (cases val-compl a-val-compl (val-call ...) (binop-val ...))
;  evalúa un complemento sobre un c-val, tiene 2 casos:
;    1) val-call(some-calls) entonces se tienen que aplicar los argumentos
;    2) binop-val(binop c-val) entonces se aplica una bin-op entre a.val y la evaluacion
;       de c-val (c-val es un comp-value)

; eval-simple-value s-val env (cases simple-value s-val (id-val ...) (num-val ...) (true-val ...))
;   evalúa un valor simple, comprende los casos desde id-val hasta arr-val
;   para el caso de id-val se debe hacer apply-env
(define (eval-simple-value s-val env)
   (cases simple-value s-val
    (id-val (identifier) (apply-env env identifier))
    (int-val (number) number)
    (str-val (text) text)
    (true-val () 'true)
    (false-val () 'false)
    (nil-val () 'nil)
    (arr-val (comp-values)(eval-comp-value (car comp-value) env))))

;*******************************************************************************************
;Referencias
(define-datatype reference reference?
  (a-ref (position integer?)
         (vec vector?)))

(define deref
  (lambda (ref)
    (primitive-deref ref)))

(define primitive-deref
  (lambda (ref)
    (cases reference ref
      (a-ref (pos vec)
             (vector-ref vec pos)))))

(define setref!
  (lambda (ref val)
    (primitive-setref! ref val)))

(define primitive-setref!
  (lambda (ref val)
    (cases reference ref
      (a-ref (pos vec)
             (vector-set! vec pos val)))))

;*******************************************************************************************
;*******************************************************************************************
;Ambientes

;definición del tipo de dato ambiente
(define-datatype environment environment?
  (empty-env-record)
  (extended-env-record
   (syms (list-of symbol?))
   (vec  vector?)
   (env environment?)))

(define scheme-value? (lambda (v) #t))

;empty-env:      -> enviroment
;función que crea un ambiente vacío
(define empty-env
  (lambda ()
    (empty-env-record)))       ;llamado al constructor de ambiente vacío


;extend-env: <list-of symbols> <list-of numbers> enviroment -> enviroment
;función que crea un ambiente extendido
(define extend-env
  (lambda (syms vals env)
    (extended-env-record syms (list->vector vals) env)))

;extend-env-recursively: <list-of symbols> <list-of <list-of symbols>> <list-of expressions> environment -> environment
;función que crea un ambiente extendido para procedimientos recursivos
(define extend-env-recursively
  (lambda (proc-names idss bodies old-env)
    (let ((len (length proc-names)))
      (let ((vec (make-vector len)))
        (let ((env (extended-env-record proc-names vec old-env)))
          (for-each
            (lambda (pos ids body)
              (vector-set! vec pos (closure ids body env)))
            (iota len) idss bodies)
          env)))))

; |Ambiente recursivo para un solo procedimiento

(define (a-recursive-env a-proc-name ids body env)
  (let ((vec (make-vector 1)))
    (let ((env (extended-env-record (list a-proc-name) vec env)))
          (vector-set! vec 0 (closure ids body env))
          env)
    )
  )

;iota: number -> list
;función que retorna una lista de los números desde 0 hasta end
(define iota
  (lambda (end)
    (let loop ((next 0))
      (if (>= next end) '()
        (cons next (loop (+ 1 next)))))))

;función que busca un símbolo en un ambiente
(define apply-env
  (lambda (env sym)
    (deref (apply-env-ref env sym))))

(define apply-env-ref
  (lambda (env sym)
    (cases environment env
      (empty-env-record ()
                        (eopl:error 'Error "undefined local variable or method ~s" sym))
      (extended-env-record (syms vals env)
                           (let ((pos (rib-find-position sym syms)))
                             (if (number? pos)
                                 (a-ref pos vals)
                                 (apply-env-ref env sym)))))))

;*******************************************************************************************
;*******************************************************************************************
;Ambiente inicial

(define (init-env) (empty-env))
;*******************************************************************************************
;*******************************************************************************************
;Funciones Auxiliares

; funciones auxiliares para encontrar la posición de un símbolo
; en la lista de símbolos de un ambiente

(define rib-find-position
  (lambda (sym los)
    (list-find-position sym los)))

(define list-find-position
  (lambda (sym los)
    (list-index (lambda (sym1) (eqv? sym1 sym)) los)))

(define list-index
  (lambda (pred ls)
    (cond
      ((null? ls) #f)
      ((pred (car ls)) 0)
      (else (let ((list-index-r (list-index pred (cdr ls))))
              (if (number? list-index-r)
                (+ list-index-r 1)
                #f))))))

;*******************************************************************************************
;*******************************************************************************************
;;;Rangos
(define-datatype range range?
  (inclusive (start number?) (end number?) (step number?))
  (exclusive (start number?) (end number?) (step number?))
  )

(define (eval-range a-range)
  (cases range a-range
    (inclusive (start end step) (iota-range start end step))
    (exclusive (start end step) (iota-range start (- end 1) step))
    )
  )

;;Función que retorna una lista dado un inicio, un final, y un incremento
(define iota-range
  (lambda (start end step)
    (cond [(or
            (and (< start end) (> 0 step))
            (and (> start end) (< 0 step)))
           (eopl:error 'Step "bad step")]
          [else
           (let loop ((next start))
             (if (= 0 (abs (- next end)))
                 (list next)
                 (cons next (loop (+ next step)))))]
          )
    ))