(* --------------------------------------------------------------- *)
(* ------------------------- Prima  Parte ------------------------ *)
(* --------------------------------------------------------------- *)
(* --------------------------------------------------------------- *)


(* --------------------------------------------------------------- *)
(* ------------------------ Dichiarazioni ------------------------ *)
(* --------------------------------------------------------------- *)

load "Int";

datatype token = LET | IN | END | LETREC | AND | LAMBDA | OP | ID | SYM | NM| STR | BOOL | Nil| Notoken 

datatype s_espressione = NUM of int | STRINGA of string | T | F | NIL | DOT of s_espressione * s_espressione 

datatype Sexpr = Var of string | Quote of s_espressione | Op of string * Sexpr list | If of Sexpr * Sexpr * Sexpr | Lambda of string list * Sexpr | Call of Sexpr * Sexpr list | Let of Sexpr * string list * Sexpr list | Letrec of Sexpr * string list * Sexpr list 

datatype meta_S = M of s_espressione | S of string 

type token_lexema = token * meta_S 

exception e of string; 


(* --------------------------------------------------------------- *)
(* ------------------------ Funzioni 1parte----------------------- *)
(* --------------------------------------------------------------- *)

fun lexi(s:string, tkl: token_lexema list): token_lexema list =  
let 
val L = explode s

fun isletter(c: char): bool =
	if c = #"a" orelse c = #"b" orelse c = #"c" orelse c = #"d" orelse c = #"e"
	orelse c = #"f" orelse c = #"g" orelse c = #"h" orelse c = #"i"
	orelse c = #"j" orelse c = #"k" orelse c = #"l" orelse c = #"m"
	orelse c = #"n" orelse c = #"o" orelse c = #"p" orelse c = #"q"
	orelse c = #"r" orelse c = #"s" orelse c = #"t" orelse c = #"u"
	orelse c = #"v" orelse c = #"w" orelse c = #"x" orelse c = #"y"
	orelse c = #"z" orelse
	c = #"A" orelse c = #"B" orelse c = #"C" orelse c = #"D" orelse c = #"E"
	orelse c = #"F" orelse c = #"G" orelse c = #"H" orelse c = #"I"
	orelse c = #"J" orelse c = #"K" orelse c = #"L" orelse c = #"M"
	orelse c = #"N" orelse c = #"O" orelse c = #"P" orelse c = #"Q"
	orelse c = #"R" orelse c = #"S" orelse c = #"T" orelse c = #"U"
	orelse c = #"V" orelse c = #"W" orelse c = #"X" orelse c = #"Y"
	orelse c = #"Z" orelse c= #"_"
	then true
	else false;
fun isnumero(c: char): bool =
   if c = #"~" orelse c = #"0" orelse c = #"1" orelse c = #"2" orelse c = #"3" orelse c = #"4" orelse c = #"5" orelse c = #"6" orelse c = #"7" orelse c = #"8" orelse c = #"9"
	then true
	else false;
fun isKey(c: string): bool =
	if c = "LET" orelse c = "IN" orelse c = "END" orelse c = "AND" orelse c = "NIL" orelse c = "ADD" orelse c = "SUB" orelse c = "MUL" orelse	c = "DIV" orelse c = "REM" orelse c = "EQ" orelse c = "LEQ" orelse c = "CAR" orelse c = "CDR" orelse c = "CONS" orelse c = "ATOM" orelse c = "IF" orelse c = "LAMBDA" orelse
	c = "in" orelse c = "end" orelse c = "and" orelse c = "nil" orelse c = "add" orelse c = "sub" orelse c = "mul" orelse c = "div" orelse c = "rem" orelse c = "eq" orelse c = "leq" orelse c = "car" orelse c = "cdr" orelse c = "cons" orelse c = "atom" orelse c = "if" orelse c = "lambda"
	then true
	else false;

fun ccStringa(nil,R) = (nil ,nil)
| ccStringa(x::l,R) = if x <> #"\"" then ccStringa(l,x::R) else (nil,nil)

fun ccNumero(nil,R) = (nil,R)
| ccNumero(x::l,R) = if isnumero(x) then ccNumero(l,x::R) else (x::l,R)

