我有一段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函数中更改一些内容：
let rec-eval(e:exp)(r:evT-env):evT=将e与…匹配。。。
和/或在main中添加一些新的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*)
动态作用域的最简单(虽然不是最高效)实现将使用单个堆栈，实现为关联列表，用OCaml的说法是(iden * 'a) list。每个新的let绑定都会将一个新的对推送到列表中，任何引用都会查找最近的绑定。这很简单。
您可以重用主机语言(OCaml)堆，并将assoc列表实现为一个函数，而不是使用显式堆栈。在这种情况下，我们将使用iden -> 'a函数，而不是使用(iden * 'a) list，空环境表示为
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定义的作用域约束。因此，如果在两个不同的let表达式中使用名称't，并不意味着这些't应该是相同的。此外，将类型赋予函数的参数并不会设置参数类型，而是对其进行约束(因此称为类型约束)，因此说(v : 't与说v可以具有任何(无约束)类型是一样的。有了这些知识，应该很容易理解为什么会发生类型错误——您将类型为evT的值传递给一个期望值为string的函数。这些是不同的类型，所以我们有一个错误。
TL；DR；您可以使用堆栈的现有表示，它非常适合动态范围界定。只需更改函数应用程序代码。顺便说一句，动态作用域比静态作用域更容易实现，事实上，最初它只是静态作用域的错误实现：)所以你只需要破坏正确的实现。