Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch new-ghost-var Excluding Merge-Ins
This is equivalent to a diff from d5fc82fa3d to 65050f07f4
|
2023-07-18
| ||
| 04:50 | Generator - X86: begin Leaf check-in: 65050f07f4 user: hothing tags: new-ghost-var | |
| 04:38 | Cx-lang, primitive optimizer: assigment reducer check-in: 46bf8f862f user: hothing tags: new-ghost-var | |
|
2023-07-10
| ||
| 05:01 | I want to test new mechinics for separate named and unnamed(ghost) variables check-in: 7f2da6d07a user: hothing tags: new-ghost-var | |
| 04:43 | * Leaf check-in: d5fc82fa3d user: hothing tags: master, trunk | |
|
2023-07-09
| ||
| 11:49 | Cx-language description check-in: 31c67c42c4 user: hothing tags: master, trunk | |
Changes to clang/CLang.fs.
|
| | | > | > > | > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 |
namespace nanopass
module CLanguage =
// Grammar:
// arg ::= int | var
// exp ::= arg | (read) | (- arg) | (+ arg arg)
// stmt ::= (assign var exp) | (return arg)
// C0 ::= (program (var∗) stmt+)
type CLanguage = CProgram of CSymbols * CStatement list
and CSymbols = Map<string, CVarInfo>
and CStatement = CAssign of string * CExpression // variable name * expression
| CIfStmt of CArgument * CStatement list * CStatement list
| CReturn of CArgument
and CVarInfo = {
dtype: CDataType; // data type
offset : int; // offset in the memory
auto : bool; // is generated variable
rdcnt : int; // read op counter
wrcnt : int // write op counter
}
and CExpression = CValue of CArgument
| CRead // read value, polymorphic :: () -> integer | () -> boolean
| CNeg of CArgument // negative:: integer -> integer
| CAdd of CArgument * CArgument // add:: integer -> integer -> integer
| CSub of CArgument * CArgument // substract:: integer -> integer -> integer
| CMul of CArgument * CArgument // multiply:: integer -> integer -> integer
| CDiv of CArgument * CArgument // divide:: integer -> integer -> integer
| CCmpEq of CArgument * CArgument // compare 'equal':: integer -> integer -> boolean
| CCmpNeq of CArgument * CArgument // compare 'not equal':: integer -> integer -> boolean
| CCmpLt of CArgument * CArgument // compare 'less':: integer -> integer -> boolean
| CCmpGt of CArgument * CArgument // compare 'great':: integer -> integer -> boolean
| CCmpLe of CArgument * CArgument // compare 'less or equal':: integer -> integer -> boolean
| CCmpGe of CArgument * CArgument // compare 'great equal':: integer -> integer -> boolean
| CNot of CArgument // boolean NOT:: boolean -> boolean
| CAnd of CArgument * CArgument // booleand AND:: boolean -> boolean -> boolean
| COr of CArgument * CArgument // booleand OR:: boolean -> boolean -> boolean
| CXOr of CArgument * CArgument // booleand exclusive OR:: boolean -> boolean -> boolean
and CArgument = CInt of int | CBool of bool | CBoolVar of string | CIntVar of string
and CDataType = CTypeAny | CTypeInt | CTypeBool | CUnknown
let get_arg_type arg =
match arg with
| CBool _ | CBoolVar _ -> CTypeBool
| CInt _ | CIntVar _ -> CTypeInt
|
| ︙ | ︙ | |||
57 58 59 60 61 62 63 64 65 66 67 68 69 70 |
| CCmpGt (a1, a2)
| CCmpLt (a1, a2)
| CCmpNeq (a1, a2)
| CCmpEq (a1, a2) ->
CTypeBool
| CNot (_)
| CAnd (_, _)
| COr (_, _) ->
CTypeBool
let expr_args_is_ok exp =
match exp with
| CValue v -> true
| CRead -> true
| > | 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 |
| CCmpGt (a1, a2)
| CCmpLt (a1, a2)
| CCmpNeq (a1, a2)
| CCmpEq (a1, a2) ->
CTypeBool
| CNot (_)
| CAnd (_, _)
| CXOr (_, _)
| COr (_, _) ->
CTypeBool
let expr_args_is_ok exp =
match exp with
| CValue v -> true
| CRead -> true
|
| ︙ | ︙ | |||
84 85 86 87 88 89 90 91 92 93 94 95 96 97 |
let t2 = get_arg_type a2
match t1, t2 with
| CTypeInt , CTypeInt-> true
| _, _ -> false
| CNot (a1) ->
(get_arg_type a1) = CTypeBool
| CAnd (a1, a2)
| COr (a1, a2) ->
let t1 = get_arg_type a1
let t2 = get_arg_type a2
match t1, t2 with
| CTypeBool , CTypeBool-> true
| _, _ -> false
| > > > > > > > | | | > > | | | < < < < < < | | | | | 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 |
let t2 = get_arg_type a2
match t1, t2 with
| CTypeInt , CTypeInt-> true
| _, _ -> false
| CNot (a1) ->
(get_arg_type a1) = CTypeBool
| CAnd (a1, a2)
| CXOr (a1, a2)
| COr (a1, a2) ->
let t1 = get_arg_type a1
let t2 = get_arg_type a2
match t1, t2 with
| CTypeBool , CTypeBool-> true
| _, _ -> false
let calcNextOffset lastVar =
match (lastVar.dtype) with
| CTypeBool -> (lastVar.offset) + 1
| CTypeInt -> (lastVar.offset) + 4
| _ -> (lastVar.offset) + 8
(* let makeSymByArg offset arg =
match arg with
| CBoolVar v ->
Some (v, {dtype = CTypeBool; offset = offset; rdcnt = 0; wrcnt = 0})
| CIntVar v ->
Some (v, {dtype = CTypeInt; offset = offset; rdcnt = 0; wrcnt = 0})
| _ -> None
let updateSymCnt written varInfo =
if written then
{varInfo with wrcnt = varInfo.wrcnt + 1}
else
{varInfo with rdcnt = varInfo.rdcnt + 1}
let addSym calcNextOffset arg syms =
let newOffs =
if Map.count syms > 0 then
let firstVar = Map.pick (fun k v -> Some(v)) syms
let lastVar = Map.fold (fun s k v -> if (v.offset > s.offset) then v else s) firstVar syms
calcNextOffset lastVar
else
0
match makeSymByArg newOffs arg with
| Some (vh) -> Map.add name vh syms // DESIGN ERROR: ghost variable should have the name???
| _ -> syms
let updateSym written arg syms =
let updateCnt wrc vx =
match vx with
| Some(v) -> Some( if wrc then {v with wrcnt = v.wrcnt + 1} else {v with rdcnt = v.rdcnt + 1})
| None -> None
|
| ︙ | ︙ | |||
167 168 169 170 171 172 173 |
| Some arg ->
addSym calcNextOffset isGhost arg syms
|> updateSym true arg
|> updateSymsByExpr exp
| _ -> syms
(newSyms, (List.append stmts [CAssign(varname, exp)]))
| | | 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 |
| Some arg ->
addSym calcNextOffset isGhost arg syms
|> updateSym true arg
|> updateSymsByExpr exp
| _ -> syms
(newSyms, (List.append stmts [CAssign(varname, exp)]))
let addAssignWith calcNextOffset expConstructor isGhost varname arg1Name arg2Name prg =
let syms, stmts = prg
let exp, syms = expConstructor arg1Name arg2Name syms
let wArg = match (get_expr_result_type exp) with
| CTypeBool -> Some (CBoolVar varname)
| CTypeInt -> Some (CIntVar varname)
| _ -> None
let newSyms = match wArg with
|
| ︙ | ︙ | |||
189 190 191 192 193 194 195 |
let newAddInt arg1 arg2 syms =
let isGhost = true
let a1 = (CIntVar arg1)
let a2 = (CIntVar arg2)
let syms = syms |> addSym calcNextOffset isGhost a1 |> addSym calcNextOffset isGhost a2
let exp = CAdd (a1, a2)
(exp, syms)
| > | 199 200 201 202 203 204 205 206 |
let newAddInt arg1 arg2 syms =
let isGhost = true
let a1 = (CIntVar arg1)
let a2 = (CIntVar arg2)
let syms = syms |> addSym calcNextOffset isGhost a1 |> addSym calcNextOffset isGhost a2
let exp = CAdd (a1, a2)
(exp, syms)
*)
|
Added clang/CLangOp.fs.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 |
namespace nanopass
module CLanguageOp =
open CLanguage
let varInfo dtype offset auto =
{dtype = dtype; offset = offset; rdcnt = 0; wrcnt = 0; auto = auto}
let newTempSym calcNextOffset dtype syms =
let gen, st = syms
let newName = $"tmp.{gen + 1}"
let newOffs =
if Map.count st > 0 then
let firstVar = Map.pick (fun k v -> Some(v)) st
let lastVar = Map.fold (fun s k v -> if (v.offset > s.offset) then v else s) firstVar st
calcNextOffset lastVar
else
0
let x = varInfo dtype newOffs true
let st = Map.add newName x st
(newName, (gen + 1, st))
let addNamedSym calcNextOffset (name:string) dtype syms =
let gen, st = syms
let newOffs =
if Map.count st > 0 then
let firstVar = Map.pick (fun k v -> Some(v)) st
let lastVar = Map.fold (fun s k v -> if (v.offset > s.offset) then v else s) firstVar st
calcNextOffset lastVar
else
0
let x = varInfo dtype newOffs false
let st = Map.add name x st
(gen + 0, st)
let existsVar (name:string) syms =
let (gen:int), st = syms
if Map.count st > 0 then
match Map.tryFind name st with
| Some _ -> true
| None -> false
else
false
let removeVar (name:string) syms =
let (gen:int), st = syms
let st = Map.remove name st
(gen, st)
let expectTypeOfVar name dtype syms =
let _, st = syms
if Map.count st > 0 then
let lastVar = Map.find name st
lastVar.dtype = dtype
else
false
let getVar (name:string) syms =
let (gen:int), st = syms
if Map.count st > 0 then
Map.tryFind name st
else
None
let getVarType (name:string) syms =
let (gen:int), st = syms
if Map.count st > 0 then
let r = Map.tryFind name st
match r with
| Some vi -> vi.dtype
| None -> CUnknown
else
CUnknown
let updateAccessCnt written (name:string) syms =
let (gen:int), st = syms
if Map.count st > 0 then
let lastVar = Map.find name st
let nVar =
if written then {lastVar with wrcnt = lastVar.wrcnt + 1}
else {lastVar with rdcnt = lastVar.rdcnt + 1}
let st = Map.add name nVar st
(gen, st)
else
syms
|
Added clang/CLangOp2.fs.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 |
namespace nanopass
module CLanguageOp2 =
open CLanguage
type CSymbols2 = Map<CVarDescriptor, CVarInfo>
and CVarDescriptor = CNamedVar of CVarInfo | CAutoVar of CVarInfo
and CVarInfo = {
dtype: CDataType; // data type
offset : int; // offset in the memory
rdcnt : int; // read op counter
wrcnt : int // write op counter
}
let varInfo dtype offset auto =
{dtype = dtype; offset = offset; rdcnt = 0; wrcnt = 0; auto = auto}
let newTempSym calcNextOffset dtype syms =
let gen, st = syms
let newName = $"tmp.{gen + 1}"
let newOffs =
if Map.count st > 0 then
let firstVar = Map.pick (fun k v -> Some(v)) st
let lastVar = Map.fold (fun s k v -> if (v.offset > s.offset) then v else s) firstVar st
calcNextOffset lastVar
else
0
let x = varInfo dtype newOffs false
let st = Map.add newName x st
(newName, (gen + 1, st))
let addNamedSym calcNextOffset (name:string) dtype syms =
let gen, st = syms
let newOffs =
if Map.count st > 0 then
let firstVar = Map.pick (fun k v -> Some(v)) st
let lastVar = Map.fold (fun s k v -> if (v.offset > s.offset) then v else s) firstVar st
calcNextOffset lastVar
else
0
let x = varInfo dtype newOffs false
let st = Map.add name x st
(gen + 0, st)
let expectTypeOfVar name dtype syms =
let _, st = syms
if Map.count st > 0 then
let lastVar = Map.find name st
lastVar.dtype = dtype
else
false
let getVar name syms =
let _, st = syms
if Map.count st > 0 then
Map.tryFind name st
else
None
let updateAccessCnt written name syms =
let gen, st = syms
if Map.count st > 0 then
let lastVar = Map.find name st
let nVar =
if written then {lastVar with wrcnt = lastVar.wrcnt + 1}
else {lastVar with rdcnt = lastVar.rdcnt + 1}
let st = Map.add name nVar st
(gen, st)
else
syms
|
Added clang/CReducer.fs.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 |
namespace nanopass
module Optimizator1 =
open nanopass.CLanguage
open nanopass.CLanguageOp
type OptimizationResult<'a> = Done of 'a | Skiped of 'a
let argContainsName name arg =
match arg with
| CBool _ | CInt _ -> false
| CBoolVar vname | CIntVar vname -> vname = name
let expContainsName name exp =
match exp with
| CValue v ->
argContainsName name v
| CRead ->
false
| CNeg (e) -> argContainsName name e
| CAdd (a1, a2)
| CSub (a1, a2)
| CMul (a1, a2)
| CDiv (a1, a2) ->
(argContainsName name a1 ) || (argContainsName name a2)
| CCmpGe (a1, a2)
| CCmpLe (a1, a2)
| CCmpGt (a1, a2)
| CCmpLt (a1, a2)
| CCmpNeq (a1, a2)
| CCmpEq (a1, a2) ->
(argContainsName name a1 ) || (argContainsName name a2)
| CNot (a1) -> (argContainsName name a1 )
| CAnd (a1, a2)
| CXOr (a1, a2)
| COr (a1, a2) -> (argContainsName name a1 ) || (argContainsName name a2)
let rec containsNameInArgs name stmt =
match stmt with
| CAssign (_, exp) ->
(expContainsName name exp)
| CIfStmt (arg, stmtsT, stmtsF) ->
(argContainsName name arg)
|| List.fold (fun r s -> r || containsNameInArgs name s) false stmtsT
|| List.fold (fun r s -> r || containsNameInArgs name s) false stmtsF
| CReturn (arg) ->
argContainsName name arg
let reduce0 prg =
let symtab, stmts = prg
let ta = List.indexed stmts
let fa = List.head ta
match (snd fa) with
| CAssign(tgtName, CValue (arg)) ->
let nx = List.choose (fun e -> if (containsNameInArgs tgtName (snd e)) then Some(e) else None) ta
if nx.Length = 1 then
let sa = List.head nx
match (snd sa) with
| CAssign(tgtName2, CValue (arg2)) ->
if argContainsName tgtName arg2 then
let stmts = List.removeAt (fst sa) stmts
let stmts = List.insertAt (fst sa) (CAssign(tgtName2, CValue (arg))) stmts
let stmts = List.removeAt (fst fa) stmts
let symtab = removeVar tgtName symtab
(symtab, stmts)
else
(symtab, stmts)
| _ -> (symtab, stmts)
else
(symtab, stmts)
| _ ->
(symtab, stmts)
let rec reduce1 prg =
let symtab, stmts = prg
let matchByArg name stmt =
match stmt with
| CAssign (vname, _) -> vname = name
| _ -> false
let relinkArg exp stmt =
match stmt with
| CAssign (name, _) -> CAssign (name, exp)
| _ -> stmt
match stmts with
| hd::rstmts ->
match hd with
| CAssign(tgtName, CValue (arg)) ->
let linked = List.filter (fun s -> matchByArg tgtName (snd s)) (List.indexed rstmts)
if linked.Length = 1 then
let anchor = List.head linked
let nstmts = List.removeAt (fst anchor) rstmts
let nstmts = List.insertAt (fst anchor) (relinkArg (CValue arg) (snd anchor)) nstmts
let symtab = removeVar tgtName symtab
(symtab, nstmts)
else
(symtab, stmts)
| CIfStmt(condArg, stmtsT, stmtsF) ->
let symtab, stmtsT = reduce1 (symtab, stmtsT)
let symtab, stmtsF = reduce1 (symtab, stmtsF)
let nstmts = CIfStmt(condArg, stmtsT, stmtsF)::rstmts
(symtab, nstmts)
| _ -> prg
| [] -> prg
|
Changes to clang/CTypeEval.fs.
|
| | | 1 2 3 4 5 6 7 8 |
namespace nanopass
module CTypeEvaluator =
open CLanguage
type TypeCheckResult<'a> =
| Success of 'a
|
| ︙ | ︙ | |||
33 34 35 36 37 38 39 40 41 42 43 44 45 46 |
| CCmpGt (a1, a2)
| CCmpLt (a1, a2)
| CCmpNeq (a1, a2)
| CCmpEq (a1, a2) ->
CTypeBool
| CNot (_)
| CAnd (_, _)
| COr (_, _) ->
CTypeBool
let expr_args_is_ok exp =
match exp with
| CValue v -> true
| CRead -> true
| > | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 |
| CCmpGt (a1, a2)
| CCmpLt (a1, a2)
| CCmpNeq (a1, a2)
| CCmpEq (a1, a2) ->
CTypeBool
| CNot (_)
| CAnd (_, _)
| CXOr (_, _)
| COr (_, _) ->
CTypeBool
let expr_args_is_ok exp =
match exp with
| CValue v -> true
| CRead -> true
|
| ︙ | ︙ | |||
60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 |
let t2 = get_arg_type a2
match t1, t2 with
| CTypeInt , CTypeInt-> true
| _, _ -> false
| CNot (a1) ->
(get_arg_type a1) = CTypeBool
| CAnd (a1, a2)
| COr (a1, a2) ->
let t1 = get_arg_type a1
let t2 = get_arg_type a2
match t1, t2 with
| CTypeBool , CTypeBool-> true
| _, _ -> false
let merge_result1 resA resB =
match (resA, resB) with
| Success t1, Success t2 ->
Success t1
| Failure f1, Failure f2 ->
Failure ($"{f1}, {f2}")
| Failure _, _ ->
resA
| _, Failure _ ->
resB
let merge_result2 resA resB =
match (resA, resB) with
| Success t1, Success t2 ->
Success t2
| Failure f1, Failure f2 ->
Failure ($"{f1}, {f2}")
| Failure _, _ ->
resA
| _, Failure _ ->
resB
let merge_equal_result resA resB =
match (resA, resB) with
| Success t1, Success t2 ->
if t1 = t2 then Success t1
else Failure ($"the results are not same: {t1} /= {t2}")
| Failure f1, Failure f2 ->
Failure ($"{f1}, {f2}")
| Failure _, _ ->
resA
| _, Failure _ ->
resA
| > > > | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 |
let t2 = get_arg_type a2
match t1, t2 with
| CTypeInt , CTypeInt-> true
| _, _ -> false
| CNot (a1) ->
(get_arg_type a1) = CTypeBool
| CAnd (a1, a2)
| CXOr (a1, a2)
| COr (a1, a2) ->
let t1 = get_arg_type a1
let t2 = get_arg_type a2
match t1, t2 with
| CTypeBool , CTypeBool-> true
| _, _ -> false
let merge_result1 resA resB =
match (resA, resB) with
| Success t1, Success t2 ->
Success t1
| Failure f1, Failure f2 ->
Failure ($"{f1}, {f2}")
| Failure _, _ ->
resA
| _, Failure _ ->
resB
let merge_result2 resA resB =
match (resA, resB) with
| Success t1, Success t2 ->
Success t2
| Failure f1, Failure f2 ->
Failure ($"{f1}, {f2}")
| Failure _, _ ->
resA
| _, Failure _ ->
resB
let merge_equal_result resA resB =
match (resA, resB) with
| Success t1, Success t2 ->
if t1 = t2 then Success t1
else Failure ($"the results are not same: {t1} /= {t2}")
| Failure f1, Failure f2 ->
Failure ($"{f1}, {f2}")
| Failure _, _ ->
resA
| _, Failure _ ->
resA
|
Changes to clang/clang.fsproj.
1 2 3 4 5 6 7 8 9 10 11 12 13 |
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net7.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
</PropertyGroup>
<ItemGroup>
<Compile Include="CLang.fs" />
<Compile Include="CTypeEval.fs" />
</ItemGroup>
</Project>
| > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net7.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
</PropertyGroup>
<ItemGroup>
<Compile Include="CLang.fs" />
<Compile Include="CLangOp.fs" />
<Compile Include="CTypeEval.fs" />
<Compile Include="CReducer.fs" />
</ItemGroup>
</Project>
|
Changes to clang/tests/UnitTest1.fs.
1 2 3 | module clang.tests open NUnit.Framework | | > | | | | | > > > > > > > | > > > > > > > > | | | | | | | | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 |
module clang.tests
open NUnit.Framework
open nanopass.CLanguage
open nanopass.CLanguageOp
[<SetUp>]
let Setup () =
()
[<Test>]
let Test1 () =
Assert.Pass()
[<Test>]
let ``test addNamedSym`` () =
let syms = (0, Map.add "f1" (varInfo CTypeBool 0 false) (Map.empty))
let syms' = addNamedSym calcNextOffset "f1" CTypeBool (0, Map.empty)
Assert.AreEqual(syms, syms')
[<Test>]
let ``test updateAccessCnt /read`` () =
let syms = addNamedSym calcNextOffset "f1" CTypeBool (0, Map.empty)
let syms = updateAccessCnt false "f1"syms |> updateAccessCnt false "f1"
match getVar "f1" syms with
| Some (v) -> Assert.AreEqual(v.rdcnt, 2)
| None -> Assert.Fail()
[<Test>]
let ``test updateAccessCnt /write`` () =
let syms = addNamedSym calcNextOffset "f1" CTypeBool (0, Map.empty)
let syms = updateAccessCnt true "f1"syms |> updateAccessCnt false "f1"
match getVar "f1" syms with
| Some (v) -> Assert.AreEqual(v.rdcnt, 1); Assert.AreEqual(v.wrcnt, 1)
| None -> Assert.Fail()
(*
[<Test>]
let ``test updateSym read`` () =
let syms = Map.add "a" {var = (CTypeBool, 0); ghost = true; rdcnt = 0; wrcnt = 0} (Map.empty)
let syms' = addSym calcNextOffset false(CBoolVar "f1") syms |> updateSym false (CBoolVar "f1")
Assert.AreEqual({var = (CTypeBool, 1); ghost = false; rdcnt = 1; wrcnt = 0}, Map.find "f1" syms')
[<Test>]
let ``test updateSym write`` () =
let syms = Map.add "a" {var = (CTypeBool, 0); ghost = true; rdcnt = 0; wrcnt = 0} (Map.empty)
let syms' = addSym calcNextOffset false(CBoolVar "f1") syms |> updateSym true (CBoolVar "f1")
Assert.AreEqual({var = (CTypeBool, 1); ghost = false; rdcnt = 0; wrcnt = 1}, Map.find "f1" syms')
[<Test>]
let ``test updateSymsByExpr`` () =
let syms =
Map.add "a" {var = (CTypeBool, 0); ghost = true; rdcnt = 0; wrcnt = 0} (Map.empty)
|> addSym calcNextOffset false(CBoolVar "f1")
|> addSym calcNextOffset false(CBoolVar "f2")
let syms' = updateSymsByExpr (CAnd(CBoolVar "f1", CBoolVar "f2")) syms
Assert.AreEqual({var = (CTypeBool, 1); ghost = false; rdcnt = 1; wrcnt = 0}, Map.find "f1" syms')
Assert.AreEqual({var = (CTypeBool, 2); ghost = false; rdcnt = 1; wrcnt = 0}, Map.find "f2" syms')
[<Test>]
let ``test addAssign`` () =
let syms =
Map.add "a" {var = (CTypeBool, 0); ghost = true; rdcnt = 0; wrcnt = 0} (Map.empty)
|> addSym calcNextOffset false(CBoolVar "f1")
|> addSym calcNextOffset false(CBoolVar "f2")
let prg = (syms, []) |> addAssign calcNextOffset false "f3" (CAnd(CBoolVar "f1", CBoolVar "f2"))
//Assert.AreEqual((syms, []), prg)
Assert.AreEqual({var = (CTypeBool, 1); ghost = false; rdcnt = 1; wrcnt = 0}, Map.find "f1" (fst prg))
Assert.AreEqual({var = (CTypeBool, 2); ghost = false; rdcnt = 1; wrcnt = 0}, Map.find "f2" (fst prg))
Assert.AreEqual({var = (CTypeBool, 3); ghost = false; rdcnt = 0; wrcnt = 1}, Map.find "f3" (fst prg))
Assert.AreEqual(CAssign ("f3", CAnd(CBoolVar "f1", CBoolVar "f2")), (List.head (snd (prg))))
[<Test>]
let ``test addAssignWith`` () =
let syms =
Map.add "a" {var = (CTypeBool, 0); ghost = true; rdcnt = 0; wrcnt = 0} (Map.empty)
let prg = (syms, [])
|> addAssignWith calcNextOffset newAddInt false "f3" "f1" "f2"
Assert.AreEqual({var = (CTypeInt, 1); ghost = false; rdcnt = 1; wrcnt = 0}, Map.find "f1" (fst prg))
Assert.AreEqual({var = (CTypeInt, 5); ghost = false; rdcnt = 1; wrcnt = 0}, Map.find "f2" (fst prg))
Assert.AreEqual({var = (CTypeInt, 9); ghost = false; rdcnt = 0; wrcnt = 1}, Map.find "f3" (fst prg))
Assert.AreEqual(CAssign ("f3", CAnd(CBoolVar "f1", CBoolVar "f2")), (List.head (snd (prg))))
*)
|
Added clang/tests/UnitTest2.fs.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 |
module clang.tests2
open NUnit.Framework
open nanopass.CLanguage
open nanopass.CLanguageOp
[<SetUp>]
let Setup () =
()
[<Test>]
let ``Cx-Lang:Op newTempSym`` () =
let syms = (0, Map.add "" (varInfo CTypeBool -1 true) (Map.empty))
let nvar, syms' = newTempSym calcNextOffset CTypeInt syms
Assert.AreNotEqual(syms, syms')
Assert.AreNotEqual("tmp.0", nvar)
Assert.AreEqual("tmp.1", nvar)
Assert.True(Map.exists (fun k v -> k = "tmp.1") (snd syms'))
[<Test>]
let ``Cx-Lang:Op addNamedSym`` () =
//let syms = (0, Map.add "" (varInfo CTypeBool -1 true) (Map.empty))
let syms' = addNamedSym calcNextOffset "a" CTypeInt (0, Map.empty)
let newVar = varInfo CTypeInt 0 false
Assert.AreEqual(newVar, Map.find "a" (snd syms'))
[<Test>]
let ``Cx-Lang:Op newTempSym + addNamedSym`` () =
let syms' = addNamedSym calcNextOffset "a" CTypeInt (0, Map.empty)
let newVar, syms' = newTempSym calcNextOffset CTypeBool syms'
let testVar = varInfo CTypeInt 0 false
Assert.AreEqual("tmp.1", newVar)
Assert.AreEqual(testVar, Map.find "a" (snd syms'))
|
Added clang/tests/UnitTest3.fs.
> | 1 | module clang.tests3 |
Added clang/tests/UnitTest4.fs.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
module clang.tests4
open NUnit.Framework
open nanopass.CLanguage
open nanopass.CLanguageOp
open nanopass.Optimizator1
[<SetUp>]
let Setup () =
()
[<Test>]
let ``Cx-language:reducer - test A1`` () =
let source = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
]
let expected = [
CAssign ("a", CValue (CInt 0));
]
let symtab = (0, (Map.empty))
let x, z = reduce0 (symtab, source)
Assert.That(z, Is.EquivalentTo(expected))
[<Test>]
let ``Cx-language:reducer - test A2`` () =
let source = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
CAssign ("tmp.2", CValue (CInt -1));
CReturn (CIntVar "tmp.2")
]
let expected = [
CAssign ("a", CValue (CInt 0));
CAssign ("tmp.2", CValue (CInt -1));
CReturn (CIntVar "tmp.2")
]
let symtab = (0, (Map.empty))
let x, z = reduce0 (symtab, source)
Assert.That(z, Is.EquivalentTo(expected))
[<Test>]
let ``Cx-language:reducer - test A3`` () =
let source = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
CAssign ("b", CValue (CIntVar "tmp.1"));
]
let expected = source
let symtab = (0, (Map.empty))
let x, z = reduce0 (symtab, source)
Assert.That(z, Is.EquivalentTo(expected))
[<Test>]
let ``Cx-language:reducer - test A4`` () =
let source = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("tmp.2", CValue (CIntVar "tmp.1"));
CAssign ("tmp.3", CValue (CIntVar "tmp.2"));
]
let expected = [CAssign ("tmp.3", CValue (CInt 0));]
let symtab = (0, (Map.empty))
let x, z = reduce0 (symtab, source) |> reduce0
Assert.That(z, Is.EquivalentTo(expected))
[<Test>]
let ``Cx-language:reducer - test B4`` () =
let source = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("tmp.2", CValue (CIntVar "tmp.1"));
CAssign ("tmp.3", CValue (CIntVar "tmp.2"));
]
let expected = [CAssign ("tmp.3", CValue (CInt 0));]
let symtab = (0, (Map.empty))
let x, z = reduce1 (symtab, source)
Assert.That(z, Is.EquivalentTo(expected))
|
Changes to clang/tests/clang.tests.fsproj.
1 | <Project Sdk="Microsoft.NET.Sdk"> | < < < > > > < < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 |
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net7.0</TargetFramework>
<IsPackable>false</IsPackable>
<GenerateProgramFile>false</GenerateProgramFile>
<IsTestProject>true</IsTestProject>
</PropertyGroup>
<ItemGroup>
<Compile Include="UnitTest1.fs" />
<Compile Include="UnitTest2.fs" />
<Compile Include="UnitTest3.fs" />
<Compile Include="UnitTest4.fs" />
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.5.0" />
<PackageReference Include="NUnit" Version="3.13.3" />
<PackageReference Include="NUnit3TestAdapter" Version="4.4.2" />
<PackageReference Include="NUnit.Analyzers" Version="3.6.1" />
<PackageReference Include="coverlet.collector" Version="3.2.0" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\clang.fsproj" />
</ItemGroup>
</Project>
|
Added gen-x86/XHomes.fs.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 |
namespace nanopass.Generators
module X86AssignHomes =
open nanopass.Generators.X86
exception ItemNotFound of string
exception ItemAlreadyExists of string
(* let prepareAllocationSimple vars =
List.map (fun vname -> (vname, XRV(vname))) vars |> Map.ofList
let prepareAllocation prg =
match prg with
| XProgramAbs (vars, stmts) ->
let vars = List.map (fun vname -> (vname, XRV(vname))) vars |> Map.ofList
XProgramImp(vars, stmts)
| XProgramImp (allocatedVars, stmts) ->
prg
let x0assignHomes nVars stmts =
let transArg arg vars =
match arg with
| XVar(name) ->
match Map.tryFind name vars with
| Some(x) ->
match x with
| XRR (reg) -> XReg reg
| XRM (reg, offset) -> XDeref(reg, offset)
| XRV (vname) -> XVar vname
| None -> raise (ItemNotFound(name))
| _ -> arg
let transCell cell vars =
match cell with
| XTVar(name) ->
match Map.tryFind name vars with
| Some(x) ->
match x with
| XRR (reg) -> XTReg reg
| XRM (reg, offset) -> XTDeref(reg, offset)
| XRV (vname) -> XTVar vname
| None -> raise (ItemNotFound(name))
| _ -> cell
let translate stmt =
match stmt with
| MovQ(arg, cell) -> MovQ(transArg arg nVars, transCell cell nVars)
| AddQ(arg, cell) -> AddQ(transArg arg nVars, transCell cell nVars)
| SubQ(arg, cell) -> SubQ(transArg arg nVars, transCell cell nVars)
| MulQ(arg, cell) -> MulQ(transArg arg nVars, transCell cell nVars)
| DivQ(arg, cell) -> DivQ(transArg arg nVars, transCell cell nVars)
| NegQ(cell) -> NegQ(transCell cell nVars)
| PushQ(arg) -> PushQ(transArg arg nVars)
| PopQ(cell) -> PopQ(transCell cell nVars)
| _ -> stmt
List.map translate stmts
let assignHomes prg =
match prg with
| XProgramAbs(_) ->
prg
| XProgramImp (allocatedVars, stmts) ->
let nStmts = x0assignHomes allocatedVars stmts
XProgramImp(allocatedVars, nStmts)
*)
|
Added gen-x86/XLang.fs.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 |
namespace nanopass.Generators
module X86 =
type XLanguage = XProgramAbs of XVariable list * XInstruction list
| XProgramImp of Map<XVariable, XReference> * XInstruction list
and XVariable = string
and XReference = XRR of XRegister | XRM of XRegister * int | XRV of XVariable
and XInstruction = AddQ of XArg * XCell
| SubQ of XArg * XCell
| MulQ of XArg * XCell
| DivQ of XArg * XCell
| MovQ of XArg * XCell
| MovZBQ of XArg * XCell
| RetQ
| NegQ of XCell
| CallQ of string
| PushQ of XArg
| PopQ of XCell
| SetE of XCell
| CmpQ of XArg * XCell
and XArg = XInt of int
| XIntVar of XVariable
| XBoolVar of XVariable
| XReg of XRegister
| XByteReg of XByteRegister
| XDeref of XRegister * int
and XCell = XTVar of XVariable | XTReg of XRegister | XTDeref of XRegister * int | XTByteReg of XByteRegister
and XRegister = Rsp | Rbp | Rax | Rbx | Rcx | Rdx | Rsi | Rdi | R8 | R9 | R10 | R11 | R12 | R13 | R14 | R15
and XByteRegister = Ral | Rah
|
Added gen-x86/XSelect.fs.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 |
namespace nanopass.Generators
module X86Select =
open nanopass.CLanguage
open nanopass.Generators.X86
(*
(assign x (+ y z)) ⇒ [(movq (var y) (var x)) ; (addq (var z) (var x))]
(assign x (+ 10 32)) ⇒ [(movq (int 10) (var x)) ; (addq (int 32) (var x))]
(assign x (+ y 10)) ⇒ [(movq (var y) (var x)) ; (addq (int 10) (var x))]
(assign x (+ 10 y)) ⇒ [(movq (int 10) (var x)) ; (addq (var y) (var x))]
(assign x (+ 10 x)) ⇒ [(addq (int 10) (var x))]
(assign x (+ x 10)) ⇒ [(addq (int 10) (var x))]
(assign x (+ x x)) ⇒ [(addq (var x) (var x))]
(assign x (- y z)) ⇒ [(movq (var y) (var x)) ; (subq (var z) (var x))]
(assign x (- 10 32)) ⇒ [(movq (int 10) (var x)) ; (subq (int 32) (var x))]
(assign x (- y 10)) ⇒ [(movq (var y) (var x)) ; (subq (int 10) (var x))]
(assign x (- 10 y)) ⇒ [(movq (int 10) (var x)) ; (subq (var y) (var x))]
(assign x (- 10 x)) ⇒ [(addq (int -10) (var x))]
(assign x (- x 10)) ⇒ [(subq (int 10) (var x))]
(assign x (- x x)) ⇒ [(subq (var x) (var x))]
(assign x ('* y z)) ⇒ [(movq (var y) (var x)) ; (mulq (var z) (var x))]
(assign x ('* 10 32)) ⇒ [(movq (int 10) (var x)) ; (mulq (int 32) (var x))]
(assign x ('* y 10)) ⇒ [(movq (var y) (var x)) ; (mulq (int 10) (var x))]
(assign x ('* 10 y)) ⇒ [(movq (int 10) (var x)) ; (mulq (var y) (var x))]
(assign x ('* 10 x)) ⇒ [(mulq (int 10) (var x))]
(assign x ('* x 10)) ⇒ [(mulq (int 10) (var x))]
(assign x ('* x x)) ⇒ [(mulq (var x) (var x))]
(assign x (/ y z)) ⇒ [(movq (var y) (var x)) ; (divq (var z) (var x))]
(assign x (/ 10 32)) ⇒ [(movq (int 10) (var x)) ; (divq (int 32) (var x))]
(assign x (/ y 10)) ⇒ [(movq (var y) (var x)) ; (divq (int 10) (var x))]
(assign x (/ 10 y)) ⇒ [(movq (int 10) (var x)) ; (divq (var y) (var x))]
(assign x (/ 10 x)) ⇒
[(movq (int 10) (var tmp.0)) ; (divq (var x) (var tmp.0)); (movq (var tmp.0) (var x))]
[(pushq (var x)); (movq (int 10) (var x)); (popq (reg a)); (divq (reg a) (var x))]
(assign x (/ x 10)) ⇒ [(divq (int 10) (var x))]
(assign x (/ x x)) ⇒
[(divq (var x) (var x))]
[(movq (int 1) (var x))]
*)
type VarPosition = VP_None | VP_Left | VP_Right | VP_Both
let hasArgName arg name =
match arg with
| CBoolVar vname
| CIntVar vname -> name = vname
| _ -> false
let hasExpVar exp name =
match exp with
| CRead -> false
| CValue arg
| CNot arg
| CNeg arg -> hasArgName arg name
| CAnd (arg1, arg2)
| COr (arg1, arg2)
| CXOr (arg1, arg2)
| CAdd (arg1, arg2)
| CSub (arg1, arg2)
| CMul (arg1, arg2)
| CDiv (arg1, arg2)
| CCmpEq (arg1, arg2)
| CCmpNeq (arg1, arg2)
| CCmpLt (arg1, arg2)
| CCmpGt (arg1, arg2)
| CCmpLe (arg1, arg2)
| CCmpGe (arg1, arg2) -> hasArgName arg1 name || hasArgName arg2 name
let expVarPos exp name =
match exp with
| CRead -> VP_None
| CValue arg
| CNot arg
| CNeg arg ->
if hasArgName arg name then
VP_Left
else
VP_None
| CAnd (arg1, arg2)
| COr (arg1, arg2)
| CXOr (arg1, arg2)
| CAdd (arg1, arg2)
| CSub (arg1, arg2)
| CMul (arg1, arg2)
| CDiv (arg1, arg2)
| CCmpEq (arg1, arg2)
| CCmpNeq (arg1, arg2)
| CCmpLt (arg1, arg2)
| CCmpGt (arg1, arg2)
| CCmpLe (arg1, arg2)
| CCmpGe (arg1, arg2) ->
let e1 = hasArgName arg1 name
let e2 = hasArgName arg2 name
match (e1, e2) with
| (false, false) -> VP_None
| (false, true) -> VP_Right
| (true, false) -> VP_Left
| (true, true) -> VP_Both
let isAsgmtShort stmt =
match stmt with
| CAssign (vname, exp) ->
hasExpVar exp vname
| _ -> false
let x0genArg arg =
match arg with
| CInt v -> XInt v
| CBool m -> if m then XInt 1 else XInt 0
| CIntVar vname -> XIntVar vname
| CBoolVar vname -> XBoolVar vname
let x0gen tvar exp =
match exp with
| CAnd (arg1, arg2) ->
match expVarPos exp tvar with
| VP_None -> []
| VP_Left -> []
| VP_Right | VP_Both -> []
| CAdd (arg1, arg2) ->
match expVarPos exp tvar with
| VP_None -> [MovQ(x0genArg arg1, XTVar tvar); AddQ(x0genArg arg2, XTVar tvar)]
| VP_Left -> [AddQ(x0genArg arg2, XTVar tvar)]
| VP_Right | VP_Both -> [AddQ(x0genArg arg1, XTVar tvar)]
| CSub (arg1, arg2) ->
match expVarPos exp tvar with
| VP_None -> [MovQ(x0genArg arg1, XTVar tvar); SubQ(x0genArg arg2, XTVar tvar)]
| VP_Left | VP_Both -> [SubQ(x0genArg arg2, XTVar tvar)]
| VP_Right -> [NegQ(XTVar tvar); AddQ(x0genArg arg1, XTVar tvar)]
| CNeg arg ->
match expVarPos exp tvar with
| VP_None -> [MovQ(x0genArg arg, XTVar tvar); NegQ(XTVar tvar)]
| _ -> [NegQ(XTVar tvar)]
| CMul (arg1, arg2) ->
match expVarPos exp tvar with
| VP_None -> [MovQ(x0genArg arg1, XTVar tvar); MulQ(x0genArg arg2, XTVar tvar)]
| VP_Left -> [MulQ(x0genArg arg2, XTVar tvar)]
| VP_Right | VP_Both -> [MulQ(x0genArg arg1, XTVar tvar)]
| CDiv (arg1, arg2) ->
match expVarPos exp tvar with
| VP_None -> [MovQ(x0genArg arg1, XTVar tvar); DivQ(x0genArg arg2, XTVar tvar)]
| VP_Left | VP_Both -> [DivQ(x0genArg arg2, XTVar tvar)]
| VP_Right -> [MovQ(XVar tvar, XTReg Rax); DivQ(x0genArg arg1, XTReg Rax); MovQ(XReg Rax, XTVar tvar)]
| CRead ->
[CallQ "read_int"; MovQ(XReg Rax, XTVar tvar)]
| CValue arg ->
match expVarPos exp tvar with
| VP_None -> [MovQ(x0genArg arg, XTVar tvar)]
| _ -> []
(*
let x0SelectInstr stmt =
match stmt with
| CAssign(vname, exp) -> x0gen vname exp
| CReturn(arg) -> [MovQ(x0genArg arg, XTReg Rax)]
let selectInstruction prg =
match prg with
| CProgram (vars, stmts) ->
XProgramAbs(vars, List.collect x0SelectInstr stmts)
let rec x0reduct reductor nStmts stmts =
match stmts with
| instr1::tStmts ->
match tStmts with
| instr2::rStmts ->
let res = reductor instr1 instr2
match res with
| Some(r) -> x0reduct reductor nStmts (r::rStmts)
| None -> x0reduct reductor (nStmts@[instr1]) tStmts
| [] -> nStmts@[instr1]
| [] -> nStmts
let reduction reductor prg =
match prg with
| XProgramAbs (vars, stmts) ->
XProgramAbs(vars, x0reduct reductor [] stmts)
| XProgramImp (_) -> prg
*)
|
Added gen-x86/gen-x86.fsproj.
> > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net7.0</TargetFramework>
<RootNamespace>gen_x86</RootNamespace>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
</PropertyGroup>
<ItemGroup>
<Compile Include="XLang.fs" />
<Compile Include="XSelect.fs" />
<Compile Include="XHomes.fs" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\clang\clang.fsproj" />
</ItemGroup>
</Project>
|
Added gen-x86/tests/Program.fs.
> > > > | 1 2 3 4 |
module Program =
[<EntryPoint>]
let main _ = 0
|
Added gen-x86/tests/UnitTest1.fs.
> > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 |
module gen_x86.tests
open NUnit.Framework
[<SetUp>]
let Setup () =
()
[<Test>]
let Test1 () =
Assert.Pass()
|
Added gen-x86/tests/gen-x86.tests.fsproj.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 |
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net7.0</TargetFramework>
<RootNamespace>gen_x86.tests</RootNamespace>
<IsPackable>false</IsPackable>
<GenerateProgramFile>false</GenerateProgramFile>
<IsTestProject>true</IsTestProject>
</PropertyGroup>
<ItemGroup>
<Compile Include="UnitTest1.fs" />
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.5.0" />
<PackageReference Include="NUnit" Version="3.13.3" />
<PackageReference Include="NUnit3TestAdapter" Version="4.4.2" />
<PackageReference Include="NUnit.Analyzers" Version="3.6.1" />
<PackageReference Include="coverlet.collector" Version="3.2.0" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\gen-x86.fsproj" />
</ItemGroup>
</Project>
|
Added nanopass.sln.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 |
Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio Version 17
VisualStudioVersion = 17.0.31903.59
MinimumVisualStudioVersion = 10.0.40219.1
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "rlang", "rlang\rlang.fsproj", "{1E753FFA-C39A-4471-8FD0-14E22E1969DE}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "clang", "clang\clang.fsproj", "{81C016C3-BDF9-4C20-BD55-276E4C764B8B}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "mylog", "mylog\mylog.fsproj", "{C71DC09D-5739-4284-849F-147147D14727}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "cgraph", "cgraph\cgraph.fsproj", "{8C19601F-5B0D-4F72-B11E-1687504813A9}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "rctrans", "rctrans\rctrans.fsproj", "{59EDB692-CA58-496F-9099-4CC36DDB4210}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ucomp", "ucomp\ucomp.fsproj", "{3F0842CA-C22F-4551-A019-B72C17DCB69B}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "clang.tests", "clang\tests\clang.tests.fsproj", "{CEF714DF-FC4C-4253-AF3D-97958D3EBF27}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "rlang.tests", "rlang\tests\rlang.tests.fsproj", "{FC6F48ED-5BAF-48AE-97AD-820A4E4C5F21}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "rctrans.tests", "rctrans\tests\rctrans.tests.fsproj", "{CB32AD2E-7C88-4C9E-9315-976781AABEC5}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "gen-x86.tests", "gen-x86\tests\gen-x86.tests.fsproj", "{21401B63-CF86-4E03-B560-CFDC2B96F0E5}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "gen-x86", "gen-x86\gen-x86.fsproj", "{D194073B-3ABA-469B-B664-B95DD1D4127F}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{1E753FFA-C39A-4471-8FD0-14E22E1969DE}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{1E753FFA-C39A-4471-8FD0-14E22E1969DE}.Debug|Any CPU.Build.0 = Debug|Any CPU
{1E753FFA-C39A-4471-8FD0-14E22E1969DE}.Release|Any CPU.ActiveCfg = Release|Any CPU
{1E753FFA-C39A-4471-8FD0-14E22E1969DE}.Release|Any CPU.Build.0 = Release|Any CPU
{81C016C3-BDF9-4C20-BD55-276E4C764B8B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{81C016C3-BDF9-4C20-BD55-276E4C764B8B}.Debug|Any CPU.Build.0 = Debug|Any CPU
{81C016C3-BDF9-4C20-BD55-276E4C764B8B}.Release|Any CPU.ActiveCfg = Release|Any CPU
{81C016C3-BDF9-4C20-BD55-276E4C764B8B}.Release|Any CPU.Build.0 = Release|Any CPU
{C71DC09D-5739-4284-849F-147147D14727}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{C71DC09D-5739-4284-849F-147147D14727}.Debug|Any CPU.Build.0 = Debug|Any CPU
{C71DC09D-5739-4284-849F-147147D14727}.Release|Any CPU.ActiveCfg = Release|Any CPU
{C71DC09D-5739-4284-849F-147147D14727}.Release|Any CPU.Build.0 = Release|Any CPU
{8C19601F-5B0D-4F72-B11E-1687504813A9}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{8C19601F-5B0D-4F72-B11E-1687504813A9}.Debug|Any CPU.Build.0 = Debug|Any CPU
{8C19601F-5B0D-4F72-B11E-1687504813A9}.Release|Any CPU.ActiveCfg = Release|Any CPU
{8C19601F-5B0D-4F72-B11E-1687504813A9}.Release|Any CPU.Build.0 = Release|Any CPU
{59EDB692-CA58-496F-9099-4CC36DDB4210}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{59EDB692-CA58-496F-9099-4CC36DDB4210}.Debug|Any CPU.Build.0 = Debug|Any CPU
{59EDB692-CA58-496F-9099-4CC36DDB4210}.Release|Any CPU.ActiveCfg = Release|Any CPU
{59EDB692-CA58-496F-9099-4CC36DDB4210}.Release|Any CPU.Build.0 = Release|Any CPU
{3F0842CA-C22F-4551-A019-B72C17DCB69B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{3F0842CA-C22F-4551-A019-B72C17DCB69B}.Debug|Any CPU.Build.0 = Debug|Any CPU
{3F0842CA-C22F-4551-A019-B72C17DCB69B}.Release|Any CPU.ActiveCfg = Release|Any CPU
{3F0842CA-C22F-4551-A019-B72C17DCB69B}.Release|Any CPU.Build.0 = Release|Any CPU
{CEF714DF-FC4C-4253-AF3D-97958D3EBF27}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{CEF714DF-FC4C-4253-AF3D-97958D3EBF27}.Debug|Any CPU.Build.0 = Debug|Any CPU
{CEF714DF-FC4C-4253-AF3D-97958D3EBF27}.Release|Any CPU.ActiveCfg = Release|Any CPU
{CEF714DF-FC4C-4253-AF3D-97958D3EBF27}.Release|Any CPU.Build.0 = Release|Any CPU
{FC6F48ED-5BAF-48AE-97AD-820A4E4C5F21}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{FC6F48ED-5BAF-48AE-97AD-820A4E4C5F21}.Debug|Any CPU.Build.0 = Debug|Any CPU
{FC6F48ED-5BAF-48AE-97AD-820A4E4C5F21}.Release|Any CPU.ActiveCfg = Release|Any CPU
{FC6F48ED-5BAF-48AE-97AD-820A4E4C5F21}.Release|Any CPU.Build.0 = Release|Any CPU
{CB32AD2E-7C88-4C9E-9315-976781AABEC5}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{CB32AD2E-7C88-4C9E-9315-976781AABEC5}.Debug|Any CPU.Build.0 = Debug|Any CPU
{CB32AD2E-7C88-4C9E-9315-976781AABEC5}.Release|Any CPU.ActiveCfg = Release|Any CPU
{CB32AD2E-7C88-4C9E-9315-976781AABEC5}.Release|Any CPU.Build.0 = Release|Any CPU
{21401B63-CF86-4E03-B560-CFDC2B96F0E5}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{21401B63-CF86-4E03-B560-CFDC2B96F0E5}.Debug|Any CPU.Build.0 = Debug|Any CPU
{21401B63-CF86-4E03-B560-CFDC2B96F0E5}.Release|Any CPU.ActiveCfg = Release|Any CPU
{21401B63-CF86-4E03-B560-CFDC2B96F0E5}.Release|Any CPU.Build.0 = Release|Any CPU
{D194073B-3ABA-469B-B664-B95DD1D4127F}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{D194073B-3ABA-469B-B664-B95DD1D4127F}.Debug|Any CPU.Build.0 = Debug|Any CPU
{D194073B-3ABA-469B-B664-B95DD1D4127F}.Release|Any CPU.ActiveCfg = Release|Any CPU
{D194073B-3ABA-469B-B664-B95DD1D4127F}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
GlobalSection(NestedProjects) = preSolution
{21401B63-CF86-4E03-B560-CFDC2B96F0E5} = {D194073B-3ABA-469B-B664-B95DD1D4127F}
EndGlobalSection
EndGlobal
|
Added rctrans/Library.fs.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 |
namespace nanopass
module RCTranslator =
open nanopass.RLanguage
open nanopass.CLanguage
open nanopass.CLanguageOp
exception TranslationError of string
let newTempSym = newTempSym calcNextOffset
let addNamedSym = addNamedSym calcNextOffset
let flatten exp symtab stmts =
let make_var_arg dtype name =
match dtype with
| CTypeBool -> CBoolVar name
| CTypeInt -> CIntVar name
| _ -> CIntVar name
let rec flatten exp symtab stmts =
match exp with
| RInt v ->
let newVar, symtab = newTempSym CTypeInt symtab
let symtab = updateAccessCnt true newVar symtab
(newVar, CTypeInt, symtab, List.append stmts [CAssign(newVar, CValue (CInt v))])
| RBool v ->
let newVar, symtab = newTempSym CTypeBool symtab
let symtab = updateAccessCnt true newVar symtab
(newVar, CTypeBool, symtab, List.append stmts [CAssign(newVar, CValue (CBool v))])
| RNeg (exp) ->
let gen , st = symtab
let arg, dt, symtab, nStmts = flatten exp (gen + 1, st) stmts
let symtab = updateAccessCnt false arg symtab
let newVar, symtab = newTempSym CTypeInt symtab
let symtab = updateAccessCnt true newVar symtab
(newVar, dt, symtab, List.append nStmts [CAssign(newVar, CNeg (make_var_arg dt arg))])
| RRead ->
let newVar, symtab = newTempSym CTypeAny symtab
let symtab = updateAccessCnt true newVar symtab
(newVar, CTypeAny, symtab, List.append stmts [CAssign(newVar, CRead)])
| RVar name ->
if existsVar name symtab then
let dt = getVarType name symtab
//let symtab = updateAccessCnt false name symtab
if dt = CUnknown then raise (TranslationError $"variable '{name}' not found or has wrong descriptor")
(name, dt, symtab, stmts)
else
raise (TranslationError $"variable '{name}' not found")
| RLet (name, expInit, expBody) ->
let bindVar, dtype, symtab, stmts = flatten expInit symtab stmts
let symtab = addNamedSym name dtype symtab |> updateAccessCnt true name
let stmts = List.append stmts [CAssign(name, CValue (make_var_arg dtype bindVar))]
let bodyVar, dtypeBody, symtab, stmts = flatten expBody symtab stmts
(bodyVar, dtypeBody, symtab, stmts)
| RBinary (op, expR, expL) ->
let varR, dtR, symtab, stmts = flatten expR symtab stmts
let varL, dtL, symtab, stmts = flatten expL symtab stmts
let symtab = updateAccessCnt false varL symtab |> updateAccessCnt false varR
if dtR <> dtL then raise (TranslationError $"operator {op} arguments have different types: {dtR} {dtL}")
let x = match op with
| Add -> CAdd (CIntVar varR, CIntVar varL), CTypeInt
| Sub -> CSub (CIntVar varR, CIntVar varL), CTypeInt
| Mul -> CMul (CIntVar varR, CIntVar varL), CTypeInt
| Div -> CDiv (CIntVar varR, CIntVar varL), CTypeInt
| And -> CAnd (CBoolVar varR, CBoolVar varL), CTypeBool
| Or -> COr (CBoolVar varR, CBoolVar varL), CTypeBool
| Xor -> CXOr (CBoolVar varR, CBoolVar varL), CTypeBool
if dtR <> (snd x) then raise (TranslationError $"first argument of the operator '{op}' has wrong type '{dtR}'")
if dtL <> (snd x) then raise (TranslationError $"second argument of the operator '{op}' has wrong type '{dtL}'")
let newVar, symtab = newTempSym (snd x) symtab
let symtab = updateAccessCnt false newVar symtab
(newVar, (snd x), symtab, List.append stmts [CAssign(newVar, (fst x))])
| RIfStmt (cond, expT, expF) ->
let condVar, dtC, symtab, stmts = flatten cond symtab stmts
let varT, dtypeT, symtab, stmtsT = flatten expT symtab []
let varF, dtypeF, symtab, stmtsF = flatten expF symtab []
let symtab = updateAccessCnt false condVar symtab
|> updateAccessCnt false varT
|> updateAccessCnt false varF
if dtC <> CTypeBool then raise (TranslationError $"IF condition expression has wrong type {dtC}, expected BOOLEAN")
if dtypeT <> dtypeF then raise (TranslationError $"IF branches have different data types")
let newVar, symtab = newTempSym dtypeT symtab
let symtab = updateAccessCnt true newVar symtab |> updateAccessCnt true newVar
let stmtsT = List.append stmtsT [CAssign(newVar, CValue (make_var_arg dtypeT varT))]
let stmtsF = List.append stmtsF [CAssign(newVar, CValue (make_var_arg dtypeT varF))]
(newVar, dtypeT, symtab, List.append stmts [CIfStmt(CBoolVar condVar, stmtsT, stmtsF)])
| RCompare (cmp, expA, expB) ->
let varA, dtA, symtab, stmts = flatten expA symtab stmts
let varB, dtB, symtab, stmts = flatten expB symtab stmts
let symtab = updateAccessCnt false varA symtab |> updateAccessCnt false varB
if dtA <> dtB then raise (TranslationError $"arguments of the comparision operator have different data types")
if dtA <> CTypeInt then raise (TranslationError $"first argument of the comparision operator has wrong type")
if dtB <> CTypeInt then raise (TranslationError $"second argument of the comparision operator has wrong type")
let x=
match cmp with
| CmpEq -> CCmpEq (CIntVar varA, CIntVar varB)
| CmpLt -> CCmpLt (CIntVar varA, CIntVar varB)
| CmpGt -> CCmpGt (CIntVar varA, CIntVar varB)
| CmpLe -> CCmpLe (CIntVar varA, CIntVar varB)
| CmpGe -> CCmpGe (CIntVar varA, CIntVar varB)
let newVar, symtab = newTempSym CTypeBool symtab
let symtab = updateAccessCnt false newVar symtab
(newVar, CTypeBool, symtab, List.append stmts [CAssign(newVar, x)])
let var, dtype, symtab, stmts = flatten exp symtab stmts
let symtab = updateAccessCnt false var symtab
let stmts = List.append stmts [CReturn(make_var_arg dtype var)]
(symtab, stmts)
|
Added rctrans/README.md.
> > > > > > > > > | 1 2 3 4 5 6 7 8 9 |
# Транслятор R-lang -> Cx-lang
В целом довольно простая штука получается за исключением двух моментов:
1. Трансляция RRead - тип временной переменной не определен. И тут вопрос если принять что эта функция не полиморфная то значит тип у нее только один - CTypeInt. Но на следующем шаге надо будет преобразовывать int -> bool.
2. Трансялция RIfStmt - тип определяется контекстом...
(Let "A", RInt 10, RIfStmt (Var "B", RInt 1, RBool false))
Как транслировать такое выражение? Получается что тип выражение ЕСЛИ зависит от объемлющих подвыражений в каждой ветви и они должны быть одинаковыми!
Ага. Тогда каждая ветвь должна присвивать результат одной и той же временной переменной.
|
Added rctrans/rctrans.fsproj.
> > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 |
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net7.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
</PropertyGroup>
<ItemGroup>
<Compile Include="Library.fs" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\rlang\rlang.fsproj" />
<ProjectReference Include="..\clang\clang.fsproj" />
</ItemGroup>
</Project>
|
Added rctrans/rctrans.sln.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 |
Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio Version 17
VisualStudioVersion = 17.0.31903.59
MinimumVisualStudioVersion = 10.0.40219.1
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "rctrans", "rctrans.fsproj", "{6A537AF8-3CDB-4BE0-AAC5-092C67414FC1}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "rctrans.tests", "tests\rctrans.tests.fsproj", "{770EA28D-8F28-4ED4-AA66-437FD69F8609}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{6A537AF8-3CDB-4BE0-AAC5-092C67414FC1}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{6A537AF8-3CDB-4BE0-AAC5-092C67414FC1}.Debug|Any CPU.Build.0 = Debug|Any CPU
{6A537AF8-3CDB-4BE0-AAC5-092C67414FC1}.Release|Any CPU.ActiveCfg = Release|Any CPU
{6A537AF8-3CDB-4BE0-AAC5-092C67414FC1}.Release|Any CPU.Build.0 = Release|Any CPU
{770EA28D-8F28-4ED4-AA66-437FD69F8609}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{770EA28D-8F28-4ED4-AA66-437FD69F8609}.Debug|Any CPU.Build.0 = Debug|Any CPU
{770EA28D-8F28-4ED4-AA66-437FD69F8609}.Release|Any CPU.ActiveCfg = Release|Any CPU
{770EA28D-8F28-4ED4-AA66-437FD69F8609}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
EndGlobal
|
Added rctrans/tests/Program.fs.
> > > > | 1 2 3 4 |
module Program =
[<EntryPoint>]
let main _ = 0
|
Added rctrans/tests/UnitTest1.fs.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 |
module rctrans.tests
open NUnit.Framework
open nanopass.RLanguage
open nanopass.CLanguage
open nanopass.CLanguageOp
open nanopass.RCTranslator
[<SetUp>]
let Setup () =
()
[<Test>]
let ``RCTranslator:flatten - test A1`` () =
let exp = RLet ("a", RInt 0, RInt -1)
let expected = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
CAssign ("tmp.2", CValue (CInt -1));
CReturn (CIntVar "tmp.2")
]
let x, z = flatten exp (0, Map.empty) []
Assert.That(z, Is.EquivalentTo(expected))
[<Test>]
let ``RCTranslator:flatten - test A1-1`` () =
let exp = RLet ("a", RVar "a", RInt -1)
try
let x, z = flatten exp (0, Map.empty) []
Assert.Fail()
with
| TranslationError(str) -> Assert.Pass(str)
| _ -> Assert.Fail("other exceptions")
[<Test>]
let ``RCTranslator:flatten - test A2`` () =
let exp = RLet ("a", RInt 0, RRead)
let expected = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
CAssign ("tmp.2", CRead);
CReturn (CIntVar "tmp.2")
]
let x, z = flatten exp (0, Map.empty) []
Assert.That(z, Is.EquivalentTo(expected))
[<Test>]
let ``RCTranslator:flatten - test A2-1`` () =
let exp = RLet ("a", RRead, RVar "a")
try
let symtab, _ = flatten exp (0, Map.empty) []
match getVar "a" symtab with
| Some(v) ->
Assert.AreEqual(v.auto, false)
Assert.AreEqual(v.rdcnt, 1)
Assert.AreEqual(v.wrcnt, 1)
| None -> Assert.Fail()
with
| TranslationError(str) -> Assert.Pass(str)
| ex -> Assert.Warn($"other exceptions {ex}")
[<Test>]
let ``RCTranslator:flatten - test A3`` () =
let exp = RLet ("a", RInt 0, RNeg (RInt -1))
let expected = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
CAssign ("tmp.3", CValue (CInt -1));
CAssign ("tmp.4", CNeg (CIntVar "tmp.3"));
CReturn (CIntVar "tmp.4")
]
let x, z = flatten exp (0, Map.empty) []
Assert.That(z, Is.EquivalentTo(expected))
[<Test>]
let ``RCTranslator:flatten - test A4`` () =
let exp = RLet ("a", RInt 0, RVar "b")
let expected = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
CReturn (CIntVar "b")
]
try
flatten exp (0, Map.empty) [] |> ignore
with
| TranslationError(str) -> Assert.Pass()
| _ as exp -> Assert.Fail($"unexpected Exception: {exp}")
[<Test>]
let ``RCTranslator:flatten - test A5`` () =
let dt = getVarType "name" (0, Map.empty)
Assert.AreEqual(dt, CUnknown)
[<Test>]
let ``RCTranslator:flatten - test A6`` () =
let exp = RLet ("a", RInt 0, RVar "b")
let expected = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
CReturn (CIntVar "b")
]
try
let symtab = addNamedSym "b" CTypeInt (0, Map.empty)
let symtab, z = flatten exp symtab []
Assert.That(z, Is.EquivalentTo(expected))
match getVar "a" symtab with
| Some v ->
Assert.AreEqual(v.rdcnt, 0)
Assert.AreEqual(v.wrcnt, 1)
| None -> Assert.Fail()
with
| TranslationError(str) -> Assert.Fail()
| _ -> Assert.Fail()
[<Test>]
let ``RCTranslator:flatten - test A7-1`` () =
let exp = RLet ("a", RInt 0, RBinary(Add, RVar "b", RInt 1))
let expected = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
CAssign ("tmp.2", CValue (CInt 1));
CAssign ("tmp.3", CAdd (CIntVar "b", CIntVar "tmp.2"))
CReturn (CIntVar "tmp.3")
]
try
let symtab = addNamedSym "b" CTypeInt (0, Map.empty)
let _, z = flatten exp symtab []
Assert.That(z, Is.EquivalentTo(expected))
with
| TranslationError(str) -> Assert.Fail()
| _ -> Assert.Fail()
[<Test>]
let ``RCTranslator:flatten - test A7-1 acc`` () =
let exp = RLet ("a", RInt 0, RBinary(Add, RVar "a", RInt 1))
let expected = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
CAssign ("tmp.2", CValue (CInt 1));
CAssign ("tmp.3", CAdd (CIntVar "a", CIntVar "tmp.2"))
CReturn (CIntVar "tmp.3")
]
try
let symtab = addNamedSym "b" CTypeInt (0, Map.empty)
let symtab, z = flatten exp symtab []
Assert.That(z, Is.EquivalentTo(expected))
match getVar "a" symtab with
| Some v ->
Assert.AreEqual(1, v.rdcnt)
Assert.AreEqual(1, v.wrcnt)
| None -> Assert.Fail("unexpected non-existed variable")
with
| TranslationError(str) -> Assert.Fail(str)
| _ as exp -> Assert.Fail($"unexpected Exception: {exp}")
[<Test>]
let ``RCTranslator:flatten - test A7-1 acc /2`` () =
let exp = RLet ("a", RInt 0, RVar "a")
let expected = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
CReturn (CIntVar "a")
]
try
let symtab = addNamedSym "b" CTypeInt (0, Map.empty)
let symtab, z = flatten exp symtab []
Assert.That(z, Is.EquivalentTo(expected))
match getVar "a" symtab with
| Some v ->
Assert.AreEqual(1, v.rdcnt)
Assert.AreEqual(1, v.wrcnt)
| None -> Assert.Fail("unexpected non-existed variable")
with
| TranslationError(str) -> Assert.Fail(str)
| _ as exp -> Assert.Fail($"unexpected Exception: {exp}")
[<Test>]
let ``RCTranslator:flatten - test A7-2`` () =
let exp = RLet ("a", RInt 0, RBinary(Sub, RVar "b", RInt 1))
let expected = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
CAssign ("tmp.2", CValue (CInt 1));
CAssign ("tmp.3", CSub (CIntVar "b", CIntVar "tmp.2"))
CReturn (CIntVar "tmp.3")
]
try
let symtab = addNamedSym "b" CTypeInt (0, Map.empty)
let _, z = flatten exp symtab []
Assert.That(z, Is.EquivalentTo(expected))
with
| TranslationError(str) -> Assert.Fail()
| _ -> Assert.Fail()
[<Test>]
let ``RCTranslator:flatten - test A7-3`` () =
let exp = RLet ("a", RInt 0, RBinary(Mul, RVar "b", RInt 1))
let expected = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
CAssign ("tmp.2", CValue (CInt 1));
CAssign ("tmp.3", CMul (CIntVar "b", CIntVar "tmp.2"))
CReturn (CIntVar "tmp.3")
]
try
let symtab = addNamedSym "b" CTypeInt (0, Map.empty)
let _, z = flatten exp symtab []
Assert.That(z, Is.EquivalentTo(expected))
with
| TranslationError(str) -> Assert.Fail()
| _ -> Assert.Fail()
[<Test>]
let ``RCTranslator:flatten - test A7-4`` () =
let exp = RLet ("a", RInt 0, RBinary(Div, RVar "b", RInt 1))
let expected = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
CAssign ("tmp.2", CValue (CInt 1));
CAssign ("tmp.3", CDiv (CIntVar "b", CIntVar "tmp.2"))
CReturn (CIntVar "tmp.3")
]
try
let symtab = addNamedSym "b" CTypeInt (0, Map.empty)
let _, z = flatten exp symtab []
Assert.That(z, Is.EquivalentTo(expected))
with
| TranslationError(str) -> Assert.Fail()
| _ -> Assert.Fail()
[<Test>]
let ``RCTranslator:flatten - test A7-5F`` () =
let exp = RLet ("a", RInt 0, RBinary(And, RVar "b", RInt 1))
let expected = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
CAssign ("tmp.2", CValue (CInt 1));
CAssign ("tmp.3", CAnd (CIntVar "b", CIntVar "tmp.2"))
CReturn (CIntVar "tmp.3")
]
try
let symtab = addNamedSym "b" CTypeInt (0, Map.empty)
let _, z = flatten exp symtab []
Assert.That(z, Is.EquivalentTo(expected))
with
| TranslationError(str) -> Assert.Pass(str)
| _ -> Assert.Fail()
[<Test>]
let ``RCTranslator:flatten - test A7-5T`` () =
let exp = RLet ("a", RBool false, RBinary(And, RVar "b", RBool true))
let expected = [
CAssign ("tmp.1", CValue (CBool false));
CAssign ("a", CValue (CBoolVar "tmp.1"));
CAssign ("tmp.2", CValue (CBool true));
CAssign ("tmp.3", CAnd (CBoolVar "b", CBoolVar "tmp.2"))
CReturn (CBoolVar "tmp.3")
]
try
let symtab = addNamedSym "b" CTypeBool (0, Map.empty)
let _, z = flatten exp symtab []
Assert.That(z, Is.EquivalentTo(expected))
with
| TranslationError(str) -> Assert.Fail(str)
| _ -> Assert.Fail()
[<Test>]
let ``RCTranslator:flatten - test A7-6`` () =
let exp = RLet ("a", RBool false, RNeg(RVar "a"))
let expected = [
CAssign ("tmp.1", CValue (CBool false));
CAssign ("a", CValue (CBoolVar "tmp.1"));
CAssign ("tmp.3", CNeg (CBoolVar "a"))
CReturn (CBoolVar "tmp.3")
]
try
let symtab = addNamedSym "b" CTypeInt (0, Map.empty)
let _, z = flatten exp symtab []
Assert.That(z, Is.EquivalentTo(expected))
with
| TranslationError(str) -> Assert.Fail(str)
| _ -> Assert.Fail()
[<Test>]
let ``RCTranslator:flatten - test A7-7`` () =
let exp = RLet ("a", RBool false, RNeg(RVar "a"))
let expected = [
CAssign ("tmp.1", CValue (CBool false));
CAssign ("a", CValue (CBoolVar "tmp.1"));
CAssign ("tmp.3", CNeg (CBoolVar "a"))
CReturn (CBoolVar "tmp.3")
]
try
let symtab = addNamedSym "b" CTypeInt (0, Map.empty)
let _, z = flatten exp symtab []
Assert.That(z, Is.EquivalentTo(expected))
with
| TranslationError(str) -> Assert.Fail(str)
| _ -> Assert.Fail()
|
Added rctrans/tests/UnitTest2.fs.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 |
module rctrans.tests2
open NUnit.Framework
open nanopass.RLanguage
open nanopass.CLanguage
open nanopass.RCTranslator
[<SetUp>]
let Setup () =
()
[<Test>]
let ``RCTranslator:flatten - test B1`` () =
let exp = RLet ("a", RInt 0, RIfStmt (RBool true, RInt -1, RVar "a"))
let expected = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
CAssign ("tmp.2", CValue (CBool true));
CIfStmt (CBoolVar "tmp.2",
[CAssign ("tmp.3", CValue (CInt -1)); CAssign ("tmp.4", CValue (CIntVar "tmp.3"))],
[CAssign ("tmp.4", CValue (CIntVar "a"))]);
CReturn (CIntVar "tmp.4")
]
let x, z = flatten exp (0, Map.empty) []
Assert.That(z, Is.EquivalentTo(expected))
[<Test>]
let ``RCTranslator:flatten - test B2`` () =
let exp = RLet ("a", RBool false, RIfStmt (RBool true, RBool true, RVar "a"))
let expected = [
CAssign ("tmp.1", CValue (CBool false));
CAssign ("a", CValue (CBoolVar "tmp.1"));
CAssign ("tmp.2", CValue (CBool true));
CIfStmt (CBoolVar "tmp.2",
[CAssign ("tmp.3", CValue (CBool true)); CAssign ("tmp.4", CValue (CBoolVar "tmp.3"))],
[CAssign ("tmp.4", CValue (CBoolVar "a"))]);
CReturn (CBoolVar "tmp.4")
]
let x, z = flatten exp (0, Map.empty) []
Assert.That(z, Is.EquivalentTo(expected))
[<Test>]
let ``RCTranslator:flatten - test B3`` () =
let exp = RLet ("a", RBool false, RIfStmt (RBool true, RBool true, RVar "a"))
let expected = [
CAssign ("tmp.1", CValue (CBool false));
CAssign ("a", CValue (CBoolVar "tmp.1"));
CAssign ("tmp.2", CValue (CBool true));
CIfStmt (CBoolVar "tmp.2",
[CAssign ("tmp.3", CValue (CBool true)); CAssign ("tmp.4", CValue (CBoolVar "tmp.3"))],
[CAssign ("tmp.4", CValue (CBoolVar "a"))]);
CReturn (CBoolVar "tmp.4")
]
let x, z = flatten exp (0, Map.empty) []
Assert.That(z, Is.EquivalentTo(expected))
[<Test>]
let ``RCTranslator:flatten - test B4`` () =
let exp = RLet ("a", RInt 0, RNeg (RBinary (Add, RInt 3, RInt 4)))
let expected = [
CAssign ("tmp.1", CValue (CInt 0));
CAssign ("a", CValue (CIntVar "tmp.1"));
CAssign ("tmp.3", CValue (CInt 3));
CAssign ("tmp.4", CValue (CInt 4));
CAssign ("tmp.5", CAdd (CIntVar "tmp.3", CIntVar "tmp.4"));
CAssign ("tmp.6", CNeg (CIntVar "tmp.5"));
CReturn (CIntVar "tmp.6")
]
let x, z = flatten exp (0, Map.empty) []
Assert.That(z, Is.EquivalentTo(expected))
|
Added rctrans/tests/rctrans.tests.fsproj.
> > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>net7.0</TargetFramework>
<IsPackable>false</IsPackable>
<GenerateProgramFile>false</GenerateProgramFile>
<IsTestProject>true</IsTestProject>
</PropertyGroup>
<ItemGroup>
<Compile Include="UnitTest1.fs" />
<Compile Include="UnitTest2.fs" />
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.5.0" />
<PackageReference Include="NUnit" Version="3.13.3" />
<PackageReference Include="NUnit3TestAdapter" Version="4.4.2" />
<PackageReference Include="NUnit.Analyzers" Version="3.6.1" />
<PackageReference Include="coverlet.collector" Version="3.2.0" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\rctrans.fsproj" />
</ItemGroup>
</Project>
|
Added rlang/RAEDME.md.
> > > > > | 1 2 3 4 5 |
# Язык вычисление Rx
Это очень простой язык задача которого вычислить единственное выражение.
interprete exp input -> exp
|
Changes to rlang/RPartialEval.fs.
| ︙ | ︙ | |||
129 130 131 132 133 134 135 |
| Div -> RBinary(Div, RInt(a * b), e)
| _ -> exp
| _ -> exp
| RBinary (Div, expL, expR) ->
if expL = expR then RInt 1 else exp
| _ -> exp
| | | | | | | | 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 |
| Div -> RBinary(Div, RInt(a * b), e)
| _ -> exp
| _ -> exp
| RBinary (Div, expL, expR) ->
if expL = expR then RInt 1 else exp
| _ -> exp
let rebuildNeg exp =
match exp with
| RNeg(RNeg(e)) ->
e
| RNeg(RBinary (Sub, expL, expR)) ->
RBinary(Sub, expR, expL)
| RNeg(RInt(a)) ->
RInt -a
| _ -> exp
let rebuildAddMulSame exp =
match exp with
| RBinary (Add, expL, expR) ->
match (expL, expR) with
| RBinary(Mul, x, y), RBinary(Mul, u, w) ->
|
| ︙ | ︙ |