first pattern matching steps

Test/Program.fs

@@ -0,0 +1,8 @@
+// Learn more about F# at http://fsharp.org
+
+open System
+
+[<EntryPoint>]
+let main argv =
+    printfn "Hello World from F#!"
+    0 // return an integer exit code

Test/Test.fsproj

@@ -0,0 +1,17 @@
+<Project Sdk="FSharp.NET.Sdk;Microsoft.NET.Sdk">
+
+  <PropertyGroup>
+    <OutputType>Exe</OutputType>
+    <TargetFramework>netcoreapp1.1</TargetFramework>
+  </PropertyGroup>
+
+  <ItemGroup>
+    <Compile Include="Program.fs" />
+  </ItemGroup>
+
+  <ItemGroup>
+    <PackageReference Include="FSharp.Core" Version="4.1.*" />
+    <PackageReference Include="FSharp.NET.Sdk" Version="1.0.*" PrivateAssets="All" />
+  </ItemGroup>
+
+</Project>

ce.erl

@@ -5,5 +5,5 @@
 ast(File) ->
     {ok, Bin} = file:read_file(File),
     {ok, Toks, _} = core_scan:string(binary_to_list(Bin)),
-    {pok, Ast} = core_parse:parse(Toks),
+    {ok, Ast} = core_parse:parse(Toks),
     Ast.

flatc/Program.fs

@@ -97,7 +97,7 @@ module Compiler =
         |> List.map (fun x -> x.FullName, x.FullType.TypeDefinition)
 
     let mkName (name : string) num =
-        if Char.IsLower name.[0] then
+        if Char.IsUpper name.[0] then
             sprintf "%s%i" name num
         else
             sprintf "_%s%i" name num
@@ -130,6 +130,9 @@ module Compiler =
     let modCall left right exps =
         cerl.ModCall ((left, right), exps)
 
+    let apply f args =
+        cerl.App (f, args)
+
     let lambda args expr =
         cerl.Lambda (args, expr)
 
@@ -146,8 +149,15 @@ module Compiler =
         function
         | "op_Multiply" -> Some "*"
         | "op_Addition" -> Some "+"
+        | "op_Subtraction" -> Some "-"
         | _ -> None
 
+    let (|Lit|_|) (o: obj) =
+        match o with
+        | :? int as i -> cerl.LInt i |> Some
+        | x -> None
+
+
     //TODO: should we consult the FSharpType as well?
     let mapConst (o : obj) =
         match o with
@@ -159,10 +169,39 @@ module Compiler =
         | Intr2Erl x ->
             let erlang = litAtom "erlang" |> constr
             let mul = litAtom x |> constr
-            let exprss, nm = foldNames nm processExpr exprs
-            modCall erlang mul exprss, nm
+            let args, nm = foldNames nm processExpr exprs
+            modCall erlang mul args, nm
+        | name -> //apply
+            let func = litAtom name |> constr
+            let args, nm = foldNames nm processExpr exprs
+            apply func args, nm
         | x ->  failwithf "not implemented %A" x
 
