ocaml的教学语言，从静态切换到动态作用域
Posted
tags:
篇首语：本文由小常识网(cha138.com)小编为大家整理，主要介绍了ocaml的教学语言，从静态切换到动态作用域相关的知识，希望对你有一定的参考价值。
我有代码的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;;
我应该改变的东西在这个recoursive 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*)
答案
最简单的（虽然不是最有效的）实现动态范围将使用一个堆栈，作为一个关联列表，(iden * 'a) list OCaml中的说法来实现。每一个新的让结合推动了一双新的列表，以及任何参考查找最接近的绑定。这很简单。
相反，使用一个明确的堆栈，你可以重复使用宿主语言（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的一个类型变量的范围是由它所在的让利定义的范围约束。所以，如果你正在使用的名称't在两个不同的让表达并不意味着这些't应该是相同的。此外，归咎于一个类型的函数不设置参数类型的参数，但限制它（因此得名类型约束），所以说(v : 't是相同的话说，v可以有任何（不受约束）型。有了这些知识，应该很容易理解为什么发生错误类型 - 你传递一个类型evT的一个值，预计类型string的值的函数。这些是不同类型的，所以我们有一个错误。
TL; DR;你可以使用堆栈的现有表示，它是动态范围界定完美的罚款。只要改变功能的应用程序代码。顺便说一句，动态作用域是比静态范围，以实现更容易，其实，原来这只是一个错误的实现静态范围的:)所以你只需要打破的正确实施。
以上是关于ocaml的教学语言，从静态切换到动态作用域的主要内容，如果未能解决你的问题，请参考以下文章