fun creaTokenLexema(c:string): token_lexema = 
	if c = "LET" then (LET,S c ) else if
	c = "IN" then (IN,S c ) else if 
	c = "END" then (END,S c ) else if 
	c = "LETREC" then (LETREC,S c ) else if 
	c = "AND" then (AND,S c ) else if 
	c = "NIL" then (Nil,M NIL ) else if 
	c = "T" then (BOOL,M T ) else if 
	c = "F" then (BOOL,M F ) else if 
	c = "ADD" then (OP,S c ) else if
	c = "SUB" then (OP,S c ) else if
	c = "MUL" then (OP,S c ) else if
	c = "DIV" then (OP,S c ) else if
	c = "REM" then (OP,S c ) else if
	c = "EQ" then (OP,S c ) else if
	c = "LEQ" then (OP,S c ) else if
	c = "CAR" then (OP,S c ) else if
	c = "CDR" then (OP,S c ) else if
	c = "CONS" then (OP,S c ) else if
	c = "ATOM" then (OP,S c ) else if
	c = "IF" then (OP,S c ) else if
	c = "LAMBDA" then (LAMBDA,S c ) else if

	c = "let" then (LET,S c ) else if
	c = "in" then (IN,S c ) else if 
	c = "end" then (END,S c ) else if 
	c = "letrec" then (LETREC,S c ) else if 
	c = "and" then (AND,S c ) else if 
	c = "nil" then (Nil,M NIL ) else if 
	c = "t" then (BOOL,M T ) else if 
	c = "f" then (BOOL,M F ) else if 
	c = "add" then (OP,S c ) else if
	c = "sub" then (OP,S c ) else if
	c = "mul" then (OP,S c ) else if
	c = "div" then (OP,S c ) else if
	c = "rem" then (OP,S c ) else if
	c = "eq" then (OP,S c ) else if
	c = "leq" then (OP,S c ) else if
	c = "car" then (OP,S c ) else if
	c = "cdr" then (OP,S c ) else if
	c = "cons" then (OP,S c ) else if
	c = "atom" then (OP,S c ) else if
	c = "if" then (OP,S c ) else if
	c = "lambda" then (LAMBDA,S c ) 
	else (ID,S c );


fun ccKey(nil,L) = (nil,"")
| ccKey(x::l,L) =
 (* ho letto uno spazio quindi è una ID *)
 if x = #" " then 
    let
    (* ho il problema che in ID come questa *)
    (* FACT il programma mi prenderebbe:    *)
    (* (BOOL,M F) , (ID,S "ACT") e non va   *)
    (* bene.                                *)
      val stringa = implode(L)
    in
      if stringa = "T " then (l,"T")
      else if stringa = "F " then (l,"F")
      else (l,implode(L))
    end
 else if isletter(x) then (* controllo che sia un carattere *)
	if isKey(implode(L@[x])) then 
	        (* controllo che non sia LETREC *)
		if hd(l) = #"R" andalso hd(tl(l)) = #"E" andalso hd(tl(tl(l))) = #"C" 
		orelse hd(l) = #"r" andalso hd(tl(l)) = #"e" andalso hd(tl(tl(l))) = #"c" 
		then (tl(tl(tl(l))),implode (L@[x]@(hd(l)::hd(tl(l))::hd(tl(tl(l)))::nil)) ) (* "LETREC" *)
		else ( l,implode(L@[x]) )
	else ccKey(l,L@[x])
 else raise e("non e’ un carattere") (* se non è un carattere torno *)

