0
type ide = string;;
type integer = int;;
(*Eccezioni*)
exception WrongMatchException;;
exception EmptyEnvException;;
exception TypeErrorException;;
exception UnboundRecordException;;
exception OutOfBoundException;;
type exp =
| Ide of ide (*Identificatore*)
| Int of int (*Valori Interi*)
| Bool of bool (*Valori Booleani, true=1, false=0*)
| Add of exp * exp (*Operatori Matematici*)
| Sub of exp * exp
| Mul of exp * exp
| Eq of exp * exp
| Leq of exp * exp
| And of exp * exp (*Operatori Logici*)
| Or of exp * exp
| Not of exp
| Function of ide * ide * exp (*Funzione con un parametro, non ricorsiva*)
| IfThenElse of exp * exp * exp (*Classico If Then Else *)
| LetIn of ide * exp * exp (*Blocco Let*)
| FunApply of ide * exp (*Applicazione funzionale Ide(E)*)
| Tupla of ide * elts (*Espressione Tupla*)
| GetIndex of elts * exp (*Accesso Elemento Tupla*)
| GetFirstN of elts * exp (* Seleziona elementi Tupla*)
| TupleEquals of elts * elts (*Confronto tra tuple*)
| Map of ide * exp (*Applica funzione ad elementi tupla*)
| ListaE of elts
and
(*Elementi di una tupla*)
elts = Elemento of exp | Lista of exp list
;;
(* the empty environment *)
(* emptyEnv: 'a -> 'b *)
let emptyEnv = fun x -> raise EmptyEnvException;;
let emptyFunEnv = fun x -> raise EmptyEnvException;;
let emptyTuplaEnv = fun x -> raise EmptyEnvException;;
(*bind: ('a -> 'b) -> ide -> exp -> (ide -> exp) *)
let bind env (variable: ide) value = fun y ->
if variable = y then value else env y;;
(*Funzioni di supporto*)
(*Casting da exp a tipi primitivi*)
let asint = function Int x -> x | _ -> failwith "not an integer";;
let asbool = function Bool x -> x | _ -> failwith "not a boolean";;
let aslist = function Lista x -> x | _ -> failwith "not a list";;
(*Cast da Lista_exp to Lista_elts *)
let aslist_e = function ListaE x -> x | _ -> failwith "not a list_e";;
let tupla2Lista = function Tupla(x, y) -> y | _ -> failwith "non a tupla";;
let rec getElement lista index = match lista with
| [] -> raise OutOfBoundException
| primo::elems -> if index = 0 then primo else getElement elems (index-1);;
let rec first lista number = if number = 0 then [] else
let lista1 = aslist(lista) in
match lista1 with
| [] -> raise OutOfBoundException
| primo::elems -> let resto = Lista(elems) in primo::(first resto (number-1));;
let rec map lista funct = match lista with
| [] -> []
| elem::elems -> (funct elem)::(map elems funct);;
let rec valTuple lista eval_fun env funenv tenv = match lista with
| [] -> []
| elem::elems -> (eval_fun elem env funenv tenv)::(valTuple elems eval_fun env funenv tenv);;
let funDeclr (expression: exp) env funenv = match expression with
| Function (funName, param, body) -> bind funenv funName (param, body, env)
| _ -> raise WrongMatchException;;
let tupleDeclr (tupla: exp) env tenv = match tupla with
| Tupla (id, lista) -> bind tenv id lista
| _ -> raise WrongMatchException;;
let append elemento lista2 = let lista21 = aslist (aslist_e lista2)
in elemento::lista21
let appendE elemExp elemExpLE = let listaE = aslist_e elemExpLE in
match listaE with
| Elemento (expr) -> Lista(elemExp::[expr])
| Lista (exprlist) -> Lista(elemExp::exprlist);;
let rec eval (expression: exp) env funenv tenv =
match expression with
| Int i -> Int(i)
| Ide i -> env i
| Bool i -> Bool(i)
| Add (e1, e2) -> Int(asint(eval e1 env funenv tenv) + asint(eval e2 env funenv tenv))
| Sub (e1, e2) -> Int(asint(eval e1 env funenv tenv) - asint(eval e2 env funenv tenv))
| Mul (e1, e2) -> Int(asint(eval e1 env funenv tenv) * asint(eval e2 env funenv tenv))
| Eq (e1, e2) -> if (eval e1 env funenv tenv) = (eval e2 env funenv tenv) then Bool(true) else Bool(false)
| Leq (e1, e2) -> if (eval e1 env funenv tenv) <= (eval e2 env funenv tenv) then Bool(true) else Bool(false)
| And (e1, e2) -> if asbool(eval e1 env funenv tenv) && asbool(eval e2 env funenv tenv) then Bool(true) else Bool(false)
| Or (e1, e2) -> if asbool(eval e1 env funenv tenv) || asbool(eval e2 env funenv tenv) then Bool(true) else Bool(false)
| Not (e1) -> if asbool(eval e1 env funenv tenv) then Bool(false) else Bool(true)
| FunApply (funName, arg) -> (*Chiamata di funzione*)
let value = eval arg env funenv tenv in
let (param, body, ambiente) = funenv funName in
let env1 = bind env param value in
eval body env1 funenv tenv
| IfThenElse (e1, e2, e3) -> if asbool(eval e1 env funenv tenv) then eval e2 env funenv tenv
else eval e3 env funenv tenv
| LetIn (id, value, body) -> let value = eval value env funenv tenv in
let env1 = bind env id value in
eval body env1 funenv tenv
(*| Tupla (id, lista) -> let lista1 = aslist(lista) in
let lista0 = valTuple lista1 eval env funenv tenv in
ListaE(Lista(lista0))*)
| GetIndex (id, i) -> let index = asint(eval i env funenv tenv) in
let lista = aslist(id) in
getElement lista index
| GetFirstN (exp, i) -> let index = asint(eval i env funenv tenv) in
ListaE(Lista(first exp index))
| TupleEquals (exp1, exp2) -> if aslist(exp1) = aslist(exp2) then Bool(true) else Bool(false)
| Map (funx, exp1) -> let lista = aslist(aslist_e(eval exp1 env funenv tenv)) in
let (param, body, ambiente) = funenv funx in
(match lista with
| [] -> ListaE(Lista([]))
| x::xs ->
let value = eval x env funenv tenv in
let env1 = bind env param value in
let remaining = ListaE(Lista(xs)) in
ListaE(appendE (eval body env1 funenv tenv)
(eval (Map (funx,remaining)) env1 funenv tenv))
)
| _ -> raise WrongMatchException
;;
(**TEST**)
let simpleAnd = And(Bool true, Bool true);;
let doubleAnd = And(Bool true, And(Bool true, Bool false));;
eval simpleAnd emptyEnv emptyFunEnv emptyTuplaEnv;;
eval doubleAnd emptyEnv emptyFunEnv emptyTuplaEnv;;
let letAndEquals = LetIn("x", Int 1, Eq(Ide "x", Int 1));;
eval letAndEquals emptyEnv emptyFunEnv emptyTuplaEnv;;
let simpleAdd = LetIn("x", Int 2, LetIn("y", Int 4, Add(Ide "x", Ide "y")));;
eval simpleAdd emptyEnv emptyFunEnv emptyTuplaEnv;;
(*Valutazione Tupla*)
let lista_x = Lista(Ide "x" :: Int(23) :: Add(Ide "x", Int 2) ::[]);;
let exampleList = LetIn("x", Int 2, Tupla("lista", lista_x));;
eval exampleList emptyEnv emptyFunEnv emptyTuplaEnv;;
(*First 2 elems from tuple*)
let tupla = Tupla("tupla_x", Lista(Int (5) :: Int(6) :: Bool(true) :: Int(7) ::[]));;
let primi2 = GetFirstN(tupla2Lista(tupla), Int(2));;
eval primi2 emptyEnv emptyFunEnv emptyTuplaEnv;;
(*Map(raddoppia, tupla)*)
let raddoppia = Function("mul2", "x", Mul(Ide "x", Int 2));;
let funenv0 = funDeclr raddoppia emptyEnv emptyFunEnv;;
let tupla = Tupla("tupla_x", Lista(Int (5) :: Int(6) :: Bool(true) :: Int(7) ::[]));;
let lista = tupla2Lista(tupla);;
let exampleMap = Map("mul2", GetFirstN(lista, Int 2));;
eval exampleMap emptyEnv funenv0 emptyTuplaEnv;;
(*
let simpleFunction = LetIn("x", Int 14, FunApply("mul2", Ide "x"));;
eval simpleFunction emptyEnv funenv0;;
let lista_x = Tuple("lista_x", Lista(Int 4, Int 5, Int 6));;
let simpleMap = Map("mul2", Ide "lista_x");;
eval simpleMap emptyEnv funenv0;;
(**TEST DAL PDF**)
let add5 = Function("add5", "x", Add(Ide "x", Int 5));;
let funenv1 = funDeclr add5 emptyEnv emptyFunEnv;;
(*let tupla = Tupla(Int 5, Int 6, Bool true, Int 7);;
let test1 = LetIn("x", Int 5, LetIn("t", tupla, Map(GetFirstN(Ide "t", Int 2)), Function("x", Add(Ide "x", Int 5))));;
eval test1 emptyEnv funenv1;;*)
*)
我試圖建立一個解釋器。給定以下代碼，當我嘗試執行它時，最後一行（eval exampleMap emptyEnv funenv0 emptyTuplaEnv ;;）返回WrongMatchException。我認爲這個問題是由Map生成的，因爲primi2使用函數GetFirstN沒有任何問題。Ocaml匹配失敗
我不明白爲什麼地圖不匹配。有任何想法嗎？