Code:
type Result = string option
type Parser<'a> = string -> int -> ('a -> Result) -> ('a -> Result) -> Result
let win r = Some <| "Correct: " + r
let lose _ = None
let parse_a: Parser<char> = fun text i win_cps lose_cps ->
let x = text.[i]
if x = 'a' then win_cps x else lose_cps x
let parse_many: Parser<char> -> Parser<char list> = fun p text i win_cps lose_cps ->
let rec loop: char list -> Parser<char list> = fun l text i _ _ ->
let win = fun (l: char list) (r: char) -> loop (r:l) text i win_cps lose_cps
let lose = fun (l: char list) (r: char) -> win_cps (r:l)
p text (i+1) (win l) (lose l)
loop [] text (i-1) win_cps lose_cps
parse_many parse_a "aaabc" 0 (fun r -> win (r |> System.String.Concat)) lose
The error: cps_parser_v0.fsx(12,59): error FS0039: The type 'l' is not defined
I want to make a functionally pure CPS parser in Haskell and am experimenting in F# first. If I really wanted to do this in F# I would use mutable state, but for now I am just wondering why this is not working? It looks to me that it can't remember partially applied parameters.
You have a typo: (r:l) should be (r::l). The : operator means "is of type", i.e. r:l means that you're telling the compiler that r is of type l. The :: operator means "prepend this to the front of this list": r::l means "prepend r to the front of list l".
You've made this mistake in two places: loop (r:l) should be loop (r::l), and one line further down, win_cps (r:l) should be win_cps (r::l).
Related
I would like to create a record type with a type annotation, with the constraint that the annotation must be a function that returns a certain type. Consider this example below:
type Foo<'Function> = {
Function: 'Function
}
I would 'Function to be able to be any function, as long as it returns for example int, so that
{Function = (fun a b c d e f g -> 2)}
{Function = (fun a -> 2)}
work, but
{Function = (fun a -> "")}
would be invalid.
As far as i understand F# functions, they are a nested structure of tuples, where the most inner second tuple field is the return type of the function, which is the reason why neither of these:
type Foo<('Input -> int)> = {
Function: ('Input -> int)
}
type ReturnsInt = FSharpFunc<'Input,int>
will work for any function with more than one argument, because the result type is encapsulated in the second annotation in either the signature or FSharpFunc<_,_>. Is there a way to realize this as a type annotation?
Edit
As Fyodor suggested in the comments below, this can be overcome by using only functions that have tupled arguments, leading to the function annotation being
FSharpFunc<argumentTuples,ReturnType>, e.g.:
type Foo<'ArgumentTuples> = {
Function: 'ArgumentTuples -> int
}
{Function = (fun (a,b,c,d,e,f,g) -> 2)} // works
{Function = (fun a -> 2)} // works
{Function = (fun a -> "")} // wont work
While this approach has its own problems and is not the specific answer to the original question, this workaround/workflow adaptation might be enough for me. I'll leave this question up (can't mark the comment as answer anyways)
Perhaps I'm missing something here, but why not simply define your type as:
type Foo<'InputType> = {
Function: ('InputType -> int)
}
Or more generic:
type Foo<'InputType, 'OutputType> = {
Function: ('InputType -> 'OutputType)
}
Edit: Ok, I see the problem.
So to use Fyodors solution, do something like this:
type Foo<'InputType> = {
Function: ('InputType -> int)
}
let add a b = a + b
let myFunction = {
Function = (fun (a,b) -> add a b)
}
Something along these lines might work for you, although you should be careful about not loosing the general picture. The branching may explode if there is a lot of complexity in your data model.
module FunctionTests
//define function types templates
type F1<'a> = 'a -> int
type F2<'a, 'b> = 'a -> 'b -> int
type F3<'a, 'b, 'c> = 'a -> 'b -> 'c -> int
type F4<'a, 'b, 'c, 'd> = 'a -> 'b -> 'c -> 'd -> int
//define actual functions
let f1 : F1<string> = fun x ->
printf "calling f1: %s\n" x
1
let f2 : F2<string, string> = fun x y ->
printf "calling f2: %s; %s\n" x y
2
let f3 : F3<string, string, int> = fun x y z ->
printf "calling f2: %s; %s; %d\n" x y z
3
let f4 : F4<string, string, int, int> = fun x y z v ->
printf "calling f2: %s; %s; %d; %d\n" x y z v
4
//define DU limiting to a subset of functions
type FunctionChooser =
| FF1 of F1<string>
| FF2 of F2<string, string>
| FF3 of F3<string, string, int>
| FF4 of F4<string, string, int, int>
//define a record with the DU
type FunctionRec = {Function : FunctionChooser}
//testing harness
let callFunction (functiondefs : FunctionRec) data otherdata intparam1 intparam2 =
match functiondefs.Function with
| FF1 fn -> fn data
| FF2 fn -> fn data otherdata
| FF3 fn -> fn data otherdata intparam1
| FF4 fn -> fn data otherdata intparam1 intparam2
//tests
let res1 = callFunction {Function=FF1 f1} "somedata" "otherdata" 13 14
let res2 = callFunction {Function=FF2 f2} "somedata" "otherdata" 13 14
let res3 = callFunction {Function=FF3 f3} "somedata" "otherdata" 13 14
let res4 = callFunction {Function=FF4 f4} "somedata" "otherdata" 13 14
In the F# core libraries there are functions whose signature seemingly changes based on the parameter at compile-time:
> sprintf "Hello %i" ;;
val it : (int -> string) = <fun:it#1>
> sprintf "Hello %s" ;;
val it : (string -> string) = <fun:it#2-1>
Is it possible to implement my own functions that have this property?
For example, could I design a function that matches strings with variable components:
matchPath "/products/:string/:string" (fun (category : string) (sku : string) -> ())
matchPath "/tickets/:int" (fun (id : int) -> ())
Ideally, I would like to do avoid dynamic casts.
There are two relevant F# features that make it possible to do something like this.
Printf format strings. The compiler handles format strings like "hi %s" in a special way. They are not limited just to printf and it's possible to use those in your library in a somewhat different way. This does not let you change the syntax, but if you were happy to specify your paths using e.g. "/products/%s/%d", then you could use this. The Giraffe library defines routef function, which uses this trick for request routing:
let webApp =
choose [
routef "/foo/%s/%s/%i" fooHandler
routef "/bar/%O" (fun guid -> text (guid.ToString()))
]
Type providers. Another option is to use F# type providers. With parameterized type providers, you can write a type that is parameterized by a literal string and has members with types that are generated by some F# code you write based on the literal string parameter. An example is the Regex type provider:
type TempRegex = Regex< #"^(?<Temperature>[\d\.]+)\s*°C$", noMethodPrefix = true >
TempRegex().Match("21.3°C").Temperature.TryValue
Here, the regular expression on the first line is static parameter of the Regex type provider. The type provider generates a Match method which returns an object with properties like Temperature that are based on the literal string. You would likely be able to use this and write something like:
MatchPath<"/products/:category/:sku">.Match(fun r ->
printfn "Got category %s and sku %s" r.Category r.Sku)
I tweaked your example so that r is an object with properties that have names matching to those in the string, but you could use a lambda with multiple parameters too. Although, if you wanted to specify types of those matches, you might need a fancier syntax like "/product/[category:int]/[sku:string]" - this is just a string you have to parse in the type provider, so it's completely up to you.
1st: Tomas's answer is the right answer.
But ... I had the same question.
And while I could understand it conceptually as "it has to be 'the string format thing' or 'the provider stuff'"
I could not tell my self that I got until I tried an implementation
... And it took me a bit .
I used FSharp.Core's printfs and Giraffe's FormatExpressions.fs as guidelines
And came up with this naive gist/implementation, inspired by Giraffe FormatExpressions.fs
BTW The trick is in this bit of magic fun (format: PrintfFormat<_, _, _, _, 'T>) (handle: 'T -> 'R)
open System.Text.RegularExpressions
// convert format pattern to Regex Pattern
let rec toRegexPattern =
function
| '%' :: c :: tail ->
match c with
| 'i' ->
let x, rest = toRegexPattern tail
"(\d+)" + x, rest
| 's' ->
let x, rest = toRegexPattern tail
"(\w+)" + x, rest
| x ->
failwithf "'%%%c' is Not Implemented\n" x
| c :: tail ->
let x, rest = toRegexPattern tail
let r = c.ToString() |> Regex.Escape
r + x, rest
| [] -> "", []
// Handler Factory
let inline Handler (format: PrintfFormat<_, _, _, _, 'T>) (handle: 'T -> string) (decode: string list -> 'T) =
format.Value.ToCharArray()
|> List.ofArray
|> toRegexPattern
|> fst, handle, decode
// Active Patterns
let (|RegexMatch|_|) pattern input =
let m = Regex.Match(input, pattern)
if m.Success then
let values =
[ for g in Regex(pattern).Match(input).Groups do
if g.Success && g.Name <> "0" then yield g.Value ]
Some values
else
None
let getPattern (pattern, _, _) = pattern
let gethandler (_, handle, _) = handle
let getDecoder (_, _, decode) = decode
let Router path =
let route1 =
Handler "/xyz/%s/%i"
(fun (category, id) ->
// process request
sprintf "handled: route1: %s/%i" category id)
(fun values ->
// convert matches
values |> List.item 0,
values
|> List.item 1
|> int32)
let route2 =
Handler "/xyz/%i"
(fun (id) -> sprintf "handled: route2: id: %i" id) // handle
(fun values -> values|> List.head |> int32) // decode
// Router
(match path with
| RegexMatch (getPattern route2) values ->
values
|> getDecoder route2
|> gethandler route2
| RegexMatch (getPattern route1) values ->
values
|> getDecoder route1
|> gethandler route1
| _ -> failwith "No Match")
|> printf "routed: %A\n"
let main argv =
try
let arg = argv |> Array.skip 1 |> Array.head
Router arg
0 // return an integer exit code
with
| Failure msg ->
eprintf "Error: %s\n" msg
-1
When I'm working in the F# REPL fsharpi whenever I enter a new function the signature is printed after I've entered them:
> let foo x = x;;
val foo : x:'a -> 'a
Is there a way to retrieve this as a string? The reason I'm asking is that I'm using IfSharp for Jupyter notebooks which doesn't display the signatures, but I'd like to be able to show the types of functions for demonstration purposes.
I've messed around a bit but can't get anything useful, I've tried:
let foo x = (x, x)
printfn "%A" (foo.GetType())
printfn "%A" foo
But this isn't quite what I need:
FSI_0013+clo#3-1
<fun:it#5-2>
Is it possible to access this at all?
AFAIK, there's no function in FSharp.Core for getting a type's string representation as it would appear to the compiler (though maybe there's something in FSharp.Compiler.Services -- I haven't checked). Here's a small function that works for most simple uses:
open System
let (|TFunc|_|) (typ: Type) =
if typ.IsGenericType && typ.GetGenericTypeDefinition () = typeof<int->int>.GetGenericTypeDefinition () then
match typ.GetGenericArguments() with
| [|targ1; targ2|] -> Some (targ1, targ2)
| _ -> None
else
None
let rec typeStr (typ: Type) =
match typ with
| TFunc (TFunc(_, _) as tfunc, t) -> sprintf "(%s) -> %s" (typeStr tfunc) (typeStr t)
| TFunc (t1, t2) -> sprintf "%s -> %s" (typeStr t1) (typeStr t2)
| typ when typ = typeof<int> -> "int"
| typ when typ = typeof<string> -> "string"
| typ when typ.IsGenericParameter -> sprintf "'%s" (string typ)
| typ -> string typ
typeStr typeof<(string -> (string -> int) -> int) -> int>
// val it: string = "string -> (string -> int) -> int"
typeStr (typeof<int->int>.GetGenericTypeDefinition())
// val it: string = "'T -> 'TResult"
You can easily write a function on top of this to use typeStr on a value's type:
let valTypeString x = typStr (x.GetType ())
You can analyze types representing F# functions, with the help of the Microsoft.FSharp.Reflection namespace. There is the caveat that generic function arguments default to System.Object, and that other F# types which may form incomplete patterns (e.g. union cases, records) are not included.
open Microsoft.FSharp.Reflection
let funString o =
let rec loop nested t =
if FSharpType.IsTuple t then
FSharpType.GetTupleElements t
|> Array.map (loop true)
|> String.concat " * "
elif FSharpType.IsFunction t then
let fs = if nested then sprintf "(%s -> %s)" else sprintf "%s -> %s"
let domain, range = FSharpType.GetFunctionElements t
fs (loop true domain) (loop false range)
else
t.FullName
loop false (o.GetType())
let foo x = x
funString foo
// val it : string = "System.Object -> System.Object"
I am trying to express the Church encoding of the Free monad in F#. Free is specialized to a particular functor, Effect.
I am able to write both return_ : 'T -> Free<'T> and bind: ('T -> Free<'U>) -> Free<'T> -> Free<'U> without any problems.
A sketch of my implementation is given below.
type Effect<'T>
= GetStr of (string -> 'T)
| PutStr of string * 'T
module Effect =
let map (f: 'a -> 'b) : Effect<'a> -> Effect<'b> = function
| GetStr k ->
GetStr(f << k)
| PutStr (s,t) ->
PutStr(s, f t)
type Free<'T> =
abstract Apply : ('T -> 'R) -> (Effect<'R> -> 'R) -> 'R
module Free =
let inline runFree (f:Free<'T>) (kp: 'T -> 'R) (kf: Effect<'R> -> 'R) : 'R =
f.Apply kp kf
let return_ (x: 'a) : Free<'a> =
{ new Free<'a>
with
member __.Apply kp _ =
kp x
}
let bind (f: 'a -> Free<'b>) (m: Free<'a>) : Free<'b> =
{ new Free<'b>
with
member __.Apply kp kf =
runFree m
(fun a ->
runFree (f a) kp kf
)
kf
}
When I try to write an interpreter for this encoding, I hit a problem.
Given the following code:
module Interpret =
let interpretEffect = function
| GetStr k ->
let s = System.Console.ReadLine()
(k s , String.length s)
| PutStr(s,t) ->
do System.Console.WriteLine s
(t , 0)
let rec interpret (f: Free<string * int>) =
Free.runFree
f
(fun (str,len) -> (str,len))
(fun (a: Effect<Free<string*int>>) ->
let (b,n) = interpretEffect a
let (c,n') = interpret b
(c, n + n')
)
I get a type error in the third argument to Free.runFree within the interpret function:
...
(fun (a: Effect<Free<string*int>>) ->
^^^^^^^^^^^^^^^^^^ ------ Expecting a Effect<string * int> but given a Effect<Free<string*int>>
I understand why this is happening (the result type of the first function determines 'R === string*int) and suspect that can be solved using a rank-2 function (which can be encoded in F# e.g. http://eiriktsarpalis.github.io/typeshape/#/33) but I am not sure how to apply it.
Any pointers would be much appreciated.
Michael
You do not need to do anything there, the compiler suggested type is in fact correct (and in line with the type of runFree).
It seems that what you're thinking of there is Scott encoding (ripped from this Haskell question):
runFree :: Functor f => (a -> r) -> (f (F f a) -> r) -> F f a -> r
where F f a would be your Effect-specialised Free<'a>, and f (F f a) would be Effect<Free<'a>>, which is what you're trying to use.
Whereas Church encoding would be:
runFree :: Functor f => (a -> r) -> (f r -> r) -> F f a -> r
where f r is Effect<'a> - thus making it easier to express in F# (which is why I assume you're using it in the first place.
This is what I had for interpret:
let rec interpret (f: Free<string * int>) =
Free.runFree
f
(fun (str,len) -> (str,len))
(fun (a: Effect<_>) ->
let (b,n) = interpretEffect a
let (c,n') = interpret (Free.pureF b)
(c, n + n')
)
where pureF is
let pureF (x: 'a) : Free<'a> =
{ new Free<'a> with member __.Apply kp _ = kp x }
i.e. your return_ function.
I think defining the corresponding freeF function would clear some things (like why is Effect<'a> a functor - you're not making use of this fact anywhere in the code you pasted).
I'm programming binary arithmetic program using F#. I don't think my code was wrong but type error occurred.
Please examine my code and tell me what is wrong.
let carry a b c = if a then b||c else b&&c
let sum a b c = (if c then (a=b) else not (a=b))
let rec addc cin (l1:bool list) (l2:bool list) =
if l2.Length>0 then sum(cin,l1.Head,l2.Head)::addc(carry cin,l1.Head,l2.Head), l1.Tail, l2.Tail) else l1
The error message:
if l2.Length>0 then
sum(cin,l1.Head,l2.Head)::addc(carry(cin,l1.Head,l2.Head),l1.Tail,l2.Tail)
else l1
--------------------------------------------------^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
stdin(173,51): error FS0001: This expression was expected to have type
('a * bool * bool -> bool -> bool) list but here has type
bool list -> bool list -> ('a * bool * bool -> bool -> bool) list
Your brackets and thus your syntax is incorrect and so the meaning of the parameters and the functions is not as intended (for example when calling the sum function you are calling it with one tuple parameter and not with three parameters). Adjusting the brackets corrects the problem and then the code compiles as expected:
let carry a b c = if a then b||c else b&&c
let sum a b c = (if c then (a=b) else not (a=b))
let rec addc cin (l1:bool list) (l2:bool list) =
if l2.Length > 0 then
(sum cin l1.Head l2.Head) :: (addc (carry cin l1.Head l2.Head) l1.Tail l2.Tail)
else
l1
val addc : cin:bool -> l1:bool list -> l2:bool list -> bool list
And a call to addc works as expected:
printfn "%A" (addc true [true;true;false] [false;false;false])
Have a look as this SO post - F# function calling syntax confusion - it explains functions, function calling and tuples in F#.
Your functions 'carry' and 'sum' do not take tuples, so 'addc' can be rewritten to
let carry a b c = if a then b||c else b&&c
let sum a b c = if c then a=b else not (a=b)
let rec addc cin (l1:bool list) (l2:bool list) =
if l2.Length>0
then sum cin l1.Head l2.Head :: addc (carry cin l1.Head l2.Head) l1.Tail l2.Tail
else l1
Compiles to
val carry : a:bool -> b:bool -> c:bool -> bool
val sum : a:'a -> b:'a -> c:bool -> bool when 'a : equality
val addc : cin:bool -> l1:bool list -> l2:bool list -> bool list