Nanopass Framework on F#

Changes On Branch new-ghost-var
Login

Changes On Branch new-ghost-var

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

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 clang
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, CVarHolder>
    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 = {  
    and CVariable = CDataType * int   // (data type, offset in memory)
    and CVarHolder = { var: CVariable;  ghost : bool; rdcnt : int; wrcnt : int } // (<var>, is ghost / hidden, read counter, write counter)
                        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
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






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
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 isGhost offset arg =
(* let makeSymByArg offset arg =
        match arg with
            | CBoolVar name -> Some (name, {var = (CTypeBool, offset); ghost = isGhost; rdcnt = 0; wrcnt = 0})
            | CIntVar name -> Some (name, {var = (CTypeInt, offset); ghost = isGhost; rdcnt = 0; wrcnt = 0})
            | 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 varh =
    let updateSymCnt written varInfo =
        if written then 
            {varh with wrcnt = varh.wrcnt + 1} 
            {varInfo with wrcnt = varInfo.wrcnt + 1} 
        else 
            {varh with rdcnt = varh.rdcnt + 1}
            {varInfo with rdcnt = varInfo.rdcnt + 1}

    let calcNextOffset lastVar =
        match fst (lastVar.var) with
        | CTypeBool -> snd (lastVar.var) + 1
        | CTypeInt -> snd (lastVar.var) + 4
        | _ -> snd (lastVar.var) + 8

    let addSym calcNextOffset isGhost arg syms =
    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 (snd (v.var) > (snd (s.var))) then v else s) firstVar 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 isGhost newOffs arg with
            | Some (name, vh) -> Map.add name vh syms
        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
174

175
176
177
178
179
180
181
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 isGhost varname expConstructor arg1Name arg2Name prg =
    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

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

1
2
3
4
5
6
7
8
-
+







namespace clang
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
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
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
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
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

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 CLanguage
open nanopass.CLanguage
open nanopass.CLanguageOp

[<SetUp>]
let Setup () =
    ()

[<Test>]
let Test1 () =
    Assert.Pass()

[<Test>]
let ``test addSym`` () =
    let syms = Map.add "a" {var = (CTypeBool, 0); ghost = true; rdcnt = 0; wrcnt = 0} (Map.empty)
    let syms' = addSym (CBoolVar "f1") syms
    Assert.AreNotEqual(syms, syms')
    Assert.AreNotSame(syms, syms')
    Assert.AreEqual({var = (CTypeBool, 1); ghost = false; rdcnt = 0; wrcnt = 0}, Map.find "f1" syms')
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 (CBoolVar "f1") syms |> updateSym false (CBoolVar "f1")
    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 (CBoolVar "f1") syms |> updateSym true (CBoolVar "f1")
    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 (CBoolVar "f1") 
        |> addSym (CBoolVar "f2")
        |> 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 (CBoolVar "f1") 
        |> addSym (CBoolVar "f2")
    let prg = (syms, []) |> addAssign "f3" (CAnd(CBoolVar "f1", CBoolVar "f2"))
        |> 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 "f3" newAddInt "f1" "f2"
            |> 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
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
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
136

137
138
139
140
141
142
143





144
145
146
147
148
149
150
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 =
    let rebuildNeg exp =
        match exp with
        | RNeg(RNeg(e)) ->
			e
		| RNeg(RBinary (Sub, expL, expR)) ->
			RBinary(Sub, expR, expL)
		| RNeg(RInt(a) ->
			RInt -a
            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) ->