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, exp) -> let lista = aslist(aslist_e(eval exp 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))
)
| ListaE(exp) -> let lista = aslist(aslist_e(exp)) in
(match lista with
| [] -> ListaE (Lista [])
| x::xs -> let value = eval x env funenv tenv in
let remaining = ListaE(Lista(xs)) in
let coda = (eval remaining env funenv tenv) in
let risultato = appendE value coda in
ListaE( risultato )
)
| Tupla(x,y) -> ListaE(y)
| _ -> raise WrongMatchException
;;
鉴于代码，尝试编译它，编译器说在eval函数中的ListaE（exp）中存在类型评估错误（匹配代码编译中没有ListaE（exp）而没有问题）。显示的错误是Error: This expression has type elts but an expression was expected of type exp
任何想法问题在哪里？类型匹配是正确的，eval是exp，所以我们是权利。 ListaE是exp类型的构造函数，因此根据定义是正确的，appendE返回exp类型。我不明白问题出在哪里。
答案 0 :(得分：0)
您的函数aslist_e期望看到ListaE xxx值。但是你传递xxx值本身（ListaE构造函数中的值）。
可能会说：
let lista = aslist exp in