ocaml didactic language, switching from static to

I've an ocaml piece of code where a small language is defined with static scoping, I need to make changes to that language in order to have the scope evaluated as dynamic, but I really cannot figure out how to do it. Do I have to implement some king of stack too keep track of each function env?

here is the code:

 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"));;

and here is the main:

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;;

am I supposed to change something in this recoursive eval function:

let rec eval (e : exp) (r : evT env) : evT = match e with...

and/or add some new env in the main?

I hope I've been clear enough...

can someone help?

thanks

EDIT:

I'm going to add full modified code here (as IVG suggested)

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;;

everything works apart the new env type:

let empty (v:'t) = failwith ("unbound variable " ^ v);;

as it gets type error at compile time. have i used it the wrong way?

let env1 = empty Unbound;; (*type error*)

标签： dynamic scope static ocaml scoping

1条回答

beautiful°

2楼-- · 2019-03-06 20:29

The simplest (though not the most efficient) implementation of dynamic scope will use a single stack, implemented as an associative list, (iden * 'a) list in OCaml parlance. Every new let-binding pushes a new pair to the list, and any reference looks up for the closest binding. That's simple.

Instead of using an explicit stack you can reuse the host language (OCaml) heap, and implement an assoc list as a function. In that case, instead of using (iden * 'a) list we will use an iden -> 'a function, with the empty environment represented as

let empty v = failwith ("unbound variable " ^ v)

now the bind function will take a new binding and the old environment, and will return the new environment:

let bind v x env = fun v' -> if v = v' then x else env v

and the lookup function, will just apply

let lookup v env = env v

The real difference between dynamic and static scope occurs when a function is called. In static scope, the environment is fixed during the parsing time (or when the function definition is evaluated - aka the declaration context), or in terms of your code Fun(i, a) -> FunVal(i, a, r), we have r captured when the function is created. With dynamic scoping, you won't capture the scope, and when the function value (body) is evaluated will use the current scope instead of the declaration time environment, so instead of

FunVal(arg, fBody, fDecEnv) -> 
            eval fBody (bind fDecEnv arg (eval eArg r))

you should basically evaluate it in the current scope,

FunVal(arg, fBody, fDecEnv) -> 
            eval fBody (bind r arg (eval eArg r))

Update on the empty environments

In the representation that I suggested, which probably is more didactic, I'm raising an exception in case if we reached the bottom of the stack and didn't find a value for the corresponding variable. In your representation, the emptyenv function returns the passed value. And a special value Unbound is used as a sentinel here, to initialize it (a little be awkward to my taste). You can use the original emptyenv function instead of empty, it doesn't really matter :) My example, was more general and independent on a particular representation.

Further details, let empty v = failwith ("unbound value" ^ v") has type string -> 'a, the fact that you put 't here doesn't matter, the scope of a type variable in OCaml is bound by the scope of the let definition in which it appears. So if you're using the name 't in two different let-expression it doesn't imply that those 't should be the same. Moreover, ascribing a type to a parameter of a function doesn't set the argument type, but constraints it (hence the name type constraint), so saying (v : 't is the same as saying that v could have any (unconstrained) type. With that knowledge, it should be easy to understand why the type error occurred - you're passing a value of type evT to a function that expects a value of type string. Those are different types, so we have an error.

TL;DR; you can use the existing representation of the stack, it is perfectly fine for dynamical scoping. Just change the function application code. By the way, dynamic scoping is much easier to implement than static scope, in fact, originally it was just an erroneous implementation of static scoping :) So you just need to break the correct implementation.

0人赞添加讨论(0) 举报

ocaml didactic language, switching from static to

Update on the empty environments

采纳回答

编辑标签

举报内容

检举类型

检举原因

检举说明(必填)

打开微信“扫一扫”，打开网页后点击屏幕右上角分享按钮

付费偷看金额在0.1-10元之间