(* INTERPRETE DENOTAZIONALE CON FUNZIONI E DICHIARAZIONI (anche ricorsive) *) (* DOMINI SINTATTICI *) type ide = Id of string type exp = Eint of int | Ebool of bool | Var of ide | Pair of exp * exp | First of exp | Snd of exp | Prod of exp * exp | Sum of exp * exp | Diff of exp * exp | Eq of exp * exp | Minus of exp | Iszero of exp | Or of exp * exp | And of exp * exp | Not of exp | Ifthenelse of exp * exp * exp | Fun of ide * exp | Appl of exp * exp | Letrec of ide * exp * exp | Let of ide * exp * exp;; (* SEMANTIC DOMAINS *) type env = ide -> eval and proc = eval -> eval and eval = Funval of proc | Mkpair of eval * eval | Int of int | Bool of bool | Unbound let emptyenv = function (x: ide) -> Unbound let applyenv ((x: env), (y: ide)) = x y let bind ((r:env), l, (e:eval)) = function lu -> if lu = l then e else r(lu) (* Operations on Eval *) let typecheck (x, y) = match x with | "int" -> (match y with | Int(u) -> true | _ -> false) | "bool" -> (match y with | Bool(u) -> true | _ -> false) | _ -> failwith ("not a valid type") let minus x = if typecheck("int",x) then (match x with | Int(y) -> Int(-y) ) else failwith ("type error") let iszero x = if typecheck("int",x) then (match x with | Int(y) -> Bool(y=0) ) else failwith ("type error") let equ (x,y) = if typecheck("int",x) & typecheck("int",y) then (match (x,y) with | (Int(u), Int(w)) -> Bool(u = w)) else failwith ("type error") let plus (x,y) = if typecheck("int",x) & typecheck("int",y) then (match (x,y) with | (Int(u), Int(w)) -> Int(u+w)) else failwith ("type error") let diff (x,y) = if typecheck("int",x) & typecheck("int",y) then (match (x,y) with | (Int(u), Int(w)) -> Int(u-w)) else failwith ("type error") let mult (x,y) = if typecheck("int",x) & typecheck("int",y) then (match (x,y) with | (Int(u), Int(w)) -> Int(u*w)) else failwith ("type error") let first x = match x with Mkpair(y,z) -> y |_ -> failwith ("type error") let snd x = match x with Mkpair(y,z) -> z |_ -> failwith ("type error") let et (x,y) = if typecheck("bool",x) & typecheck("bool",y) then (match (x,y) with | (Bool(u), Bool(w)) -> Bool(u & w)) else failwith ("type error") let vel (x,y) = if typecheck("bool",x) & typecheck("bool",y) then (match (x,y) with | (Bool(u), Bool(w)) -> Bool(u or w)) else failwith ("type error") let non x = if typecheck("bool",x) then (match x with | Bool(y) -> Bool(not y) ) else failwith ("type error") (* FUNZIONI DI VALUTAZIONE SEMANTICA *) let rec makefun ((a:exp),(x:env)) = (match a with | Fun(ii,aa) -> Funval(function d -> sem aa (bind(x,ii,d))) | _ -> failwith ("Non-functional object")) and applyfun ((ev1:eval),(ev2:eval)) = ( match ev1 with | Funval(x) -> x ev2 | _ -> failwith ("attempt to apply a non-functional object")) and sem (e:exp) (r:env) = match e with | Eint(n) -> Int(n) | Ebool(b) -> Bool(b) | Var(i) -> applyenv(r,i) | Pair(a,b) -> Mkpair((sem a r),(sem b r)) | Iszero(a) -> iszero((sem a r) ) | Eq(a,b) -> equ((sem a r) ,(sem b r) ) | First(a) -> first((sem a r)) | Snd(a) -> snd((sem a r)) | Prod(a,b) -> mult ( (sem a r), (sem b r)) | Sum(a,b) -> plus ( (sem a r), (sem b r)) | Diff(a,b) -> diff ( (sem a r), (sem b r)) | Minus(a) -> minus( (sem a r)) | And(a,b) -> et ( (sem a r), (sem b r)) | Or(a,b) -> vel ( (sem a r), (sem b r)) | Not(a) -> non( (sem a r)) | Ifthenelse(a,b,c) -> let g = sem a r in if typecheck("bool",g) then (if g = Bool(true) then sem b r else sem c r) else failwith ("nonboolean guard") | Fun(i,a) -> makefun(Fun(i,a), r) | Appl(a,b) -> applyfun(sem a r, sem b r) | Let(i,a,b) -> sem b (bind(r,i,(sem a r))) | Letrec(i,a,b) -> sem b (let rec ff = function j -> applyenv(bind(r,i,(makefun(a, ff))),j) in ff) (* (let rec ff = bind(r,i,(makefun(a, ff))) in ff) *) (* val makefun : exp * env -> eval = val applyfun : eval * eval -> eval = val sem : exp -> env -> eval = *) (* ESEMPI *) (* let factorial = Letrec ( Id("fact"), Fun(Id("x"), Ifthenelse( Iszero(Diff(Var(Id("x")),Eint(1))), Eint(1), Prod(Var(Id("x")),Appl(Var(Id("fact")),Diff(Var(Id("x")),Eint(1)))))), Appl(Var(Id("fact")),Eint(10)));; let expo = Letrec ( Id("expo"), Fun(Id("x"), (Let (Id "base",First(Var(Id("x"))), (Let (Id "espo",Snd(Var(Id("x"))), Ifthenelse( Iszero(Var(Id("espo"))),Eint(1), Prod(Var(Id("base")),Appl(Var(Id("expo")),Pair(Var(Id("base")), Diff(Var(Id("espo")),Eint(1))))))))))), Appl(Var(Id("expo")),Pair(Eint(2),Eint(3))));; # sem factorial emptyenv;; - : eval = Int 3628800 # sem expo emptyenv;; - : eval = Int 8 *)