我有一段ocaml代码，其中用静态作用域定义了一种小型语言，我需要对该语言进行更改才能将范围评估为动态，但是我真的不知道该怎么做。 我是否必须实现一些堆栈之王，也要跟踪每个函数的环境？
代码如下：
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;;
我应该在此revalsive eval函数中进行一些更改：
let rec eval（e：exp）（r：evT env）：evT =匹配e与...
和/或在主目录中添加一些新的环境？
我希望我已经足够清楚了...
有人可以帮忙吗？
谢谢
编辑：
我将在此处添加完整的修改后的代码（如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*)
答案 0 :(得分：2)
最简单（尽管不是最有效）的动态范围实现将使用单个堆栈，该堆栈作为关联列表（在OCaml看来为(iden * 'a) list实现）。每个新的let绑定都会将一个新的对推入列表，并且任何引用都会查找最接近的绑定。很简单。
代替使用显式堆栈，您可以重用宿主语言（OCaml）堆，并将assoc列表实现为函数。在这种情况下，我们将使用(iden * 'a) list函数，而不是使用iden -> 'a，将空环境表示为
let empty v = failwith ("unbound variable " ^ v)
现在bind函数将采用新的绑定和旧的环境，并将返回新的环境：
let bind v x env = fun v' -> if v = v' then x else env v
和lookup函数将仅适用
let lookup v env = env v
动态和静态作用域之间的真正区别发生在调用函数时。在静态范围内，环境在解析期间（或在评估函数定义时-亦即声明上下文）是固定的，或者就您的代码Fun(i, a) -> FunVal(i, a, r)而言，我们在函数捕获时捕获了r被建造。通过动态作用域，您将不会捕获范围，并且在评估函数值（主体）时将使用当前范围而不是声明时间环境，因此将代替
FunVal(arg, fBody, fDecEnv) ->
eval fBody (bind fDecEnv arg (eval eArg r))
您应该基本上在当前范围内对其进行评估，
FunVal(arg, fBody, fDecEnv) ->
eval fBody (bind r arg (eval eArg r))
在我建议的表示中，这可能是更具说服力的，如果我们到达堆栈的底部并且没有找到对应变量的值，我将提出一个例外。在您的表示形式中，emptyenv函数返回传递的值。这里使用一个特殊的值Unbound作为标记，以对其进行初始化（我的口味有点尴尬）。您可以使用原始的emptyenv函数来代替empty，这并不重要：)我的示例更加通用，并且独立于特定的表示形式。
更多详细信息，let empty v = failwith ("unbound value" ^ v")的类型为string -> 'a，将't放在此处的事实无关紧要，OCaml中类型变量的范围受让其出现的定义。因此，如果您在两个不同的let表达式中使用名称't，则并不意味着这些't应该相同。此外，将类型赋予函数的参数不是对参数类型进行 set 设置，而是对其进行约束（因此，对名称类型进行约束），因此说(v : 't与说v可以具有任何（不受约束的）类型。有了这些知识，就应该容易理解为什么会发生类型错误-您正在将类型evT的值传递给期望值为类型string的函数。这些是不同的类型，所以我们有一个错误。
TL; DR;您可以使用堆栈的现有表示形式，这对于动态作用域非常适合。只需更改功能应用程序代码。顺便说一句，动态作用域比静态作用域更容易实现，实际上，它最初只是静态作用域的错误实现：)因此，您只需要破坏正确的实现即可。