How to guard with DateTime.TryParseExact (and get the parsed value if possible)? The following code doesn't work.
[<EntryPoint>]
let main args =
let argList = args |> List.ofSeq
match argList with
| "aaa" :: [] -> aaa.main "aaa"
| "bbb" :: [] -> bbb.main "bbb"
| "ccc" :: yyyymm :: [] when DateTime.TryParseExact
(yyyymm, "yyyyMM", CultureInfo.InvariantCulture, DateTimeStyles.None)->
ccc.main "ccc" yyyymm
You can use a mutable:
let mutable dt = Unchecked.defaultof<_>
match argList with
| "ccc" :: yyyymm :: [] when
DateTime.TryParseExact(yyyymm,
"yyyyMM",
CultureInfo.InvariantCulture,
DateTimeStyles.None,
&dt) -> ...
But an active pattern makes the match much clearer:
let (|DateTimeExact|_|) (format: string) s =
match DateTime.TryParseExact(s, format, CultureInfo.InvariantCulture, DateTimeStyles.None) with
| true, d -> Some d
| _ -> None
match argList with
| "ccc" :: DateTimeExact "yyyyMM" yyyymm :: [] -> ...
Related
I have the following types:
type Foo = { Name : string}
type Bar = {Name : string}
And I have the following Quoted expression:
<# fun (x : Foo) -> x.Name = "1" #>
Basically from this I would like to generate another quoted expression as:
<# fun (x : Bar) -> x.Name = "1" #>
How can I do this?
OK I got the following solution :
let subst expression newType =
let newVar name = Var.Global(name,newType)
let rec substituteExpr expression =
match expression with
| Call(Some (ShapeVar var),mi,other) ->
Expr.Call(Expr.Var(newVar var.Name), newType.GetMethod(mi.Name),other)
| PropertyGet (Some (ShapeVar var) ,pi, _) ->
Expr.PropertyGet(Expr.Var( newVar var.Name), newType.GetProperty(pi.Name),[])
| ShapeVar var -> Expr.Var <| newVar var.Name
| ShapeLambda (var, expr) ->
Expr.Lambda (newVar var.Name, substituteExpr expr)
| ShapeCombination(shapeComboObject, exprList) ->
RebuildShapeCombination(shapeComboObject, List.map substituteExpr exprList)
substituteExpr expression
then I can do
let f = <# fun (x : Foo) -> x.Name = "1" #>
let transformed = subst f typeof<Bar>
let typedExpression: Expr<Bar -> bool> = downcast <# %%transformed #>
I would like to extend the W algorithm to the inference of tuples and lists in F#, a priori, there are only two rules to add, which I did, however, the result is partially bad.
Indeed, if I test a code like these:
test = (8, "Hello", 0.3) -- test :: (TInt, TString, TFloat)
id :: a -> a
id x = x -- id :: a -> a
foo = id 8 -- foo :: TInt
it works, on the other hand, as detailed in the examples below, a code like this one will not work:
makePair = (\x -> (x, x)) -- makePair :: a -> (a, a)
pair = makePair 7
and pair will be inferred as (a, a) instead of (TInt, TInt).
Same for the lists.
I used this paper to write my type checker.
I really don't understand what's jamming.
Here is the minimum functional program used for these examples:
Inference.fs
module Typechecker
type Identifier = string
and Expr =
| Var of Identifier
| Lambda of Identifier * Expr
| Apply of Expr * Expr
| Let of Identifier * Expr * Expr
| Literal of Literal
| Tuple of Expr list
| List of Expr list
and Literal =
| Int of int
| Float of float
| String of string
and Statement =
| Signature of Identifier * Type
| Declaration of Identifier * Expr
and Type =
| TVar of Identifier
| TInt
| TFloat
| TString
| TArrow of Type * Type
| TTuple of Type list
| TList of Type
type Program = Program of Statement list
type Scheme = Scheme of string list * Type
and TypeEnv = Map<Identifier, Scheme>
and Subst = Map<string, Type>
type Env =
{ mutable _functions: Function list }
with
member this.containsFunction name =
this._functions |> List.exists (fun f -> f._name = name)
member this.getFunction name =
this._functions
|> List.find (fun (f: Function) -> f._name = name)
member this.getFunctionType name =
(this.getFunction name)._type
member this.hasFunctionImplementation name =
if this.containsFunction name
then (this.getFunction name)._value.IsSome
else false
member this.getFunctionValue name =
(this.getFunction name)._value.Value
/// Updates the value of a function in the environment
member this.updateFunction_value name value =
(this.getFunction name)._value <- Some value
this
/// Updates the type of a function in the environment
member this.updateFunction_type name ty =
(this.getFunction name)._type <- ty
this
member this.addFunction name ty value =
{ _functions =
List.append
this._functions
[{ _name = name;
_type = ty;
_value = value }] }
and Function =
{ _name: Identifier;
mutable _type: Type;
mutable _value: Expr option }
and DataType =
{ _name: Identifier;
_isAlias: bool;
_constructors: Ctor list option
_alias: Type option }
and Ctor = Term of Identifier | Product of Type list
let newEnv = { _functions = [] }
module Type =
let rec ftv = function
| TInt -> Set.empty
| TFloat -> Set.empty
| TString -> Set.empty
| TVar name -> Set.singleton name
| TArrow(t1, t2) -> Set.union (ftv t1) (ftv t2)
| TTuple ts -> List.fold (fun acc t -> Set.union acc (ftv t)) Set.empty ts
| TList t -> Set.singleton (toString t)
and apply s t =
match t with
| TVar name ->
match Map.tryFind name s with
| Some t -> t
| None -> TVar name
| TArrow (t1, t2) ->
TArrow(apply s t1, apply s t2)
| TInt | TFloat | TString -> t
| _ -> t
and parens s =
sprintf "(%s)" s
and braces s =
sprintf "{ %s }" s
and toString t =
let rec parenType t' =
match t' with
| TArrow(_, _) -> parens (toString t')
| _ -> toString t'
match t with
| TVar name -> name
| TInt -> "Integer"
| TFloat -> "Float"
| TString -> "String"
| TArrow(t1, t2) ->
(parenType t1) + " -> " + (toString t2)
| TTuple ts -> sprintf "(%s)" (System.String.Join(", ", List.map toString ts))
| TList t -> sprintf "[%s]" (toString t)
module Scheme =
let rec ftv (scheme: Scheme) =
match scheme with
| Scheme(variables, t) ->
Set.difference(Type.ftv t) (Set.ofList variables)
and apply (s: Subst) (scheme: Scheme) =
match scheme with
| Scheme(variables, t) ->
let newSubst = List.foldBack (fun key currentSubst -> Map.remove key currentSubst) variables s
let newType = Type.apply newSubst t
Scheme(variables, newType)
module TypeEnv =
let rec remove (env: TypeEnv) (var: Identifier) =
Map.remove var env
and ftv (typeEnv: TypeEnv) =
Seq.foldBack (fun (KeyValue(_, v)) state ->
Set.union state (Scheme.ftv v)) typeEnv Set.empty
and apply (s: Subst) (env: TypeEnv) =
Map.map (fun _ value -> Scheme.apply s value) env
module Subst =
let compose s1 s2 =
Map.union (Map.map (fun _ (v: Type) -> Type.apply s1 v) s2) s1
let rec generalize (env: TypeEnv) (t: Type) =
let variables =
Set.difference (Type.ftv t) (TypeEnv.ftv env)
|> Seq.toList
Scheme(variables, t)
and private currentId = ref 'a'
and nextId () =
let id = !currentId
currentId := (char ((int !currentId) + 1))
id
and resetId () = currentId := 'a'
and newTyVar () =
TVar(sprintf "%c" (nextId ()))
and instantiate (ts: Scheme) =
match ts with
| Scheme(variables, t) ->
let nvars = variables |> List.map (fun name -> newTyVar ())
let s = List.zip variables nvars |> Map.ofList
Type.apply s t
and varBind a t =
match t with
| TVar name when name = a -> Map.empty
| _ when Set.contains a (Type.ftv t) ->
failwithf "Occur check fails: `%s` vs `%s`" a (Type.toString t)
| _ -> Map.singleton a t
and unify (t1: Type) (t2: Type) : Subst =
match t1, t2 with
| TVar a, t | t, TVar a -> varBind a t
| TInt, TInt -> Map.empty
| TFloat, TFloat -> Map.empty
| TString, TString -> Map.empty
| TArrow(l, r), TArrow(l', r') ->
let s1 = unify l l'
let s2 = unify (Type.apply s1 r) (Type.apply s1 r')
Subst.compose s2 s1
| TTuple ts, TTuple ts' ->
if ts.Length <> ts'.Length
then failwithf "Types do not unify: `%s` vs `%s`" (Type.toString t1) (Type.toString t2)
else List.fold Subst.compose Map.empty (List.map2 unify ts ts')
| TList t, TList t' ->
unify t t'
| _ -> failwithf "Types do not unify: `%s` vs `%s`" (Type.toString t1) (Type.toString t2)
and tiLit = function
| Literal.Int _ -> Type.TInt
| Literal.Float _ -> Type.TFloat
| Literal.String _ -> Type.TString
and tiExpr (env: TypeEnv) (exp: Expr) : Subst * Type =
match exp with
| Var name ->
match Map.tryFind name env with
| Some sigma ->
let t = instantiate sigma
(Map.empty, t)
| None -> failwithf "Unbound variable: `%s`" name
| Literal lit -> (Map.empty, tiLit lit)
| Let(id, expr, in') ->
let s1, t1 = tiExpr env expr
let env1 = TypeEnv.remove env id
let scheme = generalize (TypeEnv.apply s1 env) t1
let env2 = Map.add id scheme env1
let s2, t2 = tiExpr (TypeEnv.apply s1 env2) in'
(Subst.compose s2 s1, t2)
| Lambda(id, value) ->
let tv = newTyVar ()
let env1 = TypeEnv.remove env id
let env2 = Map.union env1 (Map.singleton id (Scheme([], tv)))
let s1, t1 = tiExpr env2 value
(s1, TArrow(Type.apply s1 tv, t1))
| Tuple values ->
(Map.empty, TTuple(List.map (fun v -> snd (tiExpr env v)) values))
| List ts ->
let tv = newTyVar ()
if ts.IsEmpty
then (Map.empty, TList tv)
else
let _, t1 = tiExpr env ts.[0]
if List.forall (fun t -> snd (tiExpr env t) = t1) ts
then (Map.empty, TList t1)
else failwith "Not all items in the list are of the same type"
| Apply(e1, e2) ->
let s1, t1 = tiExpr env e1
let s2, t2 = tiExpr (TypeEnv.apply s1 env) e2
let tv = newTyVar ()
let s3 = unify (Type.apply s2 t1) (TArrow(t2, tv))
(Subst.compose (Subst.compose s3 s2) s1, Type.apply s3 tv)
and expression_typeInference env exp =
let s, t = tiExpr env exp
Type.apply s t
and updateExprEnv (env: Env) =
let mutable env' = Map.empty
List.iter
(fun (f: Function) ->
env' <- env'.Add(f._name, Scheme([f._name], f._type))
) env._functions
env'
let rec public statement_typecheck (env: Env) stmt =
let exprEnv = updateExprEnv env
match stmt with
| Signature(id, dastType) ->
typecheck_signature env id dastType
| Declaration(id, value) ->
typecheck_decl env id value exprEnv
and private typecheck_signature (env: Env) id ty =
if env.hasFunctionImplementation id
then failwithf "The type of a function cannot be defined after its implementation (`%s`)" id
else env.addFunction id ty None
and private typecheck_decl (env: Env) id value exprEnv =
let _, t_exp = tiExpr exprEnv value
if env.containsFunction id
then if env.hasFunctionImplementation id
then failwithf "Already declared function: `%s`" id
else
let t_sgn = (env.getFunction id)._type
let unapp = try (Type.apply ((unify t_sgn t_exp)) t_exp)
|> Ok with exn -> failwithf "%s" exn.Message
if match unapp with Result.Ok _ -> true
then env.updateFunction_value id value
else failwithf "The signature of `%s` is different than the type of its value\n (`%s` vs `%s`)"
id (Type.toString t_sgn) (Type.toString t_exp)
else env.addFunction id t_exp (Some value)
let typecheck_document (document: Program) =
let mutable docenv = newEnv
match document with Program stmts ->
List.iter (fun stmt -> docenv <- statement_typecheck docenv stmt) stmts
docenv
Main.fs
module Main
open Inference
[<EntryPoint>]
let main _ =
let test1 =
[Declaration("makePair", Lambda("x", Tuple([Var "x"; Var "x"]))); // makePair = (\x -> (x, x))
Declaration("pair", Apply(Var "makePair", Literal (Int 7)))] // pair = makePair 7
let infer1 = typecheck_document (Program test1)
printfn "Env1: %A" infer1
let test2 =
[Signature("id", TArrow(TVar "a", TVar "a")); // id :: a -> a
Declaration("id", Lambda("x", Var "x")) // id x = x
Declaration("foo", Apply(Var "id", Literal (Int 7)))] // foo = id 7
let infer2 = typecheck_document (Program test2)
printfn "Env2: %A" infer2
0
Here is the output:
Env1: {_functions =
[{_name = "makePair";
_type = TArrow (TVar "a",TTuple [TVar "a"; TVar "a"]);
_value = Some (Lambda ("x",Tuple [Var "x"; Var "x"]));};
{_name = "pair";
_type = TTuple [TVar "a"; TVar "a"];
_value = Some (Apply (Var "makePair",Literal (Int 7)));}];}
Env2: {_functions =
[{_name = "id";
_type = TArrow (TVar "a",TVar "a");
_value = Some (Lambda ("x",Var "x"));};
{_name = "test";
_type = TInt;
_value = Some (Apply (Var "id",Literal (Int 7)));}];}
So we can see that the inference works correctly for the first test, but not for the second (as shown above).
I would like to solve and understand this bug, and I thank you in advance for your help.
As far as I read in your code, it seems like you're missing a branch in apply.
Indeed, when t is a Tuple [], you're basically only returning it...which well will of course not work. :)
I suggest adding one branch to the match, with t as a Tuple types, with a map (\t -> apply s t) types (sorry, I don't know much F# syntax).
Hope it helps. :)
I wrote a predictive parser for a LL1 grammar. Each nonterminal A has a corresponding parseA method, which takes in a tokenlist, and returns the remainder of tokenlist and a parse tree.
I'm confused about which AST method to call in my parser. Is there a general approach to figuring this out?
This is my attempt:
Take for instance a subsection of my grammar:
expr -> t eprime
eprime -> PLUS t eprime | MINUS t eprime | ε
t -> t tprime
tprime -> TIMES f tprime | DIVIDE f tprime | ε
f -> LPAREN expr RPAREN | LITERAL | TRUE | FALSE | ID
I have four parse methods, one for each nonterminal.
let parseExpr tokenlist =
match tokenlist.head with
| "LPAREN" -> let t_expr tokenlist_t = next tokenlist |> parseExpr in
let e_expr tokenlist_e = parseEPrime tokenlist_t in
(tokenlist_e, Ast.Expression(t_expr, e_expr))
| "LITERAL" -> let t_expr tokenlist_t = next tokenlist |> parseExpr in
let e_expr tokenlist_e = parseEPrime tokenlist_t in
(tokenlist_e, Ast.Expression(t_expr, e_expr))
| "TRUE" -> let t_expr tokenlist_t = next tokenlist |> parseExpr in
let e_expr tokenlist_e = parseEPrime tokenlist_t in
(tokenlist_e, Ast.Expression(t_expr, e_expr))
| "FALSE" -> let t_expr tokenlist_t = next tokenlist |> parseExpr in
let e_expr tokenlist_e = parseEPrime tokenlist_t in
(tokenlist_e, Ast.Expression(t_expr, e_expr))
| "ID" -> let t_expr tokenlist_t = next tokenlist |> parseExpr in
let e_expr tokenlist_e = parseEPrime tokenlist_t in
(tokenlist_e, Ast.Expression(t_expr, e_expr))
let parseEPrime tokenlist =
match tokenlist with
| "PLUS" -> let expr_t tokenlist_t = next tokenlist |> parseT in
let expr_eprime tokenlist_e = parseEPrime tokenlist_t in
(tokenlist_e, Ast.Add(expr_t, expr_eprime))
| "MINUS" -> let expr_t tokenlist_t = next tokenlist |> parseT in
let expr_eprime tokenlist_e = parseEPrime tokenlist_t in
(tokenlist_e, Ast.Minus(expr_t, expr_eprime))
| "SEMI" -> (tokenlist, [])
| "RPAREN" -> (tokenlist, [])
| _ -> raise error
let parseT tokenlist =
match tokenlist.lookathead with
| "LPAREN" -> let expr_f tokenlist_f = parseF tokenlist in
let expr_tprime tokenlist_tprime = parseTprime tokenlist_f in
(tokenlist_tprime, Ast.F(expr_f, expr_tprime))
| "LITERAL" -> let expr_f tokenlist_f = parseF tokenlist in
let expr_tprime tokenlist_tprime = parseTprime tokenlist_f in
(tokenlist_tprime, Ast.Literal(expr_f, expr_tprime))
| "TRUE" -> let expr_f tokenlist_f = parseF tokenlist in
let expr_tprime tokenlist_tprime = parseTprime tokenlist_f in
(tokenlist_tprime, Ast.F(expr_f, expr_tprime))
| "FALSE" -> let expr_f tokenlist_f = parseF tokenlist in
let expr_tprime tokenlist_tprime = parseTprime tokenlist_f in
(tokenlist_tprime, Ast.F(expr_f, expr_tprime))
| "ID" -> let expr_f tokenlist_f = parseF tokenlist in
let expr_tprime tokenlist_tprime = parseTprime tokenlist_f in
(tokenlist_tprime, Ast.F(expr_f, expr_tprime))
| _-> raise error
let parseTprime tokenlist =
match tokenlist.lookathead with
| "TIMES" -> let expr_f tokenlist_f = next tokenlist |> parseF in
let expr_tprime tokenlist_tprime = parseTPrime tokenlist_f in
(tokenlist_tprime, Ast.Times(expr_f, expr_tprime))
| "DIVIDE" -> let expr_f tokenlist_f = next tokenlist |> parseF in
let expr_tprime tokenlist_tprime = parseTPrime tokenlist_f in
(tokenlist_tprime, Ast.Divide(expr_f, expr_tprime))
| "PLUS" -> (tokenlist, [])
| "MINUS" -> (tokenlist, [])
| "SEMI" -> (tokenlist, [])
| "RPAREN" -> (tokenlist, [])
| _ -> raise error
let parseF tokenlist =
match tokenlist.lookathead with
| "LPAREN" -> let expr tokenlist_expr = next tokenlist |> parseE in
match next tokenlist_expr with
| "RPAREN" -> (next tokenlist_expr, Ast.ExpressionParen(expr))
| "LITERAL" -> (next tokenlist, Ast.FLiteral)
| "TRUE" -> (next tokenlist, Ast.BoolLit)
| "FALSE" -> (next tokenlist, Ast.FBool)
| "ID" -> (next tokenlist, Ast.Id)
| _ -> raise error
As you can probably tell from my code, I wrote a type for every nonterminal, and then had a method for every production of that nonterminal.
(*expr -> T E* *)
type expr =
| Expression of t eprime
(*T -> F T*)
type t =
| F of f * tprime
(*E* -> + T E*
E* -> - T E*
E* -> ε *)
type eprime =
| Add of t eprime
| Minus of t eprime
| Eempty
(*T* -> TIMES F T*
T* -> / F T*
T* -> ε*)
type tprime =
| Divide of f * tprime
| Times of f * tprime
| TEmpty
(*F -> LPAREN E RPAREN
F -> Literal
F -> TRUE
F -> FALSE
F -> ID*)
type f =
| ExpressionParen of expr
| Literal of int
| BoolLit of bool
| Id of string
But I don't know my approach keeps too much unnecessary information than a AST would normally shake out (I imagine an AST to be a parse tree that shakes and rids itself of unnecessary leaves). So far, I've just left off the parentheses and semi colons. I'm afraid I'm leaving too much on by having type t, type f, type tprime, type eprime in my AST. But if I were to remove them, I wouldn't know how to write the type expr in my AST.
Given an AST defined as such:
type expr =
| Add of expr * expr
| Minus of expr * expr
| Times of expr * expr
| Divide of expr * expr
| IntLit of int
| BoolLit of bool
| Id of string
You can adjust your parse functions to return such an AST by making the Prime functions take the left operand as an argument like this:
let parseExpr tokens =
let (lhs, remainingTokens) = parseT tokens in
parseExprPrime lhs remainingTokens
let parseExprPrime lhs tokens = match tokenlist.lookahead with
| PLUS :: tokens ->
let (rhs, remainingTokens) = parseT (next tokens) in
parseExprPrime (Add (lhs, rhs)) remainingTokens
| MINUS :: tokens ->
let (rhs, remainingTokens) = parseT (next tokens) in
parseExprPrime (Minus (lhs, rhs)) remainingTokens
| tokens ->
lhs, tokens
parseT and parseTPrime would look the same (except with multiplication and division of course) and parseF would stay almost exactly as-is, except that Ast.ExpressionParen(expr) would just be expr because I've also removed the ExpressionParen case from the AST definition.
Note that it's not necessary to distinguish between legal and illegal tokens here. It's okay to just return lhs, tokens both for legal tokens like ; or ) and for illegal tokens. In the latter case, the illegal token will eventually detected by a calling parser - no need to detect the error in multiple places. The same is true for the expression rule: if tokens starts with an illegal token, that will be detected by parseF, so there's no need to check this here. Nor is there any need to repeat the same code four times, so you can just call parseT and parseExprPrime without even looking at the current token and those functions will take care of it.
As for whether simplifying the AST like this is worth it - let's consider a function eval: expr -> int as a case study (and let's ignore BoolLit and Id for that purpose). Using the original definition it would look like this:
let rec eval = function
| Expression (lhs, eprime) -> evalEPrime (evalT lhs) eprime
and evalEPrime lhsValue = function
| Add (rhs, rest) -> evalEPrime (lhsValue + evalT rhs) rest
| Minus (rhs, rest) -> evalEPrime (lhsValue - evalT rhs) rest
| Eempty -> lhsValue
and evalT = function
| T (lhs, tprime) -> evalTPrime (evalF lhs) tprime
and evalTPrime lhsValue = function
| Times (rhs, rest) -> evalTPrime (lhsValue * evalF rhs) rest
| Divide (rhs, rest) -> evalTPrime (lhsValue / evalF rhs) rest
| TEmpty -> lhsValue
and evalF = function
| ExpressionParen expr -> eval expr
| IntLit i -> i
Using the simplified defintiion it would instead be:
let rec eval = function
| Add (lhs, rhs) -> eval lhs + eval rhs
| Minus (lhs, rhs) -> eval lhs - eval rhs
| Times (lhs, rhs) -> eval lhs * eval rhs
| Divide (lhs, rhs) -> eval lhs / eval rhs
| IntLit i -> i
So I'd say the simplified version definitely improves working with the AST and I'd consider it worth it.
It seems true that if you have a type for every nonterminal you'll end up with tree that's more on the concrete side (similar to a parse tree) than the abstract side.
I don't know that this is so bad, it's still a good representation of the code.
One way to look at it is that your grammar is so simple and streamlined that there's not a lot of incidental punctuation that needs to be left out to make the tree more abstract.
You could probably unify the types for expressions and terms. In other words, you could use just one internal node type for your expression trees. Once the precedences have been sorted out in the parsing, both expressions and terms are a list of subexpressions with operators between them.
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)
I'm just wondering if there is a better way to write this code in F#:
let run (command : string) =
let words = command.Split [|','|]
match words.[0] with
| a when a .eignore "optionA" -> optionA words.[1] words.[2] words.[3]
| a when a .eignore "optionB" -> optionB words.[1] words.[2] words.[3] words.[4] words.[5]
| a when a .eignore "optionC" -> optionC words.[1] words.[2] words.[3] words.[4]
| a when a .eignore "optionD" -> optionD words.[1] words.[2] words.[3] words.[4]
| a when a .eignore "optionE" -> optionE words.[1] words.[2] words.[3]
| a when a .eignore "optionF" -> optionF words.[1] words.[2]
| a when a .eignore "optionG" -> optionG words.[1] words.[2] words.[3] words.[4]
| _ -> ()
I am new to F# and I feel that this statement is quite repetitive and could be done a fair bit better, but Im not really sure where to start.
Basically what it does is runs a command, with the command being the first part of the comma separated string, and the remaining being the inputs:
Example Input:
optionA,1,2,A,Test
Also .eignore is just a custom function for checking that the string is equal ignoring case.
You can do this by using composite pattern matching. You'll need an active pattern for the case-insensitive string comparison:
let (|EqIgnoreCase|_|) x y =
if String.Equals(x, y, StringComparison.OrdinalIgnoreCase)
then Some ()
else None
You can compose this EqIgnoreCase pattern into a standard cons pattern:
let run (command : string) =
let words = command.Split [|','|] |> Array.toList
match words with
| EqIgnoreCase "optionA" :: u :: v :: x :: _ -> optionA u v x
| EqIgnoreCase "optionB" :: u :: v :: x :: y :: z :: _ -> optionB u v x y z
| EqIgnoreCase "optionC" :: u :: v :: x :: y :: _ -> optionC u v x y
| EqIgnoreCase "optionD" :: u :: v :: x :: y :: _ -> optionD u v x y
| EqIgnoreCase "optionE" :: u :: v :: x :: _ -> optionE u v x
| EqIgnoreCase "optionF" :: u :: v :: _ -> optionF u v
| EqIgnoreCase "optionG" :: u :: v :: x :: y :: _ -> optionG u v x y
| _ -> ()
It's easiest to use a cons pattern instead of an array pattern, because that enables you to easily ignore the tail of the list using the wildcard pattern (_).
Here are a few function calls:
> run "optionA,1,2,A,Test";;
optionA 1 2 A
val it : unit = ()
> run "optionB,1,2,A,Test,Foo";;
optionB 1 2 A Test Foo
val it : unit = ()
> run "OPTIONA,1,2,A,Test";;
optionA 1 2 A
val it : unit = ()
> run "OPTIONA,1,2,A";;
optionA 1 2 A
val it : unit = ()
> run "OPTIONA,1,2";;
val it : unit = ()
Notice that the last line has no console output because the list of arguments is too short.
Seems like the most repetition comes from passing the arguments to your functions. The obvious solution is to make them accept a string array:
type Command = { name : string; action : string array -> unit }
Of course, you can add some validating fields like number of arguments etc. Next, let's make some accessors for new type:
let cmdName = function {name = n; action = _} -> n
let cmdAction = function {name = _; action = a} -> a
And implement case-insensitive string comparison:
let icmp a b = String.Compare(a, b, true) = 0
Now we're ready to implement the main function:
type Class() as __ =
member __.optionC(args : string array) = printfn "optionC!"
static member optionD(args : string array) = printfn "optionD"
let run (command : string) =
let words = command.Split [|','|]
[ { name = "optionA"; action = fun args -> printfn "%A" args }
{ name = "optionB"; action = fun _ -> printfn "optionB!" }
{ name = "optionC"; action = fun args -> (new Class()).optionC(args) }
{ name = "optionD"; action = Class.optionD } ]
|> List.tryFind(cmdName >> (icmp words.[0])) // [1]
|> Option.iter(cmdAction >> ((|>) words.[1..words.Length - 1]) // [2])
[1] We create the command list and try to find command with a name of first argument.
[2] Lastly, we pass all arguments to the action(optionA functions family effectively executing it).
Note that Option.iter will execute its payload only if the needed command was found.