ocaml 教学语言，从静态范围切换到动态范围

【问题标题】：ocaml didactic language, switching from static to dynamic scopingocaml 教学语言，从静态范围切换到动态范围
【发布时间】：2019-02-05 10:00:00
【问题描述】：

我有一段 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...

和/或在主目录中添加一些新环境？

我希望我已经足够清楚了......

有人可以帮忙吗？

谢谢

编辑：

我将在此处添加完整的修改代码（按照 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*)

【问题讨论】：

    标签： dynamic scope static ocaml scoping


    【解决方案1】：

    动态范围的最简单（虽然不是最有效）的实现将使用单个堆栈，实现为关联列表，在 OCaml 用语中为 (iden * 'a) list。每个新的 let-binding 都会将一个新的对推送到列表中，并且任何引用都会查找最近的绑定。这很简单。

    您可以重用宿主语言 (OCaml) 堆，并将关联列表实现为函数，而不是使用显式堆栈。在这种情况下，我们将使用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 与说@987654343 相同@ 可以有任何（不受约束的）类型。有了这些知识，应该很容易理解为什么会发生类型错误 - 您将 evT 类型的值传递给需要 string 类型的值的函数。这些是不同的类型，所以我们有一个错误。

    TL;DR;您可以使用堆栈的现有表示，它非常适合动态范围。只需更改功能应用程序代码。顺便说一句，动态作用域比静态作用域更容易实现，实际上，最初它只是静态作用域的错误实现:) 所以你只需要打破正确的实现即可。

    【讨论】：

    • 嗨，IVG，感谢您的帮助，我已经按照您的建议进行了更改，除此之外一切都解决了： let empty v = failwith ("unbound variable" ^ v) 我得到类型错误。我已经编辑了发布完整修改代码的答案。我不知道出了什么问题……你能再帮我一次吗？谢谢
    • 很好的解释。我会使用emptyenv。非常感谢您的帮助！
    猜你喜欢
    • 1970-01-01
    • 2014-12-12
    • 2011-03-06
    • 1970-01-01
    • 2019-05-27
    • 1970-01-01
    • 1970-01-01
    • 2021-12-13
    相关资源
    最近更新 更多
    热门标签
    Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode