ocaml 教学语言，从静态范围切换到动态范围
ocaml didactic language, switching from static to dynamic scoping
我有一段 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;;
我是否应该更改此递归评估函数中的某些内容：
let rec eval (e : exp) (r : evT env) : evT = match e with...
and/or 在 main 中添加一些新环境？
我希望我说得足够清楚...
有人可以帮忙吗？
谢谢
编辑：
我将在此处添加完整的修改代码（按照 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;;
除新的环境类型外一切正常：
let empty (v:'t) = failwith ("unbound variable " ^ v);;
因为它在编译时出现类型错误。
我是不是用错了？
let env1 = empty Unbound;; (*type error*)
动态范围的最简单（虽然不是最有效）实现将使用单个堆栈，实现为关联列表，用 OCaml 的说法 (iden * 'a) list。每个新的 let-binding 都会将一个新的对推送到列表中，并且任何引用都会查找最接近的绑定。很简单。
您可以重用宿主语言 (OCaml) 堆，并将关联列表实现为函数，而不是使用显式堆栈。在这种情况下，我们将使用 iden -> 'a 函数代替 (iden * 'a) list，空环境表示为
let empty v = failwith ("unbound variable " ^ v)
现在 bind 函数将采用新绑定和旧环境，并将 return 新环境：
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 函数 return 是传递的值。一个特殊的值 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;您可以使用堆栈的现有表示，它非常适合动态范围界定。只需更改功能应用程序代码即可。顺便说一句，动态作用域比静态作用域更容易实现，事实上，最初它只是静态作用域的错误实现:)所以你只需要打破正确的实现。
我有一段 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;;
我是否应该更改此递归评估函数中的某些内容：
let rec eval (e : exp) (r : evT env) : evT = match e with...
and/or 在 main 中添加一些新环境？
我希望我说得足够清楚...
有人可以帮忙吗？
谢谢
编辑：
我将在此处添加完整的修改代码（按照 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;;
除新的环境类型外一切正常：
let empty (v:'t) = failwith ("unbound variable " ^ v);;
因为它在编译时出现类型错误。 我是不是用错了？
let env1 = empty Unbound;; (*type error*)
动态范围的最简单（虽然不是最有效）实现将使用单个堆栈，实现为关联列表，用 OCaml 的说法 (iden * 'a) list。每个新的 let-binding 都会将一个新的对推送到列表中，并且任何引用都会查找最接近的绑定。很简单。
您可以重用宿主语言 (OCaml) 堆，并将关联列表实现为函数，而不是使用显式堆栈。在这种情况下，我们将使用 iden -> 'a 函数代替 (iden * 'a) list，空环境表示为
let empty v = failwith ("unbound variable " ^ v)
现在 bind 函数将采用新绑定和旧环境，并将 return 新环境：
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 函数 return 是传递的值。一个特殊的值 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;您可以使用堆栈的现有表示，它非常适合动态范围界定。只需更改功能应用程序代码即可。顺便说一句，动态作用域比静态作用域更容易实现，事实上，最初它只是静态作用域的错误实现:)所以你只需要打破正确的实现。