Skip to content

Commit

Permalink
Merge pull request #10 from FrankBro/compiler
Browse files Browse the repository at this point in the history 
Compiler
  • Loading branch information
@FrankBro
FrankBro authored Nov 9, 2018
2 parents 706b86e + 37ce31e commit c191fcc
Show file tree
Hide file tree
Showing 11 changed files with 186 additions and 85 deletions.
39 changes: 36 additions & 3 deletions Compiler.fs
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,39 @@
module Compiler

// Project management is files in the program themselves
open Error
open Expr
open Infer

// ordo compile a program by compiling 1 file that opens a bunch of files
// same for a lib, it returns a record with all the sub modules
type State = {
Types: Map<string, Ty>
Values: Map<string, Value>
}
with
static member New = {
Types = Map.empty
Values = Map.empty
}

let compileExprs (exprs: (string * Expr) list) =
Infer.resetId ()
let extract state (name: string, expr: Expr) =
let ordoTy =
Infer.infer state.Types expr
|> generalize
let ordoVal = Eval.eval state.Values expr
ordoTy, ordoVal
let rec loop (state: State) exprs =
match exprs with
| [] -> raise (compilerError NoExprsProvided)
| [x] -> extract state x
| x :: xs ->
let ordoTy, ordoVal = extract state x
let name = fst x
printfn "%s = %s : %s" name (stringOfValue ordoVal) (stringOfTy ordoTy)
let state =
{ state with
Types = Map.add name ordoTy state.Types
Values = Map.add name ordoVal state.Values
}
loop state xs
loop State.New exprs
5 changes: 5 additions & 0 deletions Error.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,15 +39,20 @@ type EvalError =
| BadUnOp
| InvalidList

type CompilerError =
| NoExprsProvided

type OrdoError =
| Generic of GenericError
| Parser of ParserError
| Infer of InferError
| Eval of EvalError
| Compiler of CompilerError

exception OrdoException of OrdoError

let genericError g = OrdoException (Generic g)
let parserError p = OrdoException (Parser p)
let inferError i = OrdoException (Infer i)
let evalError e = OrdoException (Eval e)
let compilerError c = OrdoException (Compiler c)
61 changes: 31 additions & 30 deletions Eval.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,14 +4,15 @@ open Error
open Expr
open Util