+    and processPat nm (expr : FSharpExpr) : (cerl.Pat * cerl.Guard * Map<string, int>) =
+        match expr with
+        | BasicPatterns.Call (_expr, f, _, _typeSig, [BasicPatterns.Value (_)
+                                                      BasicPatterns.Const (Lit cVal, _)])
+            when f.LogicalName = "op_Equality" ->
+            cerl.PLit cVal, cerl.Guard (litAtom "true" |> constr), nm
+            (* mapCall nm f expressions *)
+        (* | BasicPatterns.Const (o, t) -> *)
+        (*     mapConst o, nm *)
+        | x -> failwithf "not implemented %A" x
+
+    and processITEs d nm expr : (int * (cerl.Pat * cerl.Guard * Map<string, int>)) list =
+        [
+        match expr with
+        | BasicPatterns.IfThenElse(fi, BasicPatterns.DecisionTreeSuccess(idx, []), esle) ->
+            let pat, guard, nm' = processPat nm fi
+            yield idx, (pat, guard, nm')
+            // need to pass orig nm here as each branch need the same outer scope
+            yield! processITEs d nm esle
+        | BasicPatterns.DecisionTreeSuccess(idx, []) ->
+            // TODO PVar - need to pass it
+            yield idx, (cerl.PVar d, cerl.Guard (litAtom "true" |> constr), nm)
+        | x -> failwithf "processITE not impl %A" x ]
+
+
     and processExpr nm (expr : FSharpExpr) : (cerl.Exps * Map<string, int>) =
         let res, nmOut =
             match expr with
@@ -178,6 +217,25 @@ module Compiler =
                 let v', nm = safeVar true nm v.LogicalName
                 let next, nm = processExpr nm expr
                 mkLet v' ass next, nm
+            | BasicPatterns.DecisionTree (BasicPatterns.IfThenElse (iff, thenn, elsee) as e, l) as tree ->
+                printfn "tree %A" tree
+                // hacky way to get at the expr between 'match' and 'with'
+                let v, caseExpr, nm =
+                    match iff with
+                    | BasicPatterns.Call (_, _, _, _, [e1;_]) ->
+                        match processExpr nm e1 with
+                        | cerl.Exp (cerl.Constr (cerl.Var v)) as e, nm -> v, e, nm
+                        | x -> failwithf "caseExprinner not imp %A" x
+                    | x -> failwithf "caseExpr not imp %A" x
+
+                let ites = processITEs v nm e |> Map
+                let alts : List<cerl.Ann<cerl.Alt>> =
+                    l |> List.mapi (fun i (mfvs, e) ->
+                    let pat, grd, nm = ites.[i]
+                    // we can throw away nm now as have branched
+                    let e, _ = processExpr nm e
+                    cerl.Constr <| cerl.Alt (cerl.Pat pat, grd, e))
+                cerl.Case (caseExpr, alts), nm
             | x -> failwithf "not implemented %A" x
         constr res, nmOut
 

flatc/cerl.fs

@@ -8,6 +8,31 @@ module Util =
 
     let prtNl() = printf "\r\n"
 
+type Prt =
+    | Prt of (string * Prt) list
+    | Term
+    | Closing of string
+
+let t : Prt =
+    Prt ["module 'test' ['square'/1,", Prt ["'module_info'/0", Term
+                                            "'module_info'/1", Term]
+         "'square'/1", Prt ["fun (_core0) ->",
+                             Prt ["call 'erlang':'*'",
+                                   Prt ["(_core0, core0)", Term]]]
+         "end", Term]
+
+let rec printItem ((Indent ind) as i) (l, p) =
+    printf "%s%s" ind l
+    rend (i+4) p
+and rend i (prt : Prt) =
+    match prt with
+    | Prt items ->
+        for itm in items do
+            printf "%s" System.Environment.NewLine
+            printItem i itm
+    | Closing s -> printf "%s" s
+    | Term -> ()
+
 
 type Var = string
 
@@ -25,7 +50,7 @@ type Literal =
     | LAtom of Atom      // ^ atom literal
     | LNil              // ^ empty list
     with
-        static member prt indent lit =
+        static member prt (Indent indent) lit =
             match lit with
             | LChar c ->
                 sprintf "%s$%c'" indent c
@@ -55,22 +80,49 @@ and Pat =
     | PList of ExprList<Pat>         // ^ list pattern
     | PBinary of List<BitString<Pat>>  // ^ list of bitstring patterns
     | PAlias of Alias             // ^ alias pattern
+with
+    static member prt pat =
+        match pat with
+        | PVar v -> v
+        | PLit l -> Literal.prt 0 l
+        | PTuple tup ->
+            let pats = List.map Pat.prt tup
+            sprintf "{%s}" (String.concat "," pats)
+        | x -> failwithf "Pat.prt not impl %A" x
 
 and Alias = Alias of Var * Pat
 
+and Guard = Guard of Exps
+
 and Pats =
     | Pat of Pat    // ^ single pattern
     | Pats of List<Pat> // ^ list of patterns
+with
+    static member prt pats =
+        match pats with
+        | Pat p -> sprintf "<%s>" (Pat.prt p)
+        | pl -> failwithf "not impl %A" pl
 
-and Alt = Alt of  Pats * Guard * Exps
-
-and Guard = Guard of Exps
+and Alt = Alt of Pats * Guard * Exps
+with
+    static member prt ((Indent indent) as i) (Alt (pats, Guard guardExps, exps)) =
+        let pat = Pats.prt pats
+        let guard = Exps.prt 0 guardExps
+        let body = Exps.prt (i+4) exps
+        sprintf "%s%s when %s ->\r\n%s\r\n" indent pat guard body
 
 and TimeOut = TimeOut of Exps * Exps
 
 and Ann<'T> =
     | Constr of 'T      // ^ core erlang construct
     | Ann of 'T * List<Const> // ^ core erlang annotated construct
+(* with *)
+(*     static member prt indent a = *)
+(*         match a with *)
+(*         | Constr t -> *)
+(*             (^T : (static member prt : ^T -> int -> string) indent t) *)
+(*         | _ -> failwith "not imp;" *)
+            (* sprintf "%s'%s'/%i" indent name arity *)
 
 and Function = Function of Atom * int
 with
@@ -100,23 +152,39 @@ and Exp =
     with
     static member prt ((Indent indent) as i) expr =
         match expr with
-        | Var v -> v
+        | Var v -> sprintf "%s%s" indent v
         | Lit lit ->
-            Literal.prt indent lit
+            Literal.prt i lit
         | Lambda (vars, exps) ->
             let expsp = Exps.prt (i+4) exps
             let varsp = String.concat "," vars
             sprintf "%sfun (%s) ->\r\n%s" indent varsp expsp
+        | App (targetExps, args) ->
+            let target = Exps.prt (i+4) targetExps
+            let arity = List.length args
+            let argsp = args |> List.map (Exps.prt i) |> String.concat ","
+            sprintf "%sapply\r\n%s/%i\r\n%s    (%s)" indent target arity indent argsp
         | ModCall ((left, right), args) ->
-            let leftExp = Exps.prt 0 left
+            let leftExp = Exps.prt (i+4) left
             let rightExp = Exps.prt 0 right
             let argsp = args |> List.map (Exps.prt 0) |> String.concat ","
-            sprintf "%scall %s:%s\r\n%s    (%s)" indent leftExp rightExp indent argsp
+            sprintf "%scall\r\n%s:%s\r\n%s    (%s)" indent leftExp rightExp indent argsp
         | Let ((v, e), next) ->
             let vars = String.concat "," v
             let assign = Exps.prt (i+4) e
             let next' = Exps.prt (i+4) next
             sprintf "%slet <%s> =\r\n%s\r\n%sin\r\n%s" indent vars assign indent next'
+        | Case (caseExpr, alts) ->
+            let caseExpr = Exps.prt 0 caseExpr
+            let alts =
+                List.fold(fun s a ->
+                    match a with
+                    | Constr a ->
+                        let x = Alt.prt (i+4) a
+                        sprintf "%s%s\r\n" s x
+                    | x -> failwithf "not imple %A" x) "" alts
+            sprintf "%scase %s of\r\n%send" indent caseExpr alts
+
         | x -> failwithf "%A not implemented" x
 
 and Exps =
@@ -142,8 +210,7 @@ and FunDef = FunDef of Ann<Function> * Ann<Exp>
 and Module = Module of Atom * List<Function> * List<Atom * Const> * List<FunDef>
     with
     static member prt (Module (Atom name, funs, attribs, defs)) =
-        [ //let m = sprintf "module '%s' [" name
-          let indent = 11 + name.Length
+        [ let indent = 11 + name.Length
           match funs with
           | f :: funs ->
               yield Function.prt 0 f |> sprintf "module '%s' [%s" name