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.
Related
I just started exploring the possibilities of data types à la carte in combination with indexed types. My current experiment is a bit too large to include here, but can be found here. My example is mixing together an expression from different ingredients (arithmetic, functions, ...). The goal is to enforce only well-typed expressions. That is why an index is added to the expressions (the Sort type).
I can build expressions like:
-- define expressions over variables and arithmetic (+, *, numeric constants)
type Lia = IFix (VarF :+: ArithmeticF)
-- expression of integer type/sort
t :: Lia IntegralSort
t = var "c" .+. cnst 1
This is all good as long as I construct only fixed (static) expressions.
Is there a way to read an expression from string/other representation (that obviously has to encode the sort) and produce a dynamic value that gets represented by these functors?
For example, I would like to read ((c : Int) + (1 : Int)) and represent it somehow with VarF and ArithmeticF. Here I realize I cannot obtain a value of static type Lia IntegralSort. But suppose I have in addition:
data EqualityF a where
Equals :: forall s. a s -> a s -> EqualityF a BoolSort
I could expect there being a function that can read String into Maybe (IFix (EqualityF :+: VarF :+: ...)). Such a function would attempt to build representations for the LHS and RHS and if the sorts matched it could produce a result of statically known type IFix (EqualityF :+: ...) BoolSort. The problem is that the representation of LHS (and RHS) has no fixed static sort. Is what I am trying to do impossible with this representation I chose?
(.=.) :: EqualityF :<: f => IFix f s -> IFix f s -> IFix f BoolSort
(.=.) a b = inject (Equals a b)
You can use a GADT to hide the sort, allowing you to return values of sorts depending on the input. Pattern matching then allows you to recover the sort.
data Expr (f :: (Sort -> *) -> (Sort -> *)) where
BoolExpr :: IFix f BoolSort -> Expr f
IntExpr :: IFix f IntegralSort -> Expr f
Here is a simplistic parser of postfix expressions involving + and =.
parse :: (EqualityF :<: f, ArithmeticF :<: f) => String -> [Expr f] -> Maybe (Expr f)
parse (c : s) stack | isDigit c =
parse s (IntExpr (cnst (digitToInt c)) : stack)
parse ('+' : s) (IntExpr e1 : IntExpr e2 : stack) =
parse s (IntExpr (e1 .+. e2) : stack)
parse ('=' : s) (IntExpr e1 : IntExpr e2 : stack) =
parse s (BoolExpr (e1 .=. e2) : stack)
parse ('=' : s) (BoolExpr e1 : BoolExpr e2 : stack) =
parse s (BoolExpr (e1 .=. e2) : stack)
parse [] [e] = Just e
parse _ _ = Nothing
You might not like the duplicate cases for =. A more general framework is Typeable, allowing you to just test for the type equalities you need.
data SomeExpr (f :: (Sort -> *) -> Sort -> *) where
SomeExpr :: Typeable s => IFix f s -> SomeExpr f
parseSome :: forall f. (EqualityF :<: f, ArithmeticF :<: f) => String -> [SomeExpr f] -> Maybe (Expr f)
parseSome (c : s) stack | isDigit c =
parseSome s (SomeExpr (cnst (digitToInt c)) : stack)
parseSome ('+' : s) (SomeExpr e1 : SomeExpr e2 : stack) = do
e1 <- gcast e1
e2 <- gcast e2
parseSome s (SomeExpr (e1 .+. e2) : stack)
parseSome ('=' : s) (SomeExpr (e1 :: IFix f s1) : SomeExpr (e2 :: IFix f s2) : stack) = do
Refl <- eqT :: Maybe (s1 :~: s2)
parseSome s (SomeExpr (e1 .=. e2) : stack)
parseSome [] [e] = Just e
parseSome _ _ = Nothing
Edit
To parse sorts, you want to track them at the type level. Again, use an existential type.
data SomeSort where
SomeSort :: Typeable (s :: Sort) => proxy s -> SomeSort
You can construct the sort of arrays this way:
-- \i e -> array i e
arraySort :: SomeSort -> SomeSort -> SomeSort
arraySort (SomeSort (Proxy :: Proxy i)) (SomeSort (Proxy :: Proxy e)) =
SomeSort (Proxy :: Proxy (ArraySort i e))
A potential problem with Typeable here is that it only allows you to test equality of types, when you may want only to check the head constructor: you can't ask "is this type an ArraySort?", but only "is this type equal to ArraySort IntSort BoolSort?" or some other full type.
In that case you need a GADT that reflects the structure of a sort.
-- "Singleton type"
data SSort (s :: Sort) where
SIntSort :: SSort IntSort
SBoolSort :: SSort BoolSort
SArraySort :: SSort i -> SSort e -> SSort (ArraySort i e)
data SomeSort where
SomeSort :: SSort s -> SomeSort
array :: SomeSort -> SomeSort -> SomeSort
array (SomeSort i) (SomeSort e) = SomeSort (SArraySort i e)
The singleton package provides various facilities for defining and working with these singleton types, though it may be overkill for your use case.
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've defined an expression tree structure in F# as follows:
type Num = int
type Name = string
type Expr =
| Con of Num
| Var of Name
| Add of Expr * Expr
| Sub of Expr * Expr
| Mult of Expr * Expr
| Div of Expr * Expr
| Pow of Expr * Expr
| Neg of Expr
I wanted to be able to pretty-print the expression tree so I did the following:
let (|Unary|Binary|Terminal|) expr =
match expr with
| Add(x, y) -> Binary(x, y)
| Sub(x, y) -> Binary(x, y)
| Mult(x, y) -> Binary(x, y)
| Div(x, y) -> Binary(x, y)
| Pow(x, y) -> Binary(x, y)
| Neg(x) -> Unary(x)
| Con(x) -> Terminal(box x)
| Var(x) -> Terminal(box x)
let operator expr =
match expr with
| Add(_) -> "+"
| Sub(_) | Neg(_) -> "-"
| Mult(_) -> "*"
| Div(_) -> "/"
| Pow(_) -> "**"
| _ -> failwith "There is no operator for the given expression."
let rec format expr =
match expr with
| Unary(x) -> sprintf "%s(%s)" (operator expr) (format x)
| Binary(x, y) -> sprintf "(%s %s %s)" (format x) (operator expr) (format y)
| Terminal(x) -> string x
However, I don't really like the failwith approach for the operator function since it's not compile-time safe. So I rewrote it as an active pattern:
let (|Operator|_|) expr =
match expr with
| Add(_) -> Some "+"
| Sub(_) | Neg(_) -> Some "-"
| Mult(_) -> Some "*"
| Div(_) -> Some "/"
| Pow(_) -> Some "**"
| _ -> None
Now I can rewrite my format function beautifully as follows:
let rec format expr =
match expr with
| Unary(x) & Operator(op) -> sprintf "%s(%s)" op (format x)
| Binary(x, y) & Operator(op) -> sprintf "(%s %s %s)" (format x) op (format y)
| Terminal(x) -> string x
I assumed, since F# is magic, that this would just work. Unfortunately, the compiler then warns me about incomplete pattern matches, because it can't see that anything that matches Unary(x) will also match Operator(op) and anything that matches Binary(x, y) will also match Operator(op). And I consider warnings like that to be as bad as compiler errors.
So my questions are: Is there a specific reason why this doesn't work (like have I left some magical annotation off somewhere or is there something that I'm just not seeing)? Is there a simple workaround I could use to get the type of safety I want? And is there an inherent problem with this type of compile-time checking, or is it something that F# might add in some future release?
If you code the destinction between ground terms and complex terms into the type system, you can avoid the runtime check and make them be complete pattern matches.
type Num = int
type Name = string
type GroundTerm =
| Con of Num
| Var of Name
type ComplexTerm =
| Add of Term * Term
| Sub of Term * Term
| Mult of Term * Term
| Div of Term * Term
| Pow of Term * Term
| Neg of Term
and Term =
| GroundTerm of GroundTerm
| ComplexTerm of ComplexTerm
let (|Operator|) ct =
match ct with
| Add(_) -> "+"
| Sub(_) | Neg(_) -> "-"
| Mult(_) -> "*"
| Div(_) -> "/"
| Pow(_) -> "**"
let (|Unary|Binary|) ct =
match ct with
| Add(x, y) -> Binary(x, y)
| Sub(x, y) -> Binary(x, y)
| Mult(x, y) -> Binary(x, y)
| Div(x, y) -> Binary(x, y)
| Pow(x, y) -> Binary(x, y)
| Neg(x) -> Unary(x)
let (|Terminal|) gt =
match gt with
| Con x -> Terminal(string x)
| Var x -> Terminal(string x)
let rec format expr =
match expr with
| ComplexTerm ct ->
match ct with
| Unary(x) & Operator(op) -> sprintf "%s(%s)" op (format x)
| Binary(x, y) & Operator(op) -> sprintf "(%s %s %s)" (format x) op (format y)
| GroundTerm gt ->
match gt with
| Terminal(x) -> x
also, imo, you should avoid boxing if you want to be type-safe. If you really want both cases, make two pattern. Or, as done here, just make a projection to the type you need later on. This way you avoid the boxing and instead you return what you need for printing.
I think you can make operator a normal function rather than an active pattern. Because operator is just a function which gives you an operator string for an expr, where as unary, binary and terminal are expression types and hence it make sense to pattern match on them.
let operator expr =
match expr with
| Add(_) -> "+"
| Sub(_) | Neg(_) -> "-"
| Mult(_) -> "*"
| Div(_) -> "/"
| Pow(_) -> "**"
| Var(_) | Con(_) -> ""
let rec format expr =
match expr with
| Unary(x) -> sprintf "%s(%s)" (operator expr) (format x)
| Binary(x, y) -> sprintf "(%s %s %s)" (format x) (operator expr) (format y)
| Terminal(x) -> string x
I find the best solution is to restructure your original type defintion:
type UnOp = Neg
type BinOp = Add | Sub | Mul | Div | Pow
type Expr =
| Int of int
| UnOp of UnOp * Expr
| BinOp of BinOp * Expr * Expr
All sorts of functions can then be written over the UnOp and BinOp types including selecting operators. You may even want to split BinOp into arithmetic and comparison operators in the future.
For example, I used this approach in the (non-free) article "Language-oriented programming: The Term-level Interpreter
" (2008) in the F# Journal.
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).
I want the expression (x-x) to be simplified to 0.
type aexpr =
| CstI of int
| Var of string
| Add of aexpr * aexpr
| Sub of aexpr * aexpr
| Mul of aexpr * aexpr;;
let rec simplify expr =
match expr with
| Add(CstI(n1), CstI(n2)) ->CstI(n1 + n2)
| Sub(CstI(n1), CstI(n2)) ->CstI(n1 - n2)
| Mul(CstI(n1), CstI(n2)) ->CstI(n1 * n2)
| Add(e, CstI(0)) -> simplify e
| Add(CstI(0), e) -> simplify e
| Sub(CstI(0), e) -> simplify e
| Sub(e, CstI(0)) -> simplify e
| Sub(Var(x1), Var(x2)) when x1.Equals(x2) -> CstI(0) // <- not working
| Mul(CstI(0), e) -> CstI(0)
| Mul(e, CstI(0)) -> CstI(0)
| Mul(CstI(1), e) -> simplify e
| Mul(e, CstI(1)) -> simplify e
| _ -> expr;;
This does not do it. I do not see what I am doing wrong. Hope you can help me :)
Edit:
It compiles fine but it does not do anything. Ie.
let e = Mul(CstI(1), Add(CstI(4), Sub(Var("x"), Var("x"))));;
In f# interactive:
let result = simplify e;;
val result : aexpr = Add (CstI 4,Sub (Var "x",Var "x"))
Result should be CstI 4
simplify (Sub (Var "x", Var "x")) works just fine. The reason that your example does not work is that simplify does not traverse the whole tree, so the Sub (Var "x", Var "x") part of the tree is never simplified.
In short, you're missing a case Sub (e,e) -> Sub (simplify e, simplify e) and the same for the other operators.
It seems to work here. You're not dealing with a case-sensitivity issue with the string comparison, are you?