let rec evalExpr (env: Map<string, Value>) (expr: Expr) : Value =
let rec evalExpr files (env: Map<string, Value>) (expr: Expr) : Value =
match expr with
| EOpen filename -> Map.find filename files
| EListEmpty -> VList []
| EListCons (x, xs) ->
let xsValue = evalExpr env xs
let xsValue = evalExpr files env xs
match xsValue with
| VList xs ->
let xValue = evalExpr env x
let xValue = evalExpr files env x
VList (xValue :: xs)
| _ ->
raise (evalError InvalidList)
Expand All @@ -23,7 +24,7 @@ let rec evalExpr (env: Map<string, Value>) (expr: Expr) : Value =
)
match fnValue with
| VFun (innerEnv, EVar fnName, (EFun(arg, rest) as fn)) ->
let fnValue = evalExpr innerEnv fn
let fnValue = evalExpr files innerEnv fn
let env = Map.add fnName fnValue innerEnv
VFun (env, arg, rest)
// evalExpr env fn
Expand All @@ -39,48 +40,48 @@ let rec evalExpr (env: Map<string, Value>) (expr: Expr) : Value =
raise (genericError (VariableNotFound name))
)
| ECall (fnExpr, argExpr) ->
let fnValue = evalExpr env fnExpr
let fnValue = evalExpr files env fnExpr
match fnValue with
| VFun (innerEnv, pattern, bodyExpr) ->
let mergedEnv = Map.merge env innerEnv
let argValue = evalExpr mergedEnv argExpr
let argValue = evalExpr files mergedEnv argExpr
let matches, fnEnv = evalPattern mergedEnv pattern argValue
if not matches then
raise (genericError (InvalidPattern pattern))
evalExpr fnEnv bodyExpr
evalExpr files fnEnv bodyExpr
| _ -> raise (evalError (NotAFunction fnExpr))
| ELet (pattern, valueExpr, bodyExpr) ->
let value = evalExpr env valueExpr
let value = evalExpr files env valueExpr
let matches, env = evalPattern env pattern value
if not matches then
raise (genericError (InvalidPattern pattern))
evalExpr env bodyExpr
evalExpr files env bodyExpr
| ERecordEmpty ->
VRecord Map.empty
| EVariant (label, expr) ->
let value = evalExpr env expr
let value = evalExpr files env expr
VVariant (label, value)
| ERecordExtend (name, valueExpr, recordExpr) ->
let recordValue = evalExpr env recordExpr
let recordValue = evalExpr files env recordExpr
match recordValue with
| VRecord fields ->
if Map.containsKey name fields then
raise (inferError (RowConstraintFail name))
let valueValue = evalExpr env valueExpr
let valueValue = evalExpr files env valueExpr
fields
|> Map.add name valueValue
|> VRecord
| _ -> raise (genericError (NotARecordExpr recordExpr))
| ERecordRestrict (recordExpr, name) ->
let recordValue = evalExpr env recordExpr
let recordValue = evalExpr files env recordExpr
match recordValue with
| VRecord fields ->
fields
|> Map.remove name
|> VRecord
| _ -> raise (genericError (NotARecordExpr recordExpr))
| ERecordSelect (recordExpr, label) ->
let recordValue = evalExpr env recordExpr
let recordValue = evalExpr files env recordExpr
match recordValue with
| VRecord fields ->
fields
Expand All @@ -90,7 +91,7 @@ let rec evalExpr (env: Map<string, Value>) (expr: Expr) : Value =
)
| _ -> raise (genericError (NotARecordExpr recordExpr))
| ECase (valueExpr, cases, oDefault) ->
let valueValue = evalExpr env valueExpr
let valueValue = evalExpr files env valueExpr
let oCases = tryMakeVariantCases cases
match valueValue, oCases with
| VVariant (label, value), Some cases ->
Expand All @@ -103,7 +104,7 @@ let rec evalExpr (env: Map<string, Value>) (expr: Expr) : Value =
| None -> true
| Some guard ->
let matches, guardEnv = evalPattern env pattern value
match evalExpr guardEnv guard with
match evalExpr files guardEnv guard with
| VBool value -> value && matches
| _ -> raise (genericError (InvalidGuard guard))
caseLabel = label && isGuardTrue () && patternMatches
Expand All @@ -119,9 +120,9 @@ let rec evalExpr (env: Map<string, Value>) (expr: Expr) : Value =
let matches, fnEnv = evalPattern env pattern value
if not matches then
raise (genericError (InvalidPattern pattern))
evalExpr fnEnv expr
evalExpr files fnEnv expr
| _ ->
let value = evalExpr env valueExpr
let value = evalExpr files env valueExpr
let pattern, expr =
cases
|> List.tryFind (fun (pattern, expr, oGuard) ->
Expand All @@ -131,7 +132,7 @@ let rec evalExpr (env: Map<string, Value>) (expr: Expr) : Value =
| None -> true
| Some guard ->
let matches, guardEnv = evalPattern env pattern value
match evalExpr guardEnv guard with
match evalExpr files guardEnv guard with
| VBool value -> value && matches
| _ -> raise (genericError (InvalidGuard guard))
isGuardTrue () && patternMatches
Expand All @@ -147,27 +148,27 @@ let rec evalExpr (env: Map<string, Value>) (expr: Expr) : Value =
let matches, fnEnv = evalPattern env pattern value
if not matches then
raise (genericError (InvalidPattern pattern))
evalExpr fnEnv expr
evalExpr files fnEnv expr
| EIfThenElse (ifExpr, thenExpr, elseExpr) ->
let ifValue = evalExpr env ifExpr
let ifValue = evalExpr files env ifExpr
match ifValue with
| VBool true -> evalExpr env thenExpr
| VBool false -> evalExpr env elseExpr
| VBool true -> evalExpr files env thenExpr
| VBool false -> evalExpr files env elseExpr
| _ ->
raise (genericError IfValueNotBoolean )
| EUnOp (op, a) ->
let a = evalExpr env a
let a = evalExpr files env a
match op, a with
| Negative, VInt a -> VInt (-a)
| Negative, VFloat a -> VFloat (-a)
| _ -> raise (evalError BadUnOp)
| EBinOp (a, op, b) ->
let a = evalExpr env a
let a = evalExpr files env a
match op with
| And ->
match a with
| VBool true ->
let b = evalExpr env b
let b = evalExpr files env b
match b with
| VBool b -> VBool b
| _ ->
Expand All @@ -178,7 +179,7 @@ let rec evalExpr (env: Map<string, Value>) (expr: Expr) : Value =
| Or ->
match a with
| VBool false ->
let b = evalExpr env b
let b = evalExpr files env b
match b with
| VBool b -> VBool b
| _ ->
Expand All @@ -187,7 +188,7 @@ let rec evalExpr (env: Map<string, Value>) (expr: Expr) : Value =
| _ ->
raise (evalError BadBinOp)
| _ ->
let b = evalExpr env b
let b = evalExpr files env b
match a, op, b with
| VInt a, Plus, VInt b -> VInt (a + b)
| VFloat a, Plus, VFloat b -> VFloat (a + b)
Expand Down Expand Up @@ -271,5 +272,5 @@ and evalPattern (env: Map<string, Value>) pattern (value: Value) : bool * Map<_,
raise (genericError (InvalidPattern pattern))
loop env pattern value

let eval expr : Value =
evalExpr Map.empty expr
let eval files expr : Value =
evalExpr files Map.empty expr
3 changes: 3 additions & 0 deletions Expr.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -60,6 +60,7 @@ type Expr =
| EFix of Name
| EListEmpty
| EListCons of Expr * Expr
| EOpen of string
with
override x.ToString () =
match x with
Expand All @@ -83,6 +84,7 @@ with
| EFix name -> sprintf "EFix %s" name
| EListEmpty -> "EListEmpty"
| EListCons (x, xs) -> sprintf "EListCons (%O, %O)" x xs
| EOpen filename -> sprintf "EOpen \"%s\"" filename

and Pattern = Expr
and Guard = Expr
Expand Down Expand Up @@ -248,6 +250,7 @@ let stringOfExpr (x: Expr) : string =
sprintf "%s%s" op a
| EListEmpty -> "[]"
| EListCons (x, xs) -> sprintf "%s :: %s" (f false x) (f false xs)
| EOpen filename -> sprintf "open \"%s\"" filename
f false x

type Entry = {
Expand Down
Loading

0 comments on commit c191fcc

Please sign in to comment.