(* FUNZIONE PRINCIPALE *)
fun principale(nil,tkl: token_lexema list) = tkl
| principale(x::l,tkl: token_lexema list) =

   if isletter(x) then
	let
	   val(resto,stringa)=ccKey(x::l,[])
	   val risultato = creaTokenLexema(stringa)
	in
	   principale(resto,risultato::tkl )
	end
   else if isnumero(x) then
	let
	   val(resto,numeroRis)=ccNumero(x::l,[])
	   val stringaRis = implode(numeroRis)
	   val intRis = valOf(Int.fromString(stringaRis))
	in
	   principale( resto , ( NM,M(NUM(intRis)) )::tkl )
	end

   else
     case x of 
	(* SEGNI DI PUNTEGGIATURA *)
	#"(" => principale(l, (SYM,S (str x))::tkl ) | 
	#")" => principale(l, (SYM,S (str x))::tkl ) | 
	#"[" => principale(l, (SYM,S (str x))::tkl ) | 
	#"]" => principale(l, (SYM,S (str x))::tkl ) | 
	#"=" => principale(l, (SYM,S (str x))::tkl ) | 
	#":" => if hd(l) = #":" then principale(tl(l), (SYM,S "::")::tkl ) 
		else raise e("errore :: ho un solo :") |
	#"$" => principale(l, (SYM,S (str x) )::tkl ) |
	(* STRINGHE *)
	#"\"" => 	
		let
		   val(resto,stringa)=ccStringa(x::l,[])
		   val stringaRis = implode(stringa)
		in
		   principale(resto , (SYM,S (stringaRis))::tkl ) 
		end |
	(* cioè se è uno spazio !! --> lo ignoro !! *)
	_ => principale(l, tkl )

in
	rev (principale(L,tkl))
end;


(* --------------------------------------------------------------- *)
(* ------------------------ Seconda Parte ------------------------ *)
(* --------------------------------------------------------------- *)
(* --------------------------------------------------------------- *)


(* --------------------------------------------------------------- *)
(* ------------------------ Funzioni 2parte----------------------- *)
(* --------------------------------------------------------------- *)


(* estrae la constante dal costruttore di M meta_S *) 
fun quoting(M(Y)) = Y | quoting(S(X))= raise e("quoting applicato al costruttore")
and 
(* estrae la stringa dal costruttore di S meta_S *) 
unS(S(Y)) = Y | unS(M(Y))= raise e("estrazione stringa da costruttore M") 
and 
(* estrae la stringa dal costruttore di Var di Sexpr *) 
unVar(Var(Y))=Y | unVar(_) = raise e("estrazione nome variabile da costruttore errato") 
and 
(*testa se un token rappresenta una costante semplice *) 
constant(t:token): bool = t=NM orelse t=STR orelse t=BOOL 
and 
(* ********************************* *)
(* *mancava: orelse t=Nil*********** *)
(* ********************************* *)
(* testa se un token appartiene a FIRST di k *) 
expfirst(t:token): bool = constant(t) orelse t=LET orelse t=LETREC orelse t=OP orelse t=LAMBDA orelse t=ID orelse t=Nil
and 
(* funzione corrispondente al terminale const *) 
const(tkl:token_lexema list): s_espressione*token_lexema list = 
let 
   val tkhd = #1(hd(tkl)) 
   val lxhd = #2(hd(tkl)) 
in 
   case tkhd of 
      NM => (quoting(lxhd),tl(tkl)) | (* numero *) 
      STR => (quoting(lxhd),tl(tkl)) | (* stringa *) 
      BOOL => (quoting(lxhd),tl(tkl)) | (* T of F *) 
      _ => raise e("const applicato a una non-costante") 
end 
and 
(*funzione corrispondente al terminale var *) 
var(tkl:token_lexema list): Sexpr*token_lexema list= 
let 
   val tkhd = #1(hd(tkl)) 
   val lxhd = #2(hd(tkl)) 
in 
   if tkhd = ID then (Var(unS(lxhd)),tl(tkl)) else raise e("non e’una variabile") 
end 
and 
(*funzione corrispondente al nonterminale Seq_Var *) 
seqvar(tkl:token_lexema list): Sexpr list * token_lexema list= 
let 
   val tkhd = #1(hd(tkl)) 
   val lxhd = #2(hd(tkl)) 
in 
   if tkhd = ID then (*se e’ una variabile*) 
      let 
         val (sv,tv)=var(tkl) (*prendi primo elemento della sequenza*) 
         val (ls,ts)=w(tv) (*riconosci ricorsivamente il resto della sequenza *) 
      in (sv::ls,ts) (*concatena e restituisci il resto della lista token_lexe *)
      end 
   else raise e("la sequenza di variabili non inizia con una variabile ") 
