I have created an immutable Queue in F# as follows:
type Queue<'a>(f : 'a list, r : 'a list) =
let check = function
| [], r -> Queue(List.rev r, [])
| f, r -> Queue(f, r)
member this.hd =
match f with
| [] -> failwith "empty"
| hd :: tl -> hd
member this.tl =
match f, r with
| [], _ -> failwith "empty"
| hd::f, r -> check(f, r)
member this.add(x) = check(f, x::r)
static member empty : Queue<'a> = Queue([], [])
I want to create an instance of an empty Queue, however I get a value-restriction exception:
> let test = Queue.empty;;
let test = Queue.empty;;
----^^^^
C:\Documents and Settings\juliet\Local Settings\Temp\stdin(5,5): error FS0030:
Value restriction. The value 'test' has been inferred to have generic type
val test : Queue<'_a>
Either define 'test' as a simple data term, make it a function with explicit
arguments or, if you do not intend for it to be generic, add a type annotation.
Basically, I want the same kind of functionality seen in the Set module which allows me to write:
> let test = Set.empty;;
val test : Set<'a>
How can I modify my Queue class to allow users to create empty queues?
You need to use GeneralizableValueAttribute, a la:
type Queue<'a>(f : 'a list, r : 'a list) = // '
let check = function
| [], r -> Queue(List.rev r, [])
| f, r -> Queue(f, r)
member this.hd =
match f with
| [] -> failwith "empty"
| hd :: tl -> hd
member this.tl =
match f, r with
| [], _ -> failwith "empty"
| hd::f, r -> check(f, r)
member this.add(x) = check(f, x::r)
module Queue =
[<GeneralizableValue>]
let empty<'T> : Queue<'T> = Queue<'T>([], []) // '
let test = Queue.empty
let x = test.add(1) // x is Queue<int>
let y = test.add("two") // y is Queue<string>
You can read a little more about it in the language spec.
Related
I got this code:
type regexp =
| V (* void *)
| E (* epsilon *)
| C of char (* char *)
| U of regexp * regexp (* a + b *)
| P of regexp * regexp (* a.b *)
| S of regexp (* a* *)
;;
...
module ReS = Set.Make (struct
type t = regexp
let compare = compare
end)
(* module/type for pairs of sets of regular expressions *)
module RePS = Set.Make (struct
type t = ReS.t * ReS.t
let compare = compare
end)
(*module/type for set of chars *)
module CS = Set.Make(Char)
let ewps = ReS.exists ewp;;
let atmost_epsilons = ReS.for_all atmost_epsilon;;
let infinitys = ReS.exists infinity;;
let rigth_concat s = function
| V -> ReS.empty
| E -> s
| r -> ReS.map (fun e -> P (e,r)) s
;;
let ( *.* ) = rigth_concat;;
(* partial derivative of a regular expression *)
let rec pd a re = function
| V | E -> ReS.empty
| C b when b=a -> ReS.singleton E
| C b -> ReS.empty
| U (r, s) -> ReS.union (pd a r) (pd a s)
| P (r, s) when ewp a -> ReS.union ((pd a r) *.* s) (pd a s)
| P (r, s) -> (pd a r) *.* s
| S r as re -> (pd a r) *.* re
;;
let rec unions f s =
ReS.fold (fun re acc -> ReS.union (f re) acc ) s ReS.empty
;;
let rec pds a s = unions (pd a) s;;
let rec pdw (sr: ReS.t) = function
| [] -> sr
| a::tl -> pds a (pdw sr tl)
;;
I checked the types of return values and i think they are correct, but it returns the following error and I am not sure why.
This expression has type regexp -> ReS.t but an expression was
expected of type ReS.t
In function "pd" in line that has error
| U (r, s) -> ReS.union (pd a r) (pd a s)
I believe your problem is caused by the fact that function supplies an implicit parameter. This expression:
function None -> 0 | Some x -> x
is a function with one parameter. So in your case you have defined pd to have three parameters. It looks to me like you're expecting it to have two parameters.
You can probably change your function ... to match re with instead. Or you can remove the explicit re parameter, and use the parameter that's implicit in function.
I am trying to do the following (which doesn't compile):
let Parse<'T> value =
Enum.Parse(typedefof<'T>, value) :?> 'T
In short I would like to pass an enum type, and a string and get back an enum value.
An example usage would be:
type MyEnums =
| Green = 0,
| Blue = 1
and then:
let r = Parse<MyEnums> "Green"
what would be the syntax? I haven't used generics yet in F#, so this is what I came up with from reading the docs.
bonus question would be if there is a way to parse enums in a case insensitive way (besides turning everything to lowercase for example)
This does compile for me (also without true, did you open System?):
let Parse<'T> value =
System.Enum.Parse(typedefof<'T>, value, true) :?> 'T
and works case-insensitive for
type MyEnums =
| Green = 0
| Blue = 1
Parse<MyEnums> "Green" // Green
Parse<MyEnums> "blue" // Blue
I came up with this in a hurry, which I believe has the advantage of not accepting other types than enums. Haven't had time to google for a better way, if there is one. Also, the underlying type must be int, and I haven't had time to see if there's something to be done with that either.
type MyEnum = | A = 1 | B = 2
let parseEnum<'T when 'T : (new : unit -> 'T) and 'T : struct and 'T :> ValueType and 'T : enum<int>> v =
match Enum.TryParse<'T> v with
| true, v -> Some v
| false, _ -> None
let x = parseEnum<MyEnum> "B"
match x with
| Some x -> printfn "%A" x
| None -> printfn "Sorry"
// let z = parseEnum<int> "1" // won't compile
In C# I can enable monadic composition in Linq query for a custom type by implementing extension methods for Select and SelectMany, for example:
public static Either<L, R2> Select<L, R, R2>(this Either<L, R> #this, Func<R, R2> fn) => #this.Map(fn);
public static Either<L, R2> SelectMany<L, R, R2>(this Either<L, R> #this, Func<R, Either<L, R2>> fn) => #this.FlatMap(fn);
public static Either<L, R2> SelectMany<L, R, R1, R2>(this Either<L, R> #this, Func<R, Either<L, R1>> fn, Func<R, R1, R2> select) => #this.FlatMap(a => fn(a).FlatMap(b => select(a, b).ToEither<L, R2>()));
The third extension method is what enables monadic composition in Linq query on a similar basis to the liftM functions in Haskell, for example:
Either<L, C> LiftM2(Either<L, A> m1, Either<L, B> m2, Func<A, B, C> f) {
return from a in m1
from b in m2
select Right(f(a, b));
}
My problem is however related to do achieving the outcome in F# by implementing extension methods for a custom Either type to enable monadic composition in Linq query.
Here is my definition of the Either type:
type Either<'l, 'r> =
| Left of 'l
| Right of 'r
First I added a functions for map and flatmap including custom operators for map as <!> and flatmap as >>= and =<<:
[<AutoOpen>]
module Either =
let lmap f e =
match e with
| Left(l) -> Left(f(l))
| Right(r) -> Right(r)
let rmap f e =
match e with
| Left(l) -> Left(l)
| Right(r) -> Right(f(r))
let map f e = rmap f e
let inline (<!>) e f = map f e
let inline (<!) a e = map >> constant
let lflatmap f e =
match e with
| Left(l) -> f(l)
| Right(r) -> Right(r)
let rflatmap f e =
match e with
| Left(l) -> Left(l)
| Right(r) -> f(r)
let flatmap f e = rflatmap f e
let inline (>>=) f e = flatmap f e
let inline (=<<) e f = flatmap f e
let _return r = Right(r);
let fail (l : string) = Left(l);
Then I added extension methods implementations; as I've garnered from other examples:
[<Extension>]
type EitherExtensions() =
[<Extension>]
static member inline Select(e: Either<'l, 'r>, f: 'r -> 's) = map f e
static member inline SelectMany(e: Either<'l, 'r>, f: 'r -> Either<'l, 's>) = flatmap f e
static member inline SelectMany(e: Either<'l, 'r>, f: 'r -> Either<'l, 's>, select: 'r -> 's -> 't) = (f >>= e) =<< (fun s -> Either.Right(select(e, s)))
Problem is when I try to use this to implement liftM, liftM2, ... functions it doesn't appear to pick up these extension methods; instead it uses the extension methods for System.Linq.IQueryable and not my custom extension methods for Linq e.g. SelectMany
let liftM f m1 = query {
for a in m1 do
select Right(f(a))
}
The type of liftM resolve to:
liftM:
f: a -> b,
m1: System.Linq.IQueryable<'a>
-> System.Linq.IQueryable<Either<'c, 'a>>
Instead of:
liftM:
f: a -> b,
m1: Either<'c, 'a>
-> Either<'c, 'b>
I can of course implement liftM using either pattern matching, for example:
let liftM2 f m1 m2 =
match m1, m2 with
| Right(a), Right(b) -> Right(f(a, b));
| Left(a), _ -> Left(a)
| _, Left(b) -> Left(b)
...
...or inline monadic composition, for example:
let liftM2 f m1 m2 = m1 =<< (fun a -> m2 =<< (fun b -> Right(f(a, b))))
However for both expediency and a bit knowledge I'd like to know how to achieve the same outcome as C# in F#
Is this possible?
The C# query syntax is based on a syntactic transformation as your example shows, in F# each monad instance is represented by an associated builder class which implements the required operations e.g. seq, async, query. You need to create an either builder which implements the required operations. For your example you only need a minimal implementation:
type EitherBuilder() =
member x.Bind(e, f) = flatmap f e
member x.Return(value) = _return value
member x.ReturnFrom(e) = e
let either = new EitherBuilder()
then you can use it to implement liftM:
let liftM f m1 = either {
let! a = m1
return (f a)
}
When trying to sort a 1d array of variants (here by "variant" I mean all the Excel types, eg bool, double (and date), string, various errors...) with the following function :
[<ExcelFunction(Category="test", Description="sort variants.")>]
let sort_variant ([<ExcelArgument(Description= "Array to sort.")>] arr : obj[]): obj[] =
arr
|> Array.sort
I get the following error : Error FS0001 The type 'obj' does not support the 'comparison' constraint. For example, it does not support the 'System.IComparable' interface, probably meaning that there is no generic ordering function available on all obj types.
But Excel has a natural ordering function, which I'd like to emulate (at least ballpark). Eg double (and dates) < string < bool < error...
My question : What is the idiomatic way to sort an array of "variants" in F# / Excel-Dna? (I am after a function which takes an obj[] and return an obj[], nothing else, not a macro...)
My (temporary?) solution :
I created a “discriminated union” type
type XLVariant = D of double | S of string | B of bool | NIL of string
(not really sure whether NIL is necessary but it did not hurt. Also in my real life code I added a DT of DateTime instance as I need to distinguish dates from doubles).
let toXLVariant (x : obj) : XLVariant =
match x with
| :? double as d -> D d
| :? string as s -> S s
| :? bool as b -> B b
| _ -> NIL "unknown match"
let ofXLVariant (x : XLVariant) : obj =
match x with
| D d -> box d
| S s -> box s
| B b -> box b
| NIL _ -> box ExcelError.ExcelErrorRef
[<ExcelFunction(Category="test", Description="sort variants.")>]
let sort_variant ([<ExcelArgument(Description= "Array to sort.")>] arr : obj[]): obj[] =
arr
|> Array.map toXLVariant
|> Array.sort
|> Array.map ofXLVariant
(for the sake of simplicity, I missed the Errors types, but the idea is the same)
This seems a bit more explicit to me, since it just sticks to the CLR type system:
// Compare objects in the way Excel would
let xlCompare (v1 : obj) (v2 : obj) =
match (v1, v2) with
| (:? double as d1), (:? double as d2) -> d1.CompareTo(d2)
| (:? double), _ -> -1
| _, (:? double) -> 1
| (:? string as s1), (:? string as s2) -> s1.CompareTo(s2)
| (:? string), _ -> -1
| _, (:? string) -> 1
| (:? bool as b1), (:? bool as b2) -> b1.CompareTo(b2)
| (:? bool), _ -> -1
| _, (:? bool) -> 1
| _ -> 2
[<ExcelFunction(Category="test", Description="sort variants.")>]
let sort_variant ([<ExcelArgument(Description= "Array to sort.")>] arr : obj[]): obj[] =
Array.sortWith xlCompare arr
On the odd chance, that someone has a brilliant idea...
I am not sure if there is a good way to generalize that.
EDIT: I think it might be nice to explain exactly what the inputs and outputs are. The code below is only how I approached the solution.
Inputs: data, recipe
data: set of string, string list here also called "set of named lists"
recipe: list of commands
Command Print (literal|list reference)
Adds the literal to the output or if it is a list reference, it adds the head of the referenced list to the output.
Command While (list reference)
when referenced list not empty --> next command
when referenced list empty --> skip entries in recipe list past the matching Wend.
Command Wend (list reference)
replace referenced list with tail (reference list)
when referenced list is empty, next command
when referenced list is not empty, next command is the matching while above.
Outputs: string list
The best answer is the implementation of that which is shortest and which allows to re-use that algorithm in new contexts.
This is not just a programming problem for the fun of it, btw. It is basically what happens if you try to implement data driven text templating.
The code below is my attempt to solve this problem.
The first code snippet is a non-generalized solution.
The second code snippet is an attempt to isolate the algorithm.
If you play with the code, simply paste the second snippet below the first snippet and both versions are working.
The whole topic is about understanding better how to separate the iteration algorithm from the rest of the code and then to simply apply it, in contrast of having all the other code within.
Would it not be great, if there was a way to abstract the way the statements are being processed and the looping of the while/wend, such,
that it can be reused in my main code, just as I keep re-using other "iteration schemes", such as List.map?
The commonalities between my main code and this study are:
An evolving "environment" which is threaded through all steps of the computation.
Collections, which need to be iterated in a well-formed nested manner. (Malformed would be: while x while y wend x wend y)
A series of "execution steps" form the body of each of those "while wend" loops.
Done in a "pure" manner. As you will note, nothing is mutable in the study. Want to keep it like that.
Each "While" introduces a new scope (as for binding values), which is discarded again, once the while loop is done.
So, I am looking for something like:
run: CommandClassifier -> commandExecutor -> Command list -> EnvType -> EnvType
where
CommandClassifier could be a function of the form Command -> NORMAL|LOOP_START|LOOP_END
and commandexecutor: Command -> EnvType -> EnvType
Of course, nesting of those while-blocks would not be limited to 2 (just tried to keep the testProgram() small).
SideNote: the "commands list" is an AST from a preceding parser run, but that should not really matter.
type MiniLanguage =
| Print of string
| While of string
| Wend of string
let testProgram =
[ Print("Hello, I am your Mini Language program")
While("names")
Print("<names>")
While("pets")
Print("<pets>")
Wend("pets")
Print("Done with pets.")
Wend("names")
Print("Done with names.")
]
type MiniEnvironment = { Bindings : Map<string,string>; Collections : Map<string, string list> }
let init collections =
{ Bindings = Map.empty; Collections = Map.ofList collections}
let bind n v env =
let newBindings =
env.Bindings
|> Map.remove n
|> Map.add n v
{ env with Bindings = newBindings; }
let unbind n env =
{ env with Bindings = Map.remove n env.Bindings; }
let bindingValue n env =
if env.Bindings.ContainsKey n then
Some(env.Bindings.Item n)
else
None
let consumeFirstFromCollection n env =
if env.Collections.ContainsKey n then
let coll = env.Collections.Item n
match coll with
| [] -> env |> unbind n
| _ ->
let first = coll.Head
let newCollections =
env.Collections
|> Map.remove n
|> Map.add n coll.Tail
{ env with Collections = newCollections }
|> bind n first
else failwith ("Unknown collection: " + n)
// All do functions take env - the execution environment - as last argument.
// All do functions return (a new) env as single return parameter.
let rec doPrint (s : string) env =
if s.StartsWith("<") && s.EndsWith(">") then
match bindingValue (s.Substring (1, s.Length - 2 )) env with
| Some(v) -> v
| _ -> s
else s
|> printfn "%s"
env
let rec skipPastWend name code =
match code with
| (Wend(cl) :: rest) when cl = name -> rest
| [] -> failwith "No Wend found!"
| (_ :: rest) -> skipPastWend name rest
let rec doWhileX name code env =
match code with
| (Print(s) :: rest) -> env |> (doPrint s) |> doWhileX name rest
| (While(cn) :: rest) -> env |> doWhile cn rest |> ignore; env |> doWhileX name (skipPastWend cn rest)
| (Wend(cn) :: rest) when cn = name -> env
| [] -> failwith ("While without Wend for: " + name)
| _ -> failwith ("nested while refering to same collection!")
and doWhile name code env =
let e0 = env |> consumeFirstFromCollection name
match bindingValue name e0 with
| Some(s) ->
e0 |> doWhileX name code |> doWhile name code
| None -> env
let rec run (program : MiniLanguage list) env =
match program with
| (Print(s) :: rest) -> env |> (doPrint s) |> run rest
| (While(cn) :: rest) ->
env
|> doWhile cn rest |> ignore
env |> run (skipPastWend cn program)
| (Wend(cn) :: rest) -> failwith "wend found in run()"
| [] -> env
let test() =
init [ "names", ["name1"; "name2"; "name3"; ]; "pets", ["pet1"; "pet2"] ]
|> run testProgram
|> printfn "%A"
(*
Running test() yields:
Hello, I am your Mini Language program
name1
pet1
pet2
Done with pets.
name2
pet1
pet2
Done with pets.
name3
pet1
pet2
Done with pets.
Done with names.
{Bindings = map [];
Collections =
map [("names", ["name1"; "name2"; "name3"]); ("pets", ["pet1"; "pet2"])];}
*)
Here my first version of isolating the algorithm. The number of callbacks is not entirely pretty. Can anyone come up with something simpler?
// The only function I had to "modify" to work with new "generalized" algorithm.
let consumeFirstFromCollection1 n env =
if env.Collections.ContainsKey n then
let coll = env.Collections.Item n
match coll with
| [] -> (env |> unbind n , false)
| _ ->
let first = coll.Head
let newCollections =
env.Collections
|> Map.remove n
|> Map.add n coll.Tail
({ env with Collections = newCollections }
|> bind n first , true)
else failwith ("Unknown collection: " + n)
type NamedList<'n,'t when 'n : comparison> = 'n * List<'t>
type Action<'a,'c> = 'c -> 'a -> 'a
type LoopPreparer<'a,'c> = 'c -> 'a -> 'a * bool
type CommandType = | RUN | BEGIN | END
type CommandClassifier<'c> = 'c -> CommandType
type Skipper<'c> = 'c -> List<'c> -> List<'c>
type InterpreterContext<'a,'c> =
{ classifier : CommandClassifier<'c>
executor : Action<'a,'c>
skipper : Skipper<'c>
prepareLoop : LoopPreparer<'a,'c>
isMatchingEnd : 'c -> 'c -> bool
}
let interpret (context : InterpreterContext<'a,'c>) (program : 'c list) (env : 'a) : 'a =
let rec loop front (code : 'c list) e =
let e0,hasData = e |> context.prepareLoop front
if hasData
then
e0
|> loop1 front (code)
|> loop front (code)
else e
and loop1 front code e =
match code with
| x :: more when (context.classifier x) = RUN ->
//printfn "RUN %A" x
e |> context.executor x |> loop1 front more
| x :: more when (context.classifier x) = BEGIN ->
//printfn "BEGIN %A" x
e |> loop x more |> ignore
e |> loop1 front (context.skipper x more)
| x :: more when (((context.classifier x) = END) && (context.isMatchingEnd front x)) -> /// && (context.isMatchingEnd front x)
//printfn "END %A" x
e
| [] -> failwith "No END."
| _ -> failwith "TODO: Not sure which case this is. But it is not a legal one!"
let rec interpr code e =
match code with
| [] -> e
| (first :: rest) ->
match context.classifier first with
| RUN -> env |> context.executor first |> interpr rest
| BEGIN ->
e |> loop first rest |> ignore
e |> interpr (context.skipper first rest)
| END -> failwith "END without BEGIN."
interpr program env
let test1() =
let context : InterpreterContext<MiniEnvironment,MiniLanguage> =
{ classifier = fun c-> match c with | MiniLanguage.Print(_) -> RUN | MiniLanguage.While(_) -> BEGIN | MiniLanguage.Wend(_) -> END;
executor = fun c env -> match c with | Print(s) -> doPrint s env | _ -> failwith "Not a known command.";
skipper = fun c cl -> match c with | While(n) -> skipPastWend n cl | _ -> failwith "first arg of skipper SHALL be While!"
prepareLoop = fun c env -> match c with | While(n) -> (consumeFirstFromCollection1 n env) | _ -> failwith "first arg of skipper SHALL be While!"
isMatchingEnd = fun cwhile cx -> match cwhile,cx with | (While(n),Wend(p)) when n = p -> true | _ -> false
}
init [ "names", ["name1"; "name2"; "name3"; ]; "pets", ["pet1"; "pet2"] ]
|> interpret context testProgram
|> printfn "%A"