ocaml дидактический язык, переход от статического к динамическому - PullRequest
Новая
       28

ocaml дидактический язык, переход от статического к динамическому

0 голосов
/ 05 февраля 2019

У меня есть кусок кода 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 с ...

и/ или добавить какой-нибудь новый 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*)

1 Ответ

0 голосов
/ 05 февраля 2019

В самой простой (хотя и не самой эффективной) реализации динамической области будет использоваться один стек, реализованный в виде ассоциативного списка, (iden * 'a) list на языке OCaml.Каждый новый let-binding добавляет новую пару в список, и любая ссылка ищет ближайшую привязку.Это просто.

Вместо использования явного стека вы можете повторно использовать кучу основного языка (OCaml) и реализовать список ассоциаций в качестве функции.В этом случае вместо использования (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 ограничена областью определения let вкоторый появляется.Поэтому, если вы используете имя 't в двух разных выражениях let, это не означает, что эти 't должны быть одинаковыми.Более того, приписывание типа параметру функции не устанавливает тип аргумента, а ограничивает его (отсюда ограничение типа имени), поэтому высказывание (v : 't равносильно тому, что vможет иметь любой (неограниченный) тип.С этим знанием должно быть легко понять, почему произошла ошибка типа - вы передаете значение типа evT функции, которая ожидает значение типа string.Это разные типы, поэтому у нас есть ошибка.

TL; DR;Вы можете использовать существующее представление стека, оно отлично подходит для динамического определения объема.Просто измените код приложения функции.Кстати, динамическую область видимости гораздо проще реализовать, чем статическую область, на самом деле изначально это была просто ошибочная реализация статической области видимости :) Так что вам просто нужно сломать правильную реализацию.

...