end 
and 
(*funzione ausiliaria di seqvar*) 
w(tkl:token_lexema list): Sexpr list * token_lexema list= 
   let 
      val tkhd = #1(hd(tkl)) 
      val lxhd = #2(hd(tkl)) 
   in 
      if tkhd = ID then seqvar(tkl) 
      else ([],tkl) 
   end 
and 
v(tkl:token_lexema list)= 
   if hd(tkl) = (SYM, S("::")) then constlist(tl(tkl)) 
   else (NIL,tkl) 
and 
constlist(tkl:token_lexema list)= 
   let  
      val tkhd = #1(hd(tkl)) 
      val lxhd = #2(hd(tkl)) 
   in 
      if (constant(tkhd)) then 
         let 
            val (sc,tc) = const(tkl) 
            val (sv,tv) = v(tc) 
         in (DOT(sc,sv),tv) end 
      else 
         if ( hd(tkl)=(SYM,S("[")) orelse hd(tkl)=(Nil,M(NIL)) ) then 
            let 
               val (sl,tl) = lista(tkl) 
               val (sv,tv) = v(tl) 
            in (DOT(sl,sv),tv) end 
         else raise e("token non compatibile con lista di costanti") 
   end 
and 
(* funzione corrispondente al nonterminale list*) 
lista(tkl:token_lexema list)= 
   let 
      val tkhd = #1(hd(tkl)) 
      val lxhd = #2(hd(tkl)) 
   in 	
      if tkhd = Nil then (NIL,tl(tkl)) (*lista vuota *) 
      else if (tkhd = SYM andalso lxhd=S("[")) (* altrimenti inizia con[ *) then
         let 
            val (cl,tr) = constlist(tl(tkl)) (* riconosco gli elementi della lista *) 
         in 
            if (hd(tr) <> (SYM,S("]"))) (* deve rimanere ] *) 
            then raise e("lista non chiusa correttamente") 
            else (cl,tl(tr)) 
         end 
      else raise e("non e’ una lista") 
   end 

(* --------------------FUNZIONE EXP DA FARE-------------- *)
and
(* funzione corrispondente al nonterminale Exp : DA FARE *)
exp(tkl:token_lexema list):Sexpr*token_lexema list= 
let
   val tkhd = #1(hd(tkl)) 
   val lxhd = #2(hd(tkl))
