Skip to content

Commit

Permalink
Transform match pattern to use let row bindings
Browse files Browse the repository at this point in the history
  • Loading branch information
FrankBro committed Jan 16, 2019
1 parent 89c45bf commit 862bd01
Showing 3 changed files with 35 additions and 32 deletions.
31 changes: 15 additions & 16 deletions Program.fs
Original file line number Diff line number Diff line change
@@ -91,10 +91,9 @@ let testTransform parse transform =

[<EntryPoint>]
let main argv =
// testTransform
// "let { a = { b = b } } = { a = { b = 1 } } in b"
// "let _var0 = { a = { b = 1 } } in let _var1 = _var0.a in let b = _var1.b in b"
// "let _var0 = { a = (:b 1) } in match _var0.a { :b b -> b }"
testTransform
"match x { { a = 1 } -> 1 }"
"match x { { a = _var0 } when _var0 = 1 -> (let _var0 = x.a in 1) }"

// let input = "let (a: int) = 1 in a"
// test input
@@ -111,17 +110,17 @@ let main argv =

// runRepl ()

[
"let yfact fact n ="
" if n > 0 then"
" n * fact(n-1)"
" else"
" 1"
"in"
"let fact = fix yfact in"
"print (fact 5)"
]
|> String.concat "\n"
|> testEmitter "10"
// [
// "let yfact fact n ="
// " if n > 0 then"
// " n * fact(n-1)"
// " else"
// " 1"
// "in"
// "let fact = fix yfact in"
// "print (fact 5)"
// ]
// |> String.concat "\n"
// |> testEmitter "10"

0 // return an integer exit code
6 changes: 3 additions & 3 deletions TestTransform.fs
Original file line number Diff line number Diff line change
@@ -102,16 +102,16 @@ let ``Fun record multiple fields`` () =
let ``Extract guards in record`` () =
testTransform
"match x { { a = 1 } -> 1 }"
"match x { { a = _var0 } when _var0 = 1 -> 1 }"
"match x { { a = _var0 } when _var0 = 1 -> (let _var0 = x.a in 1) }"

[<Fact>]
let ``Extract guards in variant`` () =
testTransform
"match x { :a 1 -> 1 }"
"match x { :a _var0 when _var0 = 1 -> 1 }"
"match x { :a _var0 when _var0 = 1 -> (match x { :a _var0 -> 1 }) }"

[<Fact>]
let ``Transform does not mess with functions`` () =
testTransform
"let add a b = a + b"
"let add a b = a + b"
"let add a b = a + b"
30 changes: 17 additions & 13 deletions Transform.fs
Original file line number Diff line number Diff line change
@@ -3,16 +3,6 @@ module Transform
open Error
open Expr

// Before
// let { a = 1 } = { a = 1 } in 1
// After
// let _var0 = { a = 1 } in let _var1 = _var0.a in if a = 1 then 1 else error "bad match"

// Before
// match a { :a 1 -> 1 }
// After
//

let currentId = ref 0

let nextId () =
@@ -107,10 +97,19 @@ let rec transformExpr expr =
EFun (EVar var, body)
| _ -> raise (genericError (InvalidPattern pattern))
| ELet (pattern, value, body) when isRowType pattern ->
let var = getNewVar ()
let var =
match value with
| EVar var -> var
| _ -> getNewVar ()
let body = transformRowBinding var body pattern
ELet (EVar var, value, body)
match value with
| EVar _ -> body
| _ -> ELet (EVar var, value, body)
| ECase (value, cases, oDefault) ->
let var =
match value with
| EVar name -> name
| _ -> getNewVar ()
let fixedCases =
cases
|> List.map (fun (pattern, body, oGuard) ->
@@ -129,9 +128,14 @@ let rec transformExpr expr =
EBinOp (state, BinOp.And, guard)
)
|> Some
let body =
ELet (pattern, EVar var, body)
|> transformExpr
pattern, body, oGuard
)
ECase (value, fixedCases, oDefault)
match value with
| EVar name -> ECase (value, fixedCases, oDefault)
| _ -> ELet (EVar var, value, ECase (EVar var, fixedCases, oDefault))
| _ -> expr

let transform expr =

0 comments on commit 862bd01

Please sign in to comment.