отличное объяснение. Я бы использовал emptyenv. Спасибо большое за вашу помощь!
я есть кусок кода ocaml, в котором небольшой язык определяется с помощью статической области видимости. Мне нужно внести изменения в этот язык, чтобы область видимости была оценена как динамическая, но я действительно не могу понять, как это сделать. Должен ли я реализовать какой-то король стека, чтобы отслеживать каждую функцию env?
вот код:
type ide = string;;
type exp = Eint of int | Ebool of bool | Den of ide | 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 | Let of ide * exp * exp | Fun of ide * exp | FunCall of exp * exp |
Letrec of ide * exp * exp| Estring of string |Dict of (ide * exp) list | Read of ide * exp |Rm of exp * ide
|Add of ide * exp * exp | Clear of exp | Applyover of exp * exp | RemPos of exp * int;;
type 't env = ide -> 't;;
let emptyenv (v : 't) = function x -> v;;
let applyenv (r : 't env) (i : ide) = r i;;
let bind (r : 't env) (i : ide) (v : 't) = function x -> if x = i then v else applyenv r x;;
type evT = Int of int | Bool of bool | String of string | Unbound | FunVal of evFun | Valdict of (ide * evT) list |
RecFunVal of ide * evFun
and evFun = ide * exp * evT env
(*rts*)
(*type checking*)
let typecheck (s : string) (v : evT) : bool = match s with
"int" -> (match v with
Int(_) -> true |
_ -> false) |
"bool" -> (match v with
Bool(_) -> true |
_ -> false) |
_ -> failwith("not a valid type");;
(*primitive functions*)
let prod x y = if (typecheck "int" x) && (typecheck "int" y)
then (match (x,y) with
(Int(n),Int(u)) -> Int(n*u))
else failwith("Type error");;
let sum x y = if (typecheck "int" x) && (typecheck "int" y)
then (match (x,y) with
(Int(n),Int(u)) -> Int(n+u))
else failwith("Type error");;
let diff x y = if (typecheck "int" x) && (typecheck "int" y)
then (match (x,y) with
(Int(n),Int(u)) -> Int(n-u))
else failwith("Type error");;
let eq x y = if (typecheck "int" x) && (typecheck "int" y)
then (match (x,y) with
(Int(n),Int(u)) -> Bool(n=u))
else failwith("Type error");;
let minus x = if (typecheck "int" x)
then (match x with
Int(n) -> Int(-n))
else failwith("Type error");;
let iszero x = if (typecheck "int" x)
then (match x with
Int(n) -> Bool(n=0))
else failwith("Type error");;
let vel x y = if (typecheck "bool" x) && (typecheck "bool" y)
then (match (x,y) with
(Bool(b),Bool(e)) -> (Bool(b||e)))
else failwith("Type error");;
let et x y = if (typecheck "bool" x) && (typecheck "bool" y)
then (match (x,y) with
(Bool(b),Bool(e)) -> Bool(b&&e))
else failwith("Type error");;
let non x = if (typecheck "bool" x)
then (match x with
Bool(true) -> Bool(false) |
Bool(false) -> Bool(true))
else failwith("Type error");;
let rec eval (e : exp) (r : evT env) : evT = match e with
Eint n -> Int n |
Ebool b -> Bool b |
Estring s-> String s|
IsZero a -> iszero (eval a r) |
Den i -> applyenv r i |
Eq(a, b) -> eq (eval a r) (eval b r) |
Prod(a, b) -> prod (eval a r) (eval b r) |
Sum(a, b) -> sum (eval a r) (eval b r) |
Diff(a, b) -> diff (eval a r) (eval b r) |
Minus a -> minus (eval a r) |
And(a, b) -> et (eval a r) (eval b r) |
Or(a, b) -> vel (eval a r) (eval b r) |
Not a -> non (eval a r) |
Ifthenelse(a, b, c) ->
let g = (eval a r) in
if (typecheck "bool" g)
then (if g = Bool(true) then (eval b r) else (eval c r))
else failwith ("nonboolean guard") |
Let(i, e1, e2) -> eval e2 (bind r i (eval e1 r)) |
Dict (list) -> let rec evalist (l : (ide * exp) list) : (ide * evT)list =
match l with
[]->[]
|(key,value)::xs -> (key, (eval value r)):: evalist xs in
Valdict (evalist list)|
Read (key,dict)->
let evaldict= eval dict r in
(match evaldict with
Valdict v -> let rec isIn (k: ide) (d : (ide * evT) list): evT=
match d with
[]-> Unbound
| (k1,v1)::xs-> if (k=k1) then v1 else isIn k xs
in isIn key v
|_-> failwith ("Not a Dictionary")) |
Add (key,value, dict)->
(match eval dict r with
Valdict v -> Valdict ((key,(eval value r))::v)
|_-> failwith ("Not a Dictionary")) |
Rm(dict,key)->
( match eval dict r with
Valdict v -> let rec rem (k: ide) (d : (ide * evT) list) : (ide * evT)list=
match d with
[]-> []
| (k1,v1)::xs-> if (k=k1) then xs else (k1,v1)::(rem k xs)
in Valdict (rem key v)
|_-> failwith ("Not a Dictionary")) |
Clear (dict)->
( match eval dict r with
Valdict v -> let c (d : (ide * evT) list) : (ide * evT)list= []
in Valdict (c v)
|_-> failwith ("Not a Dictionary")) |
Applyover (funz,dict) ->
let a= eval funz r in
let b= eval dict r in
(match a,b with
FunVal (arg, fBody, fDecEnv), Valdict(dlist) ->
let rec apply (f: ide * exp * evT env )(d : (ide * evT) list) : (ide * evT) list =
match d with
[]->[]
|(k1,v1)::xs-> if (typecheck "int" v1) then (k1, (eval fBody (bind fDecEnv arg v1))):: (apply f xs)
else (k1,v1)::apply f xs in
Valdict (apply (arg, fBody, fDecEnv) dlist)
| _ -> failwith("Not a Dictionary")) |
RemPos (dict, pos)->
( match eval dict r with
Valdict v -> let rec rem (pos: int) (curr : int) (d : (ide * evT) list) : (ide * evT)list=
match d with
[]-> []
| (k1,v1)::xs-> if (curr=pos) then xs else (k1,v1)::(rem pos (curr+1) xs)
in Valdict (rem pos 0 v)
|_-> failwith ("Not a Dictionary")) |
Fun(i, a) -> FunVal(i, a, r) |
FunCall(f, eArg) ->
let fClosure = (eval f r) in
(match fClosure with
FunVal(arg, fBody, fDecEnv) ->
eval fBody (bind fDecEnv arg (eval eArg r)) |
RecFunVal(g, (arg, fBody, fDecEnv)) ->
let aVal = (eval eArg r) in
let rEnv = (bind fDecEnv g fClosure) in
let aEnv = (bind rEnv arg aVal) in
eval fBody aEnv |
_ -> failwith("non functional value")) |
Letrec(f, funDef, letBody) ->
(match funDef with
Fun(i, fBody) -> let r1 = (bind r f (RecFunVal(f, (i, fBody, r)))) in
eval letBody r1 |
_ -> failwith("non functional def"));;
и вот главное:
let env0 = emptyenv Unbound;;
print_string("create dictionary");;
let dict = Dict ([("age",Eint 23);("Name", Estring "Mike");("idnumber", Eint 123); ("City", Estring "London")]);;
eval dict env0;;
я должен изменить что-то в этой рекурсивной функции eval:
пусть rec eval (e: exp) (r: evT env): evT = соответствует e с ...
и / или добавить новый env в основной?
Я надеюсь, что я достаточно ясно ...
может кто-нибудь помочь?
Спасибо
РЕДАКТИРОВАТЬ:
Я собираюсь добавить полный модифицированный код здесь (как предложено IVG)
type ide = string;;
type exp = Eint of int | Ebool of bool | Den of ide | 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 | Let of ide * exp * exp | Fun of ide * exp | FunCall of exp * exp |
Letrec of ide * exp * exp| Estring of string |Dict of (ide * exp) list | Read of ide * exp |Rm of exp * ide
|Add of ide * exp * exp | Clear of exp | Applyover of exp * exp | RemPos of exp * int;;
type 't env = ide -> 't;;
let emptyenv (v : 't) = function x -> v;;
let empty (v:'t) = failwith ("unbound variable " ^ v);;
let applyenv (r : 't env) (i : ide) = r i;;
let bind (r : 't env) (i : ide) (v : 't) = function x -> if x = i then v else r x;;
(*let bind (r : 't env) (i : ide) (v : 't) = function x -> if x = i then v else applyenv r x;;*)
type evT = Int of int | Bool of bool | String of string | Unbound | FunVal of evFun | Valdict of (ide * evT) list |
RecFunVal of ide * evFun
and evFun = ide * exp * evT env
(*rts*)
(*type checking*)
let typecheck (s : string) (v : evT) : bool = match s with
"int" -> (match v with
Int(_) -> true |
_ -> false) |
"bool" -> (match v with
Bool(_) -> true |
_ -> false) |
_ -> failwith("not a valid type");;
(*primitive functions*)
let prod x y = if (typecheck "int" x) && (typecheck "int" y)
then (match (x,y) with
(Int(n),Int(u)) -> Int(n*u))
else failwith("Type error");;
let sum x y = if (typecheck "int" x) && (typecheck "int" y)
then (match (x,y) with
(Int(n),Int(u)) -> Int(n+u))
else failwith("Type error");;
let diff x y = if (typecheck "int" x) && (typecheck "int" y)
then (match (x,y) with
(Int(n),Int(u)) -> Int(n-u))
else failwith("Type error");;
let eq x y = if (typecheck "int" x) && (typecheck "int" y)
then (match (x,y) with
(Int(n),Int(u)) -> Bool(n=u))
else failwith("Type error");;
let minus x = if (typecheck "int" x)
then (match x with
Int(n) -> Int(-n))
else failwith("Type error");;
let iszero x = if (typecheck "int" x)
then (match x with
Int(n) -> Bool(n=0))
else failwith("Type error");;
let vel x y = if (typecheck "bool" x) && (typecheck "bool" y)
then (match (x,y) with
(Bool(b),Bool(e)) -> (Bool(b||e)))
else failwith("Type error");;
let et x y = if (typecheck "bool" x) && (typecheck "bool" y)
then (match (x,y) with
(Bool(b),Bool(e)) -> Bool(b&&e))
else failwith("Type error");;
let non x = if (typecheck "bool" x)
then (match x with
Bool(true) -> Bool(false) |
Bool(false) -> Bool(true))
else failwith("Type error");;
let rec eval (e : exp) (r : evT env) : evT = match e with
Eint n -> Int n |
Ebool b -> Bool b |
Estring s-> String s|
IsZero a -> iszero (eval a r) |
Den i -> applyenv r i |
Eq(a, b) -> eq (eval a r) (eval b r) |
Prod(a, b) -> prod (eval a r) (eval b r) |
Sum(a, b) -> sum (eval a r) (eval b r) |
Diff(a, b) -> diff (eval a r) (eval b r) |
Minus a -> minus (eval a r) |
And(a, b) -> et (eval a r) (eval b r) |
Or(a, b) -> vel (eval a r) (eval b r) |
Not a -> non (eval a r) |
Ifthenelse(a, b, c) ->
let g = (eval a r) in
if (typecheck "bool" g)
then (if g = Bool(true) then (eval b r) else (eval c r))
else failwith ("nonboolean guard") |
Let(i, e1, e2) -> eval e2 (bind r i (eval e1 r)) |
Dict (list) -> let rec evalist (l : (ide * exp) list) : (ide * evT)list =
match l with
[]->[]
|(key,value)::xs -> (key, (eval value r)):: evalist xs in
Valdict (evalist list)|
Read (key,dict)->
let evaldict= eval dict r in
(match evaldict with
Valdict v -> let rec isIn (k: ide) (d : (ide * evT) list): evT=
match d with
[]-> Unbound
| (k1,v1)::xs-> if (k=k1) then v1 else isIn k xs
in isIn key v
|_-> failwith ("Not a Dictionary")) |
Add (key,value, dict)->
(match eval dict r with
Valdict v -> Valdict ((key,(eval value r))::v)
|_-> failwith ("Not a Dictionary")) |
Rm(dict,key)->
( match eval dict r with
Valdict v -> let rec rem (k: ide) (d : (ide * evT) list) : (ide * evT)list=
match d with
[]-> []
| (k1,v1)::xs-> if (k=k1) then xs else (k1,v1)::(rem k xs)
in Valdict (rem key v)
|_-> failwith ("Not a Dictionary")) |
Clear (dict)->
( match eval dict r with
Valdict v -> let c (d : (ide * evT) list) : (ide * evT)list= []
in Valdict (c v)
|_-> failwith ("Not a Dictionary")) |
Applyover (funz,dict) ->
let a= eval funz r in
let b= eval dict r in
(match a,b with
FunVal (arg, fBody, fDecEnv), Valdict(dlist) ->
let rec apply (f: ide * exp * evT env )(d : (ide * evT) list) : (ide * evT) list =
match d with
[]->[]
|(k1,v1)::xs-> if (typecheck "int" v1) then (k1, (eval fBody (bind r arg v1))):: (apply f xs)
else (k1,v1)::apply f xs in
Valdict (apply (arg, fBody, fDecEnv) dlist)
| _ -> failwith("Not a Dictionary")) |
RemPos (dict, pos)->
( match eval dict r with
Valdict v -> let rec rem (pos: int) (curr : int) (d : (ide * evT) list) : (ide * evT)list=
match d with
[]-> []
| (k1,v1)::xs-> if (curr=pos) then xs else (k1,v1)::(rem pos (curr+1) xs)
in Valdict (rem pos 0 v)
|_-> failwith ("Not a Dictionary")) |
Fun(i, a) -> FunVal(i, a, r) |
FunCall(f, eArg) ->
let fClosure = (eval f r) in
(match fClosure with
FunVal(arg, fBody, fDecEnv) ->
eval fBody (bind r arg (eval eArg r)) |
RecFunVal(g, (arg, fBody, fDecEnv)) ->
let aVal = (eval eArg r) in
let rEnv = (bind fDecEnv g fClosure) in
let aEnv = (bind rEnv arg aVal) in
eval fBody aEnv |
_ -> failwith("non functional value")) |
Letrec(f, funDef, letBody) ->
(match funDef with
Fun(i, fBody) -> let r1 = (bind r f (RecFunVal(f, (i, fBody, r)))) in
eval letBody r1 |
_ -> failwith("non functional def"));;
(* ============================= MAIN =========================*)
(*creating empty env *)
(*let env1 = empty Unbound;;*) (*type error*)
let env0 = emptyenv Unbound;;
print_string("filling the dictionary");;
let dict = Dict ([("age",Eint 23);("Name", Estring "Mike");("idnumber", Eint 123); ("City", Estring "London")]);;
eval dict env0;;
print_string("finding a value by key");;
let read= eval (Read ("Name",dict)) env0;;
print_string("adding values");;
let add= eval (Add("Country",(Estring "Singapore"), dict)) env0;;
print_string("removing values by pair");;
let remove= eval (Rm (dict , "Name" )) env0;;
print_string("removing value by position");;
let rempos= eval(RemPos (dict , 2)) env0;;
print_string("apply x+1 to all int values");;
let funz = Fun ("x", Sum(Den "x", Eint 1));;
eval (Applyover (funz,dict)) env0;;
print_string("Empty the dictionary");;
let clear= eval (Clear(dict)) env0;;
все работает отдельно от нового типа env:
let empty (v:'t) = failwith ("unbound variable " ^ v);;
как он получает ошибку типа во время компиляции. я использовал это неправильно?
let env1 = empty Unbound;; (*type error*)