in
   case tkhd of
      LET => prog(tkl) |
      LETREC => prog(tkl) |
      ID => 
      (* Dentro a ID considero il caso di Y        *)
      if hd(tl(tkl)) = (SYM ,S("(")) then
         let
	    val (lista, resto) = seqexp(tl(#2(var(tkl))))
	 in
	    if hd(resto) = (SYM ,S(")")) then 
	       (Call(#1(var(tkl)) , lista), tl(resto))
	    else raise e("manca ) nel caso Y di ID")
	 end
      else var(tkl) |
      OP => if hd(tl(tkl)) = (SYM ,S("(")) then
               (* ho controllato che ci sia la parentesi dopo l'operatore  *)
	       (* ora:poichè IF-THE-ELSE e' particolare lo risolto a parte *)
	       if unS(lxhd) = "IF" then
	          let
		     (* tl(tl(tkl) perche': non passo a exp OP e (  sia      *)
		     (* perche sarebbe un errore logico che mi causerebbe    *)
		     (* tra l'altro un loop infinito                         *)
		     val (risultato_condizione , resto_condizione) = exp(tl(tl(tkl)))
		     val (risultato_then , resto_then) = exp(resto_condizione)
		     val (risultato_else , resto_else) = exp(resto_then)
	          in
		     (* controllo che ci sia la parentesi )                  *)
		     if hd(resto_else) = (SYM ,S(")")) then
		        (* tl(resto_else) perche: non gli passo la parentesi )  *)
		        (If(risultato_condizione,risultato_then,risultato_else),tl(resto_else))
		     else raise e("Manca la parentesi ) ad IF")
	          end
	       else
	       (* per tutti gli altri operandi posso usare lo stesso costrutto *)
	          let
		     val (risultato,resto) = seqexp(tl(tl(tkl)))
		     val operatore = unS(lxhd)
		  in
		     if hd(resto) = (SYM ,S(")")) then
		        (Op(operatore,risultato),tl(resto))
		     else raise e("Manca la parentesi ) a OP")
		  end
            else raise e("Manca la parentesi ( dopo l'operatore") |
      LAMBDA => if hd(tl(tkl)) = (SYM ,S("(")) then
                (* controllo che ci sia ( delle variabili di LAMBA    *)
		   let
		   (* mangio le variabili tra le parentesi ( )             *)
		      val(variabili,resto) = seqvar(tl(tl(tkl)))
		   in
		      (* controllo che ci sia ) delle variabili di LAMBA    *)
		      if hd(resto) = (SYM ,S(")")) then
		         let
			    (* ovviamnte ora devo mangiare le exp del LAMBDA      *)
			    val (risultato_exp,resto_exp)=exp(tl(resto))
			    (* mi serve la lista dei nomi delle variabili durante *)
			    (* la costruzione del Lambda.                         *)
			    fun SexprToString(nil:Sexpr list): string list = [] |
			    SexprToString(listaSexpr:Sexpr list): string list = unVar(hd(listaSexpr))::SexprToString(tl(listaSexpr))
			 in
			    (Lambda(SexprToString(variabili),risultato_exp),resto_exp)
			 end
		      else raise e("Manca la parentesi ) dopo LAMBDA")
		   end
                else raise e("Manca la parentesi ( dopo LAMBDA") |
      _ => if constant(tkhd) then
              let val (risultato,resto) = const(tkl) in (Quote(risultato), resto) end
	   else if (hd(tkl)=(SYM,S("[")) orelse hd(tkl)=(Nil,M(NIL)) ) then
	   (* Considero cioè i cue casi: SYM,S("[") e Nil,M(NIL) *)
	      let val (risultato,resto) = lista(tkl) in (Quote(risultato), resto) end
	   else raise e("errore CASE di exp: tkhd no match")
end
(* -------------FINE --FUNZIONE EXP DA FARE-------------- *)

and 
(* funzione corrispondente al non terminale Seq_Exp *) 
seqexp(tkl:token_lexema list): Sexpr list * token_lexema list= 
   let 
      val tkhd = #1(hd(tkl)) 
      val lxhd = #2(hd(tkl)) 
   in 
      if (expfirst(tkhd) orelse (tkhd = SYM andalso lxhd=S("[")))     
      then (* comincia con una espressione*) 
         let 
            val (se,te)=exp(tkl) 
            val (ls,ts)=z(te) 
         in (se::ls,ts) end 
      else raise e("la sequenza di espressioni non inizia con una espressione") 
   end 
and 
(* funzione corrispondente al non terminale Z*) 
z(tkl:token_lexema list): Sexpr list * token_lexema list= 
   let 
      val tkhd = #1(hd(tkl)) 
      val lxhd = #2(hd(tkl)) 
   in 
      if (expfirst(tkhd) orelse (tkhd = SYM andalso lxhd=S("["))) 
      then seqexp(tkl) 
      else ([],tkl) 
   end 
and 
(* funzione corrispondente al non terminale Bind *) 
bind(tkl:token_lexema list): string list * Sexpr list *token_lexema list= 
   let 
      val tkhd = #1(hd(tkl)) 
      val lxhd = #2(hd(tkl)) 
   in 
      if(tkhd = ID) then 
         let 
            val sr = unS(lxhd); (* prima variabile *) 
            val (er,ter) = exp(tl(tl(tkl))) (* espressione corrispondente alla prima variabile *) 
            val (fw1,fw2,tf) = x(ter) (*riconosci il resto del bind*) 
         in (sr::fw1,er::fw2,tf) end 
      else raise e("il bind non comicia con un identificatore ") 
   end 
and 
(* funzione corrispondente al non terminale X*) 
x(tkl:token_lexema list): string list * Sexpr list *token_lexema list= 
   let 
      val tkhd = #1(hd(tkl)) 
      val lxhd = #2(hd(tkl)) 
   in 
      case tkhd of 
         AND => bind(tl(tkl)) | 
         _ => ([],[],tkl) 
   end

(* --------------------FUNZIONE PROG DA FARE------------- *)
and
(* funzione corrispondente al nonterminale Prog: DA FARE *)
prog(tkl:token_lexema list): Sexpr*token_lexema list=
   let 
      val tkhd = #1(hd(tkl)) (* estraggo: token *)
      val lxhd = #2(hd(tkl)) (* estraggo: meta_S *)
   in
      (* controllo che il primo token sia Let o Letrec, *)
      (* se non e' cosi lancio l'eccezione *)
      if ( tkhd = LET orelse tkhd = LETREC ) then
         let
	    (* devo lanciare BIND,che genera la sequenza *)
	    (* di dichiarazioni locali nella forma x1=e1 *)
	    (* Per tener traccia del risultato uso delle *)
	    (* variabili locali che mi tengono il        *)
	    (* risulatato della funzione BIND.           *)
	    (* Ovviamente a bind gli passiamo la token_  *)
	    (* lexema list che rimane dopo aver letto    *)
	    (* Let o Letrec                              *)
	    (*                                           *)
	    (* MEMO => bind(tkl:token_lexema list):      *)
	    (* string list*Sexpr list*token_lexema list  *)
	    val (lista_stringhe,lista_Sexp,resto_bind) = bind(tl(tkl))
	 in
	    (* controllo che ora ci sia IN               *)
	    if ( #1(hd(resto_bind)) = IN ) then
	       let
	       (* come prima,ma ora lanciola funzione exp   *)
	       (* se tutto va bene una volta eseguita exp   *)
	       (* mi devo trovare END                       *)
	       val (risultato_exp,resto_exp) = exp(tl(resto_bind))
	       in
	         if ( #1(hd(resto_exp)) = END ) then
		    (* OK va tutto bene non mi rimane altro che  *)
		    (* restituire il risultato in base se ho     *)
		    (* trovato LET o LETREC.                     *)
		    (* tkhd e' la testa della list del primo let *)
		    if ( tkhd = LET) then
		    (* Dove:                                     *)
		    (*   risultato_exp =>  corpo del let         *)
		    (*   lista_stringhe => le varibili del LET   *)
		    (*   lista_Sexp => i valori delle variabili  *)
		       (Let(risultato_exp,lista_stringhe,lista_Sexp),tl(resto_exp))
		    (* quindi se non e' LET e' LETREC            *)
		    else
		       (Letrec(risultato_exp,lista_stringhe,lista_Sexp),tl(resto_exp))
		 else raise e("mi aspettavo END ")
	       end

	    else raise e("mi aspettavo IN ")

	 end
      else raise e("prog non comicia con Let o con Letrec ")
  end;

(* --------------------------------------------------------------- *)
(* --------------------------------------------------------------- *)
(* --------------------PROVA ESECUZIONE PROGRAMMA ---------------- *)
(* --------------------------------------------------------------- *)
(* --------------------------------------------------------------- *)

val stringaInput="let N = 3 and L = LAMBDA ( P Q R ) DIV (ADD ( ADD ( MUL ( P P ) MUL ( Q Q ) ) MUL ( R R ) ) N ) in L ( 2 4 6 ) end $";
lexi(stringaInput,[]);
prog(lexi(stringaInput,[]));

val stringaInput="let N = 3 and L = LAMBDA ( P Q R ) DIV (ADD ( ADD ( MUL ( P P ) MUL ( Q Q ) ) MUL ( R R ) ) N ) in L ( 2 4 6 ) end $";
lexi(stringaInput,[]);
prog(lexi(stringaInput,[]));

val stringaInput="letrec FACT = LAMBDA ( X ) IF ( EQ ( X 0 ) 1 MUL ( X FACT ( SUB ( X 1 ) ) ) ) and G = LAMBDA ( H L ) IF ( EQ ( L NIL ) L CONS ( H ( CAR ( L ) ) G ( H CDR ( L ) ) ) ) in G ( FACT [2::3::4::5] ) end $";
lexi(stringaInput,[]);
prog(lexi(stringaInput,[]));