Earlier today I encountered a limitation of F# quotations, and asked a question about it here: F# quotations: variable may escape scope
Now, I may have encountered another limitation when converting examples appearing in http://www.cs.rice.edu/~taha/publications/journal/dspg04a.pdf from MetaOcaml to F#.
This time I've this MetaOcaml snippet:
let rec peval2 p env fenv=
match p with
Program ([],e) -> eval2 e env fenv
| Program (Declaration (s1,s2,e1)::tl,e) ->
.<let rec f x = .~(eval2 e1 (ext env s2 .<x>.)
(ext fenv s1 .<f>.))
in .~(peval2 (Program(tl,e)) env (ext fenv s1 .<f>.))>.
and I converted it to
let rec peval2 p env fenv =
match p with
| Program ([], e) -> eval2 e env fenv
| Program (Declaration (s1, s2, e1) :: tl, e) ->
<# let rec f x = %(eval2 e1 (ext env s2 <# x #>)
(ext fenv s1 <# f #>))
in %(peval2 (Program(tl, e)) env (ext fenv s1 <# f #>)) #>
I get the following compile-time error: This expression was expected to have type int -> Expr<int> but here has type Expr<'a> with the two <# f #>.
Intuitively, I think the error makes a lot of sense. But is there a way in F# to describe what I want in this case?
Code sample:
open Microsoft.FSharp.Quotations
type Exp =
| Int of int
| Var of string
| App of string * Exp
| Add of Exp * Exp
| Sub of Exp * Exp
| Mul of Exp * Exp
| Div of Exp * Exp
| Ifz of Exp * Exp * Exp
type Def = Declaration of string * string * Exp
type Prog = Program of Def list * Exp
exception Yikes
let env0 = fun x -> raise Yikes
let fenv0 = env0
let ext env x v = fun y -> if x = y then v else env y
let rec eval2 e env fenv =
match e with
| Int i -> <# i #>
| Var s -> env s
| App (s, e2) -> <# %(fenv s) %(eval2 e2 env fenv) #>
| Add (e1, e2) -> <# %(eval2 e1 env fenv) + %(eval2 e2 env fenv) #>
| Sub (e1, e2) -> <# %(eval2 e1 env fenv) - %(eval2 e2 env fenv) #>
| Mul (e1, e2) -> <# %(eval2 e1 env fenv) * %(eval2 e2 env fenv) #>
| Div (e1, e2) -> <# %(eval2 e1 env fenv) / %(eval2 e2 env fenv) #>
| Ifz (e1, e2, e3) -> <# if %(eval2 e1 env fenv) = 0
then %(eval2 e2 env fenv)
else %(eval2 e3 env fenv) #>
let rec peval2 p env fenv =
match p with
| Program ([], e) -> eval2 e env fenv
| Program (Declaration (s1, s2, e1) :: tl, e) ->
<# let rec f x = %(eval2 e1 (ext env s2 <# x #>)
(ext fenv s1 <# f #>))
in %(peval2 (Program(tl, e)) env (ext fenv s1 <# f #>)) #>
I think you're hitting the same problem as in the previous question - when I copied the necessary declarations from the paper, I got:
error FS0446: The variable 'f' is bound in a quotation but is used as part of a spliced expression. This is not permitted since it may escape its scope.
This makes sense - capturing variables bound in quotation inside spliced expression is not allowed in F# and this is definitely done in the code snippet.
I'm not exactly sure why you're getting a different error messagae - if you can post a minimal complete sample, than that can be answered, but you'll still going to hit this variable capture limitation. (Which is probably something that's used quite a lot in MetaOCaml).
Related
I'm trying to write an evaluator for my language that takes a parsed if-block, evaluates all conditions and filters out the False branches and then picks one branch to take at random. I'm at the stage wherein I can filter out the branches and be left with my possible paths but only within GHCI. When I attempt to pass an if-block into my program through the command line, what occurs is if the first branch is True, that's the only branch that is taken, otherwise an empty list is returned regardless if there are any sub-branches or not. My evaluator for binary expressions works so I know that my error is with my logic in my if evaluator or parser.
Here is the behaviour through the command line:
~/Desktop/Olivia > ./Main "if (1 > 3)-> 1 + 1 [] (1 < 2)-> 2 + 2"
[]
~/Desktop/Olivia > ./Main "if (1 < 3)-> 1 + 1 [] (1 < 2)-> 2 + 2"
[2]
Here is the behaviour through GHCI:
λ > b = SubIf (Expr (HInteger 2) Less (HInteger 1)) [(Expr (HInteger 45) Add (HInteger 45)), (Expr (HInteger 6) Add (HInteger 6))]
λ > c = SubIf (Expr (HInteger 2) Less (HInteger 3)) [(Expr (HInteger 5) Add (HInteger 5)), (Expr (HInteger 6) Add (HInteger 6))]
λ > a = If (Expr (HInteger 3) Less (HInteger 2)) [(Expr (HInteger 1) Add (HInteger 100)), (Expr (HInteger 2) Add (HInteger 2))] [b, c]
λ > eval b -- All False branches return a value of 1
1
λ > eval c
[10 12]
λ > eval a
[[10 12]]
This is my expected result. In the case of n number of sub if expressions, I will pick one list of the overall list as my branch to take before I go back to evaluate the loop guard and begin the next iteration of the program.
My data type:
data HVal
= HInteger Integer
| HBool Bool
| HString String
| HList [HVal]
| Expr HVal Op HVal
| EqExpr HVal Op HVal
| Neg HVal
| Assign HVal HVal
| Do HVal [HVal]
| If HVal [HVal] [HVal]
| SubIf HVal [HVal]
| Load String
deriving (Eq, Read)
My Parsers:
parseIf :: Parser HVal
parseIf = do
_ <- string "if"
spaces
_ <- string "("
cond <- (parseExpr <|> parseEqExpr <|> parseBool)
_ <- string ")->"
expr <- spaces *> many (parseExpression <* spaces)
expr' <- spaces *> many (parseExpression <* spaces)
return $ If cond expr expr'
parseSubIf :: Parser HVal
parseSubIf = do
_ <- string "[]"
spaces
_ <- string "("
cond <- (parseExpr <|> parseEqExpr <|> parseBool)
_ <- string ")->"
expr <- spaces *> many (parseExpression <* spaces)
return $ SubIf cond expr
My Evaluator:
eval :: HVal -> HVal
---------- EVALUATING PRIMITIVES ----------
eval val#(HString _) = val
eval val#(HInteger _) = val
eval val#(HBool _) = val
eval val#(HList _) = val
eval (Expr x op y) = evalExpr x op y
eval (If cond expr expr') = evalIf cond expr expr'
eval (SubIf cond expr) = evalSubIf cond expr
evalIf :: HVal -> [HVal] -> [HVal] -> HVal
evalIf cond expr expr' = if ((eval cond) == (HBool True))
then HList $ map eval expr
else HList $ (filter (/= (HInteger 1)) (map eval expr'))
evalSubIf :: HVal -> [HVal] -> HVal
evalSubIf cond expr = if ((eval cond) == (HBool True))
then HList $ map eval expr
else (HInteger 1)
I think that the error may be with my parser for the if-block. My thinking behind it was that the if block contains the conditional for the first branch and what it evaluates to and then a list of sub expressions wherein each element of the list contains the branch conditional and what it evaluates to.
Currently, I am working on a problem of parsing and showing expressions in Haskell.
type Name = String
data Expr = Val Integer
| Var Name
| Expr :+: Expr
| Expr :-: Expr
| Expr :*: Expr
| Expr :/: Expr
| Expr :%: Expr
This is the code of my data type Expr and this is how i define show function:
instance Show Expr where
show (Val x) = show x
show (Var y) = y
show (p :+: q) = par (show p ++ "+" ++ show q)
show (p :-: q) = par (show p ++ "-" ++ show q)
show (p :/: q) = par (show p ++ "/" ++ show q)
show (p :*: q) = par (show p ++ "*" ++ show q)
show (p :%: q) = par (show p ++ "%" ++ show q)
par :: String -> String
par s = "(" ++ s ++ ")"
Later i tried to transform string input into the expression but i encounter the following problem: I don't understand how parentheses in the second case are implemented in Haskell.
*Main> Val 2 :*:Val 2 :+: Val 3
((2*2)+3)
*Main> Val 2 :*:(Val 2 :+: Val 3)
(2*(2+3))
Because of that, i am a bit confused regarding how should i transform parentheses from my string into the expression. Currently i am using the following function for parsing, but for now, it just ignores parentheses which is not intended behavior:
toExpr :: String -> Expr
toExpr str = f (lexer str) (Val 0)
where
f [] expr = expr
f (c:cs) expr
|isAlpha (head c) = f cs (Var c)
|isDigit (head c) = f cs (Val (read c))
|c == "+" = (expr :+: f cs (Val 0))
|c == "-" = (expr :-: f cs (Val 0))
|c == "/" = (expr :/: f cs (Val 0))
|c == "*" = (expr :*: f cs (Val 0))
|c == "%" = (expr :%: f cs (Val 0))
|otherwise = f cs expr
Edit: few grammar mistakes
I don't understand how parentheses in the second case are implemented in Haskell.
The brackets just give precedence to a certain part of the expression to parse. The problem is not with the parenthesis you render. I think the problem is that you did not assign precedence to your operators. This thus means that, unless you specify brackets, Haskell will consider all operators to have the same precedence, and parse these left-to-right. This thus means that x ⊕ y ⊗ z is parsed as (x ⊕ y) ⊗ z.
You can define the precedence of your :+:, :*, etc. operators with infixl:
infixl 7 :*:, :/:, :%:
infixl 5 :+:, :-:
type Name = String
data Expr = Val Integer
| Var Name
| Expr :+: Expr
| Expr :-: Expr
| Expr :*: Expr
| Expr :/: Expr
| Expr :%: Expr
As for your parser (the toExpr), you will need a parsing mechanism like a LALR parser [wiki] that stores results on a stack, and thus makes proper operations.
This was my final parser which gave me the result I needed. To get the result i wanted proper grammar was added and i wrote a parses according to he grammar.
Thanks, everyone for the help.
{-
parser for the following grammar:
E -> T E'
E' -> + T E' | - T E' | <empty string>
T -> F T'
T' -> * F T' | / F T' | % F T' | <empty string>
F -> (E) | <integer> | <identifier>
-}
parseExpr :: String -> (Expr,[String])
parseExpr tokens = parseE (lexer tokens)
parseE :: [String] -> (Expr,[String])
parseE tokens = parseE' acc rest where (acc,rest) = parseT tokens
parseE' :: Expr -> [String] -> (Expr,[String])
parseE' accepted ("+":tokens) = let (acc,rest) = parseT tokens in parseE' (accepted :+: acc) rest
parseE' accepted ("-":tokens) = let (acc,rest) = parseT tokens in parseE' (accepted :-: acc) rest
parseE' accepted tokens = (accepted,tokens)
parseT :: [String] -> (Expr,[String])
parseT tokens = let (acc,rest) = parseF tokens in parseT' acc rest
parseT' :: Expr -> [String] -> (Expr,[String])
parseT' accepted ("*":tokens) = let (acc,rest) = parseF tokens in parseT' (accepted :*: acc) rest
parseT' accepted ("/":tokens) = let (acc,rest) = parseF tokens in parseT' (accepted :/: acc) rest
parseT' accepted ("%":tokens) = let (acc,rest) = parseF tokens in parseT' (accepted :%: acc) rest
parseT' accepted tokens = (accepted,tokens)
parseF :: [String] -> (Expr,[String])
parseF ("(":tokens) = (e, tail rest) where (e,rest) = parseE tokens
parseF (t:tokens)
| isAlpha (head t) = (Var t,tokens)
| isDigit (head t) = (Val (read t),tokens)
| otherwise = error ""
parseF [] = error ""
lexer :: String -> [String]
lexer [] = []
lexer (c:cs)
| elem c " \t\n" = lexer cs
| elem c "=+-*/%()" = [c]:(lexer cs)
| isAlpha c = (c:takeWhile isAlpha cs):lexer(dropWhile isAlpha cs)
| isDigit c = (c:takeWhile isDigit cs):lexer(dropWhile isDigit cs)
| otherwise = error ""
Hello I have a been given the problem:
Write an F# function toString: aexpr -> string to format expressions
as strings, with the binary operators written in infix format. For
instance, it may format Sub(Var "x", CstI 34) as the string "x -
34". For simplicity, put parentheses around any subexpressions, even
when they are superfluous according to the standard precedence rules
for arithmetic operators. Use the predefined function string to convert
an integer value to its string representation.
Hint: toString has very much the same structure as an eval function,
although it needs no environment argument because it uses variables
names, not variable values.
yes this is a HW problem. Any help would greatly be appreciated with explanations. Below I included an eval function
These are data types we have been using:
type oper1 = Neg | Not
type oper2 = Add | Mul | Sub | Less | Eq | And
type aexpr =
| C of int
| V of string
| Op1 of oper1 * aexpr
| Op2 of oper2 * aexpr * aexpr
let rec eval e (env : (string * int) list) : int =
match e with
| CstI i -> i
| Var x -> lookup env x
| Prim("+", e1, e2) -> (eval e1 env) + (eval e2 env)
| Prim("*", e1, e2) -> (eval e1 env) * (eval e2 env)
| Prim("-", e1, e2) -> (eval e1 env) - (eval e2 env)
| Prim _ -> failwith "unknown primitive"
| Let(x, e1, e2) -> eval e2 ((x, eval e1 env) :: env)
So for the given problem I have written:
let rec toString e (env : (string * int) list) : string
match e with
| Prim("+", e1, e2) -> "e1 + e2"
| Prim("*", e1, e2) -> "e1 - e2"
| Prim("-", e1, e2) -> "e1 * e2"
this may look foolish, or am I on the right track? Fairly new to F#
The problem states:
[...] although it needs no environment argument [...]
so your function toString should look something like this:
let rec toString e =
match e with
| CstI i -> sprintf "%i" i // format number as string
| Var x -> x // already a string
| Prim("+", e1, e2) -> sprintf "(%s + %s)" (toString e1) (toString e2)
| Prim("*", e1, e2) -> sprintf "(%s * %s)" (toString e1) (toString e2)
| Prim("-", e1, e2) -> sprintf "(%s - %s)" (toString e1) (toString e2)
For nested expressions toString is called on the subexpressions first. The resulting strings are then plugged into %s in sprintf.
I was running a example of an interpreter made with Continuations, and it fails in Mono JIT compiler version 4.3.0 with a stackoverflow error despite the Tail Call optimization enabled. The same code works fine in Windows (.NET 4.6).
This is the code:
open System
open System.Runtime
let print x = printfn "%A" x
type 'data env = (string * 'data) list
let rec lookup env x =
match env with
| [] -> failwith (x + " not found")
| (y, v)::yr -> if x=y then v else lookup yr x
(* Abstract syntax of functional language with exceptions *)
type exn =
| Exn of string
type expr =
| CstI of int
| CstB of bool
| Var of string
| Let of string * expr * expr
| Prim of string * expr * expr
| If of expr * expr * expr
| Letfun of string * string * expr * expr (* (f, x, fbody, ebody) *)
| Call of string * expr
| Raise of exn
| TryWith of expr * exn * expr (* try e1 with exn -> e2 *)
type value =
| Int of int
| Closure of string * string * expr * value env (* (f, x, fBody, fDeclEnv) *)
type answer =
| Result of int
| Abort of string
let rec coEval2 (e : expr) (env : value env) (cont : int -> answer)
(econt : exn -> answer) : answer =
match e with
| CstI i -> cont i
| CstB b -> cont (if b then 1 else 0)
| Var x ->
match lookup env x with
| Int i -> cont i
| _ -> Abort "coEval2 Var"
| Prim(ope, e1, e2) ->
coEval2 e1 env
(fun i1 ->
coEval2 e2 env
(fun i2 ->
match ope with
| "*" -> cont(i1 * i2)
| "+" -> cont(i1 + i2)
| "-" -> cont(i1 - i2)
| "=" -> cont(if i1 = i2 then 1 else 0)
| "<" -> cont(if i1 < i2 then 1 else 0)
| _ -> Abort "unknown primitive") econt) econt
| Let(x, eRhs, letBody) ->
coEval2 eRhs env (fun xVal ->
let bodyEnv = (x, Int xVal) :: env
coEval2 letBody bodyEnv cont econt)
econt
| If(e1, e2, e3) ->
coEval2 e1 env (fun b ->
if b<>0 then coEval2 e2 env cont econt
else coEval2 e3 env cont econt) econt
| Letfun(f, x, fBody, letBody) ->
let bodyEnv = (f, Closure(f, x, fBody, env)) :: env
coEval2 letBody bodyEnv cont econt
| Call(f, eArg) ->
let fClosure = lookup env f
match fClosure with
| Closure (f, x, fBody, fDeclEnv) ->
coEval2 eArg env
(fun xVal ->
let fBodyEnv = (x, Int xVal) :: (f, fClosure) :: fDeclEnv
coEval2 fBody fBodyEnv cont econt)
econt
| _ -> raise (Failure "eval Call: not a function")
| Raise exn -> econt exn
| TryWith (e1, exn, e2) ->
let econt1 thrown =
if thrown = exn then coEval2 e2 env cont econt
else econt thrown
coEval2 e1 env cont econt1
(* The top-level error continuation returns the continuation,
adding the text Uncaught exception *)
let eval2 e env =
coEval2 e env
(fun v -> Result v)
(fun (Exn s) -> Abort ("Uncaught exception: " + s))
let run2 e = eval2 e []
(* Example: deep recursion to check for constant-space tail recursion *)
let exdeep = Letfun("deep", "x",
If(Prim("=", Var "x", CstI 0),
CstI 1,
Call("deep", Prim("-", Var "x", CstI 1))),
Call("deep", Var "n"));
let rundeep n = eval2 exdeep [("n", Int n)];
[<EntryPoint>]
let main argv =
rundeep 10000 |> ignore
"All fine!" |> print
0
I found that this is a problem with MONO but I wonder if there exists a way to work around this (I wish to do CSP to implement several features for the interpreter)
It is also notable that disabling the tail call optimization triggers the stackoverflow error way faster on windows than on mono/osx.
I reimplemented coEval2 using a trampoline. This function I cleverly called coEval3. coEval2 crashes for me in Debug and works in Release as expected. coEval3 seemed to work for me in both Debug and Release.
// After "jumping" the trampoline we either have a result (Done)
// or we need to "jump" again (Next)
type result<'T> =
| Done of 'T
| Next of (unit -> result<'T>)
let coEval3 (e : expr) (env : value env) (cont : int -> answer) (econt : exn -> answer) : answer =
// "Jumps" once producing either a result or a new "jump"
let rec jump (e : expr) (env : value env) (cont : int -> result<answer>) (econt : exn -> result<answer>) () : result<answer> =
match e with
| CstI i -> cont i
| CstB b -> cont (if b then 1 else 0)
| Var x ->
match lookup env x with
| Int i -> cont i
| _ -> Abort "coEval2 Var" |> Done
| Prim(ope, e1, e2) ->
jump e1 env
(fun i1 ->
jump e2 env
(fun i2 ->
match ope with
| "*" -> cont(i1 * i2)
| "+" -> cont(i1 + i2)
| "-" -> cont(i1 - i2)
| "=" -> cont(if i1 = i2 then 1 else 0)
| "<" -> cont(if i1 < i2 then 1 else 0)
| _ -> Abort "unknown primitive" |> Done) econt |> Next) econt |> Next
| Let(x, eRhs, letBody) ->
jump eRhs env (fun xVal ->
let bodyEnv = (x, Int xVal) :: env
jump letBody bodyEnv cont econt |> Next)
econt |> Next
| If(e1, e2, e3) ->
jump e1 env (fun b ->
if b<>0 then jump e2 env cont econt |> Next
else jump e3 env cont econt |> Next) econt |> Next
| Letfun(f, x, fBody, letBody) ->
let bodyEnv = (f, Closure(f, x, fBody, env)) :: env
jump letBody bodyEnv cont econt |> Next
| Call(f, eArg) ->
let fClosure = lookup env f
match fClosure with
| Closure (f, x, fBody, fDeclEnv) ->
jump eArg env
(fun xVal ->
let fBodyEnv = (x, Int xVal) :: (f, fClosure) :: fDeclEnv
jump fBody fBodyEnv cont econt |> Next)
econt |> Next
| _ -> raise (Failure "eval Call: not a function")
| Raise exn -> econt exn
| TryWith (e1, exn, e2) ->
let econt1 thrown =
if thrown = exn then jump e2 env cont econt |> Next
else econt thrown
jump e1 env cont econt1 |> Next
(* The top-level error continuation returns the continuation,
adding the text Uncaught exception *)
// If trampoline is tail-recursive F# will implement this as a loop,
// this is important for us as this means that the recursion is essentially
// turned into a loop
let rec trampoline j =
match j () with
| Done v -> v
| Next jj -> trampoline jj
let inline lift f v = f v |> Done
trampoline (jump e env (lift cont) (lift econt))
Hope this is somewhat useful
I have a discriminated union for expressions like this one (EQ =; GT >; etc)
(AND (OR (EQ X 0)
(GT X 10))
(OR (EQ Y 0)
(GT Y 10)))
I want to create instances of DU from such expressions saved in file/database.
How do i do it? If it is not feasible, what is the best way to approach it in F#?
Daniel: these expressions are saved in prefix format (as above) as text and will be parsed in F#. Thanks.
If you just want to know how to model these expressions using DUs, here's one way:
type BinaryOp =
| EQ
| GT
type Expr =
| And of Expr * Expr
| Or of Expr * Expr
| Binary of BinaryOp * Expr * Expr
| Var of string
| Value of obj
let expr =
And(
Or(
Binary(EQ, Var("X"), Value(0)),
Binary(GT, Var("X"), Value(10))),
Or(
Binary(EQ, Var("Y"), Value(0)),
Binary(GT, Var("Y"), Value(10))))
Now, this may be too "loose," i.e., it permits expressions like And(Value(1), Value(2)), which may not be valid according to your grammar. But this should give you an idea of how to approach it.
There are also some good examples in the F# Programming wikibook.
If you need to parse these expressions, I highly recommend FParsec.
Daniel's answer is good. Here's a similar approach, along with a simple top-down parser built with active patterns:
type BinOp = | And | Or
type Comparison = | Gt | Eq
type Expr =
| BinOp of BinOp * Expr * Expr
| Comp of Comparison * string * int
module private Parsing =
// recognize and strip a leading literal
let (|Lit|_|) lit (s:string) =
if s.StartsWith(lit) then Some(s.Substring lit.Length)
else None
// strip leading whitespace
let (|NoWs|) (s:string) =
s.TrimStart(' ', '\t', '\r', '\n')
// parse a binary operator
let (|BinOp|_|) = function
| Lit "AND" r -> Some(And, r)
| Lit "OR" r -> Some(Or, r)
| _ -> None
// parse a comparison operator
let (|Comparison|_|) = function
| Lit "GT" r -> Some(Gt, r)
| Lit "EQ" r -> Some(Eq, r)
| _ -> None
// parse a variable (alphabetical characters only)
let (|Var|_|) s =
let m = System.Text.RegularExpressions.Regex.Match(s, "^[a-zA-Z]+")
if m.Success then
Some(m.Value, s.Substring m.Value.Length)
else
None
// parse an integer
let (|Int|_|) s =
let m = System.Text.RegularExpressions.Regex.Match(s, #"^-?\d+")
if m.Success then
Some(int m.Value, s.Substring m.Value.Length)
else
None
// parse an expression
let rec (|Expr|_|) = function
| NoWs (Lit "(" (BinOp (b, Expr(e1, Expr(e2, Lit ")" rest))))) ->
Some(BinOp(b, e1, e2), rest)
| NoWs (Lit "(" (Comparison (c, NoWs (Var (v, NoWs (Int (i, Lit ")" rest))))))) ->
Some(Comp(c, v, i), rest)
| _ -> None
let parse = function
| Parsing.Expr(e, "") -> e
| s -> failwith (sprintf "Not a valid expression: %s" s)
let e = parse #"
(AND (OR (EQ X 0)
(GT X 10))
(OR (EQ Y 0)
(GT Y 10)))"