Ошибка выражения на функциональном языке OCaml - PullRequest
Новая
       49

Ошибка выражения на функциональном языке OCaml

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

Я определяю примитивный тип в OCaml, это домашняя работа. Все работает нормально, но я получил ошибку с реализованным типом Dict. Код: 

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| Dict of (ide * exp) list;;

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 | Unbound | FunVal of evFun | RecFunVal of ide * evFun | DictVal of (ide * evT) list
and evFun = ide * exp * evT env;;

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


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

    Dict(pairs) -> DictVal(evalDictList pairs r) |
    Eint n -> Int n |
    Ebool b -> Bool b |
    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)) |
    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 evalDictList (pairs : (ide * exp) list) (r : evT env) : (ide * evT) list = match pairs with
        [ ] -> [ ] |
        (key,value) :: other -> (key, eval value r) :: evalDictList other r;;

Все отлично работает, но когда я делаю: 

let mydict = Dict("test", Eint 2);;

или Dict("test", Eint 2);;

Я получаю эту ошибку: Ошибка: это выражение имеет тип 'a *' b, но ожидалось выражение списка типа (ide * exp).

Эта домашняя работа заключается в написании базового переводчика для языка с перечисленными выше примитивными типами.

1 Ответ

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

Ошибка немного более общая и запутанная, чем должна быть, но прямо указывает на проблему. Если я заменю переменные типа 'a и 'b в ошибке фактическими типами, вы, вероятно, сразу же увидите это:

Ошибка: это выражение имеет тип ide * exp, но ожидалось выражение из списка типов (ide * exp).

То есть вы даете Dict кортеж (чего-то), но он ожидает список кортежей (с некоторыми конкретными типами), потому что он определен как Dict of (ide * exp) list.

Упаковка кортежа в список сделает его компиляцией: 

let mydict = Dict [("test", Eint 2)];;
...