I have this method that takes in a list and turns it into a bytecode string. It works the way I expect; however, I get one trailing space that I do not want. Question: how do I get rid of this last trailing 0?
Input: byteCode [SC 10; SC 2; SAdd; SC 32; SC 4; SC 5; SAdd; SMul; SAdd]
let rec byteCode (l : sInstr list) : string =
match l with
| [] -> ""
| (SC n :: l) -> "0 " + string n + " " + byteCode l
| (SAdd :: l) -> "1 " + byteCode l
| (SSub :: l) -> "2 " + byteCode l
| (SMul :: l) -> "3 " + byteCode l
| (SNeg :: l) -> "4 " + byteCode l
| (SLess :: l) -> "5 " + byteCode l
| (SIfze n :: l) -> "6 " + string n + " " + byteCode l
| (SJump n :: l) -> "7 " + string n + " " + byteCode l
This probably won't compile because I didn't give my entire program.
This returns: "0 10 0 2 1 0 32 0 4 0 5 1 3 1 "
I expect: "0 10 0 2 1 0 32 0 4 0 5 1 3 1"
Cases like this are usually signs that strings are concatenated in a way that is too naive. Consider first collecting all the individual components of your result and then calling the predefined String.concat function:
let byteCode (l : sInstr list) : string =
let rec byteCode' l =
match l with
| [] -> []
| (SC n :: l) -> "0" :: string n :: byteCode' l
| (SAdd :: l) -> "1" :: byteCode' l
| (SSub :: l) -> "2" :: byteCode' l
| (SMul :: l) -> "3" :: byteCode' l
| (SNeg :: l) -> "4" :: byteCode' l
| (SLess :: l) -> "5" :: byteCode' l
| (SIfze n :: l) -> "6" :: string n :: byteCode' l
| (SJump n :: l) -> "7" :: string n :: byteCode' l
l |> byteCode' |> String.concat " "
String.concat already only adds the separator string between the individual parts.
This is also much cleaner, because it keeps the implementation detail of the specific separator string out of your core logic and makes it much more easily replaceable - imagine the effort of simply changing it to two spaces in your function.
Alternatively, you can just use your existing function, and on the final resulting string call the .Trim() (or .TrimEnd()) method to remove (trailing) spaces.
You could avoid recursion in this manner:
let byteCode (l : sInstr list) : string =
let instrToString (bc : sInstr) : string =
match bc with
| (SC n) -> sprintf "0 %d" n
| (SAdd ) -> "1"
| (SSub ) -> "2"
| (SMul ) -> "3"
| (SNeg ) -> "4"
| (SLess ) -> "5"
| (SIfze n) -> sprintf "6 %d" n
| (SJump n) -> sprintf "7 %d" n
l |> List.map instrToString |> String.concat " "
Supposed sInstr is defined as:
type sInstr =
| SC of int
| SAdd
| SSub
| SMul
| SNeg
| SLess
| SIfze of int
| SJump of int
the functions to byteCodes and revserse could look like this:
let byteCode (l : sInstr list) : string =
let instrToString (bc : sInstr) =
(match bc with
| SC n -> [0; n]
| SAdd -> [1]
| SSub -> [2]
| SMul -> [3]
| SNeg -> [4]
| SLess -> [5]
| SIfze n -> [6; n]
| SJump n -> [7; n])
String.Join(" ", (l |> List.map instrToString |> List.fold (fun acc lst -> acc # lst) []))
let toInstr (bcString : string) : sInstr list =
let rec recToInstr bcList =
match bcList with
| [] -> []
| head :: tail ->
match head with
| "0" -> SC(Int32.Parse(tail.[0])) :: recToInstr (tail |> List.skip 1)
| "1" -> SAdd :: recToInstr tail
| "2" -> SSub :: recToInstr tail
| "3" -> SMul :: recToInstr tail
| "4" -> SNeg :: recToInstr tail
| "5" -> SLess :: recToInstr tail
| "6" -> SIfze(Int32.Parse(tail.[0])) :: recToInstr (tail |> List.skip 1)
| "7" -> SJump(Int32.Parse(tail.[0])) :: recToInstr (tail |> List.skip 1)
| _ -> []
recToInstr (bcString.Split(' ') |> Array.toList)
Related
I'm trying to convert the following pattern matching function to a match expression:
let reverse ls =
let rec rev acc =
function
| h :: t -> rev (h :: acc) t
| [] -> acc
rev [] ls
When I attempt to convert to equivalent match expression type mismatch errors occur:
let reverse ls =
let rec rev acc =
match acc with
| h :: t -> rev (h :: acc) t
| [] -> acc
rev [] ls
The desired output for both is:
reverse [ 1; 2; 3 ]
// val it : int list = [3; 2; 1]
Your match expression is not equivalent. To get the equivalent of your function-based code, the function should look like this:
let rec rev acc x =
match x with
| h :: t -> rev (h :: acc) t
| [] -> acc
Note the extra parameter x - that's the difference. The function keyword is equivalent not to just match, but to a function that matches on its parameter. In other words, function ... is equivalent to fun x -> match x with ...
I need some help with my hometask: to express one function (sort) through others (smallest, delete, insert). If you know how, please, tell me, how I can do running my recursion cicle? it doing now only one step. maybe something like this: val4 -> head :: tail |> sort tail on line 25 (val4)?
let rec smallest = function
| x :: y :: tail when x <= y -> smallest (x :: tail)
| x :: y :: tail when x > y -> smallest (y :: tail)
| [x] -> Some x
| _ -> None
let rec delete (n, xs) =
match (n, xs) with
| (n, x :: xs) when n <> x -> x :: delete (n, xs)
| (n, x :: xs) when n = x -> xs
| (n, _) -> []
let rec insert (xs, n) =
match (xs, n) with
| ([x], n) when x < n -> [x]#[n]
| (x :: xs, n) when x < n -> x :: insert (xs, n)
| (x :: xs, n) when x >= n -> n :: x :: xs
| (_, _) -> []
let rec sort = function
| xs -> let val1 = smallest xs
let val2 = val1.[0]
let val3 = delete (val2, xs)
let val4 = insert (val3, val2)
val4
let res = sort [5; 4; 3; 2; 1; 1]
printfn "%A" res
This is sort of like insertion sort, but since you're always finding the smallest number in the whole list instead of the next highest number, it will recurse forever unless you skip whatever you've already found to be the smallest.
Furthermore, your insert and delete functions act not on the item index, but on equality to the value, so it won't be able to handle repeated numbers.
Keeping most of your original code the same, usually you have an inner recursive function to help you keep track of state. This is a common FP pattern.
let sort lst =
let size = lst |> List.length
let rec sort' xs = function
| index when index = size -> xs
| index ->
let val1 = smallest (xs |> List.skip index)
let val2 = val1.[0]
let val3 = delete (val2, xs)
let val4 = insert (val3, val2)
sort' val4 (index + 1)
sort' lst 0
let res = sort [5; 3; 2; 4; 1; ]
printfn "%A" res
Needless to say, this isn't correct or performant, and each iteration traverses the list multiple times. It probably runs in cubic time.
But keep learning!
I found it... I only had changed 4 & 5 lines above in the "smallest" on this: | [x] -> Some x
| _ -> None, when there was: | [x] -> [x]
| _ -> []
let rec sort = function
| xs -> match xs with
| head :: tail -> let val1 = smallest xs
match val1 with
| Some x -> let val2 = delete (x, xs)
let val3 = insert (val2, x)
let val4 = (fun list -> match list with head :: tail -> head :: sort tail | _ -> [])
val4 val3
| None -> []
| _ -> []
// let res = sort [5; 4; 3; 2; 1]
// printfn "%A" res
I am just starting out with F# so this might be a trivial question but I am not able to understand why the pattern matching in my code acts as it does.
Quick explanation of the code:
The func calcNextMatch should recurse a list and if 2 elements are equal they should be added together.
In the end the func should return a number that is the addition of all digits that has a match with the next digit in the list.
f.ex. [1;3;2;2;5] should return 4
Code:
let rec printList l =
match l with
| head :: tail -> printf "%d " head; printList tail
| [] -> printfn ""
let rec calcNextMatch list =
printList list
match list with
| [] -> 0
| _ :: tail ->
printList tail
let h = Seq.head list
let t = Seq.tryHead tail
printfn "h: %i" h
printfn "t: %O" t
match t with
| Some h ->
printfn "TAIL t: %i is equal to HEAD h: %i" t.Value h
printfn "Calculation is: %i" (t.Value + h)
(t.Value + h) + calcNextMatch tail
| _ -> calcNextMatch tail
let sequence = [ 1;3;2;2;5 ]
let run = calcNextMatch sequence
When I run this code the problem is that the pattern-matching
does not work as I expect it.
f.ex this print output from running the script.
h: 1
t: Some(3)
TAIL t: 3 is equal to HEAD h: 3
this means that F# has matched
match t with
| Some h ->
in a case where t = Some(3) and h = 1
which translates to
match 3 with
| Some 1 ->
and that I do not understand.
The print before the matching states the value of t and h to 3 and 1 but in the pattern-matching the value of h has change to 3
How is this possible?
You can only pattern match against constant literals, otherwise the value get bounded as if was a new let-binding.
In these cases what you do normally is to add a when condition:
match t with
| Some x when x = h ->
Also notice that you can use pattern match further to simplify your code, for instance here:
| _ :: tail ->
printList tail
let h = Seq.head list
You can write:
| h :: tail ->
printList tail
Also all this portion:
| _ :: tail ->
printList tail
let h = Seq.head list
let t = Seq.tryHead tail
printfn "h: %i" h
printfn "t: %O" t
match t with
| Some h ->
printfn "TAIL t: %i is equal to HEAD h: %i" t.Value h
printfn "Calculation is: %i" (t.Value + h)
(t.Value + h) + calcNextMatch tail
becomes:
| h :: tail ->
printList tail
//printfn "h: %i" h
//printfn "t: %O" t
match tail with
| t::_ when t = h ->
printfn "TAIL t: %i is equal to HEAD h: %i" t h
printfn "Calculation is: %i" (t + h)
(t + h) + calcNextMatch tail
And you can unify all matches in one, so your whole function becomes:
let rec calcNextMatch list =
printList list
match list with
| [] -> 0
| h::x::tail when x = h -> x + h + calcNextMatch (x::tail)
| _::tail -> calcNextMatch tail
Finally, when you're done with debugging, you can remove the prints and since the last parameter of your function is the one you match against, you can use the keyword function, also use an as pattern to avoid reconstructing the list:
let rec calcNextMatch = function
| [] -> 0
| h::((x::_) as tail) when x = h -> x + h + calcNextMatch tail
| _::tail -> calcNextMatch tail
I am talking about the zip operations in the context of heterogeneous lists. I am working on a lightly dependently typed language that uses them as tuples.
type T =
| S of string
| R of T list
let rec zip l =
let is_all_r_empty x = List.forall (function R [] -> true | _ -> false) x
let rec loop acc_total acc_head acc_tail x =
match x with
| S _ :: _ -> R l
| R [] :: ys ->
if List.isEmpty acc_head && is_all_r_empty ys then List.rev acc_total |> R
else R l
| R (x :: xs) :: ys -> loop acc_total (x :: acc_head) (R xs :: acc_tail) ys
| [] ->
match acc_tail with
| _ :: _ -> loop ((List.rev acc_head |> zip) :: acc_total) [] [] (List.rev acc_tail)
| _ -> List.rev acc_total |> R
loop [] [] [] l
let rec unzip l =
let transpose l =
let is_all_empty x = List.forall (function _ :: _ -> false | _ -> true) x
let rec loop acc_total acc_head acc_tail = function
| (x :: xs) :: ys -> loop acc_total (x :: acc_head) (xs :: acc_tail) ys
| [] :: ys ->
if List.isEmpty acc_head && is_all_empty ys then loop acc_total acc_head acc_tail ys
else l
| [] ->
match acc_tail with
| _ :: _ -> loop (List.rev acc_head :: acc_total) [] [] (List.rev acc_tail)
| _ -> List.rev acc_total
loop [] [] [] l
let is_all_r x = List.forall (function R _ -> true | _ -> false) x
match l with
| R x when is_all_r x -> List.map unzip x |> transpose |> List.map R
| R x -> x
| S _ -> failwith "Unzip called on S."
//let a = R [R [S "a"; S "t"]; R [S "b"; S "w"]; R [S "c"; S "e"]]
//let b = R [R [S "1"; S "4"]; R [S "5"; S "r"]; R [S "3"; S "6"]]
//let c = R [R [S "z"; S "v"]; R [S "x"; S "b"]; R [S "c"; S "2"]]
//
//let t3 = zip [a;b]
//let t4 = zip [t3;c]
//let u1 = unzip t4
//let r1 = u1 = [t3;c]
//let u2 = unzip t3
//let r2 = u2 = [a;b] // The above works fine on tuples with regular dimensions.
let a = R [R [S "q"; S "w"; S "e"]]
let b = R [R [S "a"; S "s"]; R [S "z"]; S "wqe"]
let ab = [a;b]
let t = zip ab
let t' = unzip t
ab = t' // This is false, but I would like the ziping and then unziping to be reversible if possible.
Zipping and unzipping in general can be expressed as a dimensional shift or a series of transposes. That is all these two functions are doing.
They behave well on regular tuples, but I would like zip+unzip to be isomorphic on irregular ones as well. My intuition is telling me that this would be asking too much of them though.
I need a second opinion here.
#r "../../packages/FsCheck.2.8.0/lib/net452/FsCheck.dll"
type T =
| S of string
| VV of T list
let transpose l on_fail on_succ =
let is_all_vv_empty x = List.forall (function VV [] -> true | _ -> false) x
let rec loop acc_total acc_head acc_tail = function
| VV [] :: ys ->
if List.isEmpty acc_head && is_all_vv_empty ys then
if List.isEmpty acc_total then failwith "Empty inputs in the inner dimension to transpose are invalid."
else List.rev acc_total |> on_succ
else on_fail ()
| VV (x :: xs) :: ys -> loop acc_total (x :: acc_head) (VV xs :: acc_tail) ys
| _ :: _ -> on_fail ()
| [] ->
match acc_tail with
| _ :: _ -> loop (VV (List.rev acc_head) :: acc_total) [] [] (List.rev acc_tail)
| _ -> List.rev acc_total |> on_succ
loop [] [] [] l
let rec zip l =
match l with
| _ :: _ -> transpose l (fun _ -> l) (List.map (function VV x -> zip x | x -> x)) |> VV
| _ -> failwith "Empty input to zip is invalid."
let rec unzip l =
let is_all_vv x = List.forall (function VV _ -> true | _ -> false) x
match l with
| VV x ->
match x with
| _ :: _ when is_all_vv x -> let t = List.map (unzip >> VV) x in transpose t (fun _ -> x) id
| _ :: _ -> x
| _ -> failwith "Empty inputs to unzip are invalid."
| S _ -> failwith "Unzip called on S."
open FsCheck
open System
let gen_t =
let mutable gen_t = None
let gen_s () = Gen.map S Arb.generate<string>
let gen_vv size = Gen.nonEmptyListOf (gen_t.Value size) |> Gen.map VV
gen_t <-
fun size ->
match size with
| 0 -> gen_s()
| _ when size > 0 -> Gen.oneof [gen_s (); gen_vv (size-1)]
| _ -> failwith "impossible"
|> Some
gen_t.Value
|> Gen.sized
let gen_t_list_irregular = Gen.nonEmptyListOf gen_t
let gen_t_list_regular = Gen.map2 List.replicate (Gen.choose(1,10)) gen_t
type MyGenerators =
static member Tuple() = Arb.fromGen gen_t
static member TupleList() = Arb.fromGen gen_t_list_regular
Arb.register<MyGenerators>()
let zip_and_unzip orig = zip orig |> unzip
let zip_and_unzip_eq_orig orig = zip_and_unzip orig = orig
// For regular tuples it passes with flying colors.
Check.One ({Config.Quick with EndSize = 10}, zip_and_unzip_eq_orig)
// I can't get it to be isomorphic for irregularly sized arrays as expected.
//let f x =
// let x' = zip x
// printfn "x'=%A" x'
// printfn "unzip x'=%A" (unzip x')
// printfn "zip_and_unzip_eq_orig x=%A" (zip_and_unzip_eq_orig x)
//
//f [VV [VV [S "12"; S "qwe"]; VV [S "d"]]; VV [VV [S ""; S "ug"]; VV [S ""]]]
No matter what, I try I cannot figure out how to make the pair isomorphic for irregularly sized tuples and I feel it is unlikely that anyone will tell me differently so I'll put the above attempt as an answer for now.
On the upside, based on the tests above, I am decently sure that it should be isomorphic for all regularly sizes tuples. I guess this should suffice. I've tightened the code up a little compared to the example I had in the question.
This irregular zipping and unzipping problem would make an interesting math puzzle.
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