Mercurial > repos > tabletprog

annotate modules/llcompile.tp @ 342:884cd5d54c0f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Bugfix to array find:withDefault and a small optimization to array map
author Michael Pavone <pavone@retrodev.com>
date Sun, 05 Apr 2015 22:49:40 -0700
parents f987bb2a1911
children f74ce841fd1e
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
310
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
1 {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
2 _compileError <- :_msg _line {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
3 #{
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
4 isError? <- { true }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
5 msg <- { _msg }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
6 line <- { _line }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
7 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
8 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
9
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
10 _notError <- :vals ifnoterr {
315
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
11 if: (object does: vals understand?: "find") {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
12 maybeErr <- vals find: :val {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
13 (object does: val understand?: "isError?") && val isError?
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
14 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
15 maybeErr value: :err {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
16 err
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
17 } none: ifnoterr
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
18 } else: ifnoterr
310
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
19 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
20
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
21 _ilFun <- :_name {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
22 _buff <- #[]
315
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
23 _blockStack <- []
310
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
24 _nextReg <- 0
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
25 #{
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
26 name <- { _name }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
27 add <- :inst { _buff append: inst }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
28 getReg <- {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
29 r <- il reg: _nextReg
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
30 _nextReg <- _nextReg + 1
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
31 r
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
32 }
315
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
33 startBlock <- {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
34 _blockStack <- _buff | _blockStack
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
35 _buff <- #[]
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
36 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
37 popBlock <- {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
38 res <- _buff
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
39 _buff <- _blockStack value
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
40 _blockStack <- _blockStack tail
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
41 res
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
42 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
43 buffer <- { _buff }
310
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
44 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
45 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
46
315
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
47 _exprHandlers <- false
310
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
48 _compileExpr:syms:ilfun:dest <- :expr :syms :ilf :dst {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
49 _exprHandlers ifget: (expr nodeType) :handler {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
50 handler: expr syms ilf dst
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
51 } else: {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
52 _compileError: "Expression with node type " . (expr nodeType) . " not implemented yet"
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
53 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
54 }
315
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
55 _opMap <- false
310
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
56
315
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
57 _compOps <- false
310
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
58
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
59 _compileBinary <- :expr syms ilf assignTo {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
60 _assignSize? <- false
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
61 _asize <- 0
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
62 dest <- option value: assignTo :asn {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
63 _assignSize? <- true
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
64 _asize <- asn size
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
65 asn
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
66 } none: {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
67 ilf getReg
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
68 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
69 l <- _compileExpr: (expr left) syms: syms ilfun: ilf assign: (option value: dest)
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
70 r <- _compileExpr: (expr right) syms: syms ilfun: ilf assign: (option none)
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
71 _notError: [(l) (r)] {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
72 lv <- l val
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
73 ls <- l size
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
74 rv <- r val
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
75 rs <- r size
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
76 _size <- if: ls > rs { ls } else: { rs }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
77 _signed <- (ls signed?) || (rs signed?)
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
78 _opMap ifget: (expr op) :ingen {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
79 ilf add: (ingen: lv rv (dest val) _size)
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
80 #{
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
81 val <- dest
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
82 size <- _size
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
83 signed? <- _signed
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
84 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
85 } else: {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
86 _compOps ifget: (expr op) :cond {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
87 ilf add: (il bool: cond dest)
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
88 #{
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
89 val <- dest
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
90 size <- il b
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
91 signed? <- false
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
92 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
93 } else: {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
94 _compileError: "Operator " . (expr op) . " is not supported yet\n" 0
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
95 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
96 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
97 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
98 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
99 _compileString <- :expr syms ilf assignTo {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
100
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
101 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
102 _compileInt <- :expr syms ilf assignTo {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
103 expr
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
104 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
105 _compileSym <- :expr syms ilf assignTo {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
106 syms ifDefined: (expr name) :def {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
107 def
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
108 } else: {
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
109 _compileError: "Symbol " . (expr name) . " is not defined in " . (ilf name)
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
110 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
111 }
315
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
112 _compileIf <- :expr syms ilf assignTo {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
113 if: ((expr args) length) != 2 {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
114 _compileError: "if takes exactly 2 arguments" 0
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
115 } else: {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
116 condArg <- (expr args) value
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
117 blockArg <- ((expr args) tail) value
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
118 cond <- _compileExpr: condArg syms: syms ilfun: ilf dest: (option none)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
119 _notError: [cond] {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
120 if: (blockArg nodeType) != (ast lambda) {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
121 _compileError: "second argument to if must be a lambda"
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
122 } else: {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
123 ilf add: (il cmp: condArg 0 (condArg size))
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
124 //TODO: Deal with if in return position
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
125 ilf startBlock
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
126 foreach: (blockArg expressions) :idx expr{
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
127 _compileExpr: expr syms: syms ilfun: ilf dest: (option none)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
128 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
129 block <- ilf popBlock
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
130 ilf add: (il skipIf: (il neq) block)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
131 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
132 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
133 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
134 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
135 _compileIfElse <- :expr syms ilf assignTo {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
136 if: ((expr args) length) != 2 {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
137 _compileError: "if takes exactly 2 arguments" 0
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
138 } else: {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
139 condArg <- (expr args) value
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
140 blockArg <- ((expr args) tail) value
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
141 elseArg <- (((expr args) tail) tail) value
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
142 cond <- _compileExpr: condArg syms: syms ilfun: ilf dest: (option none)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
143 _notError: [cond] {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
144 if: (blockArg nodeType) != (ast lambda) {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
145 _compileError: "second argument to if:else must be a lambda"
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
146 } else: {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
147 if: (elseArg nodeType) != (ast lambda) {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
148 _compileError: "third argument to if:else must be a lambda"
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
149 } else: {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
150 ilf add: (il cmp: condArg 0 (condArg size))
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
151 //TODO: Deal with if:else in return position
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
152 ilf startBlock
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
153 foreach: (blockArg expressions) :idx expr {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
154 _compileExpr: expr syms: syms ilfun: ilf dest: (option none)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
155 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
156 block <- ilf popBlock
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
157 ilf startBlock
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
158 foreach: (elseArg expressions) :idx expr {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
159 _compileExpr: expr syms: syms ilfun: ilf dest: (option none)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
160 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
161 elseblock <- ilf popBlock
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
162 ilf add: (il skipIf: (il neq) block else: elseblock)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
163 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
164 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
165 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
166 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
167 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
168 _funMap <- false
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
169 _compileCall <- :expr syms ilf assignTo {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
170 if: ((expr tocall) nodeType) = (ast sym) && (_funMap contains?: ((expr tocall) name)) {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
171 handler <- _funMap get: ((expr tocall) name) else: { false }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
172 handler: expr syms ilf assignTo
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
173 } else: {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
174 ctocall <- _compileExpr: (expr tocall) syms: syms ilfuN: ilf dest: (option none)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
175 cargs <- (expr args) map: :arg {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
176 _compileExpr: arg syms: syms ilfun: ilf dest: (option none)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
177 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
178 _notError: ctocall | cargs {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
179 ilf add: (il call: ctocall withArgs: cargs)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
180 il retr
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
181 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
182 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
183 }
310
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
184
315
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
185 _compileAssign <- :expr syms ilf assignTo {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
186 dest <- _compileExpr: (expr to) syms: syms ilfun: ilf dest: (option none)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
187 _notError: [dest] {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
188 value <- _compileExpr: (expr assign) syms: syms ilfun: ilf dest: dest
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
189 _notError: [value] {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
190 //TODO: adjust size of value if necessary
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
191 ilf add: (il mov: (value val) (dest val) (dest size))
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
192 value
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
193 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
194 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
195 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
196
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
197 _initDone? <- false
310
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
198 #{
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
199 import: [
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
200 binary
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
201 stringlit
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
202 intlit
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
203 sym
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
204 call
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
205 obj
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
206 sequence
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
207 assignment
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
208 lambda
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
209 ] from: ast
315
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
210 _initHandlers <- {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
211 if: (not: _initDone?) {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
212 _exprHandlers <- dict hash
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
213 _exprHandlers set: binary _compileBinary
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
214 _exprHandlers set: stringlit _compileString
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
215 _exprHandlers set: intlit _compileInt
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
216 _exprHandlers set: sym _compileSym
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
217 _exprHandlers set: assignment _compileAssign
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
218 _exprHandlers set: call _compileCall
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
219
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
220 _opMap <- dict hash
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
221 mapOp <- macro: :op ilfun {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
222 quote: (_opMap set: op :ina inb out size {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
223 il ilfun: ina inb out size
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
224 })
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
225 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
226 mapOp: "+" add
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
227 mapOp: "-" sub
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
228 mapOp: "*" mul
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
229 mapOp: "/" div
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
230 mapOp: "and" band
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
231 mapOp: "or" bor
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
232 mapOp: "xor" bxor
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
233
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
234 _compOps <- dict hash
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
235 _compOps set: "=" :signed? { il eq }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
236 _compOps set: "!=" :signed? { il ne }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
237 _compOps set: ">" :signed? { if: signed? { il gr } else: { il ugr } }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
238 _compOps set: "<" :signed? { if: signed? { il ls } else: { il uls } }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
239 _compOps set: ">=" :signed? { if: signed? { il ge } else: { il uge } }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
240 _compOps set: "<=" :signed? { if: signed? { il le } else: { il ule } }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
241
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
242 _funMap <- dict hash
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
243 _funMap set: "if" _compileIf
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
244 _funMap set: "if:else" _compileIfElse
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
245 //_funMap set: "while:do" _compileWhileDo
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
246 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
247 }
310
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
248
315
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
249 llFun:syms:vars:code <- :name :syms :vars :code{
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
250 _initHandlers:
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
251 syms <- symbols tableWithParent: syms
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
252 argnames <- dict hash
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
253 foreach: (code args) :idx arg {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
254 if: (arg startsWith?: ":") {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
255 arg <- arg from: 1
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
256 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
257 argnames set: arg true
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
258 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
259 ilf <- _ilFun: name
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
260 _nextReg <- 0
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
261 foreach: vars :idx var {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
262 type <- _parseType: (var assign)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
263 varname <- ((var to) name)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
264 v <- argnames ifget: varname :argnum {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
265 il arg: argnum
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
266 } else: {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
267 ilf getReg
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
268 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
269 syms define: varname #{
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
270 val <- v
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
271 size <- (type size)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
272 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
273 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
274 last <- option none
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
275 numexprs <- code length
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
276 foreach: code :idx expr {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
277 asn <- option none
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
278 if: idx = numexprs - 1 {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
279 option value: (il retr)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
280 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
281 last <- option value: (_compileExpr: expr syms: syms ilfun: ilf dest: asn)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
282 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
283 last value: :v {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
284 ilf add: (il return: (v val) (v size))
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
285 } none: {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
286 ilf add: (il return: 0 (il l))
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
287 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
288 ilf
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
289 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
290
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
291 compileText <- :text {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
292 res <- parser top: text
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
293 if: res {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
294 tree <- res yield
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
295 if: (tree nodeType) = obj {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
296 errors <- []
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
297 syms <- symbols table
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
298 functions <- tree messages fold: [] :curfuncs msg {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
299 if: (msg nodeType) = call {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
300 if: ((msg tocall) name) = "llFun:withVars:andCode" {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
301 if: ((msg args) length) = 3 {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
302 fname <- ((msg args) get: 0) name
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
303 syms define: fname #{
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
304 type <- "topfun"
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
305 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
306 #{
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
307 name <- fname
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
308 vars <- (msg args) get: 1
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
309 body <- (msg args) get: 2
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
310 } | curfuncs
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
311 } else: {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
312 errors <- (
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
313 _compileError: "llFun:withVars:andCode takes exactly 3 arguments" 0
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
314 ) | errors
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
315 curfuncs
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
316 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
317 } else: {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
318 errors <- (
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
319 _compileError: "Only llFun:withVars:andCode expressions are allowed in top level object" 0
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
320 ) | errors
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
321 curfuncs
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
322 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
323 } else: {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
324 errors <- (
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
325 _compileError: "Only call expresions are allowed in top level object" 0
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
326 ) | errors
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
327 curfuncs
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
328 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
329 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
330 if: (errors empty?) {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
331 fmap <- functions fold: (dict hash) with: :acc func {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
332 _notError: acc {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
333 ilf <- llFun: (func name) syms: syms vars: (func vars) code: (func body)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
334 _notError: ilf {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
335 acc set: (func name) (ilf buffer)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
336 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
337 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
338 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
339 fmap toBackend: x86
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
340 } else: {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
341 errors
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
342 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
343 } else: {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
344 [(_compileError: "Top level must be an object in llcompile dialect" 1)]
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
345 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
346 } else: {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
347 [(_compileError: "Failed to parse file" 0)]
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
348 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
349 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
350
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
351 main <- :args {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
352 if: (length: args) > 1 {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
353 text <- (file open: (args get: 1)) readAll
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
354 mcode <- compileText: text
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
355 _notError: mcode {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
356 ba <- bytearray executableFromBytes: mcode
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
357 arg <- if: (length: args) > 2 { int32: (args get: 2) } else: {0}
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
358 ba runWithArg: (arg i64)
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
359 }
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
360 } else: {
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
361 (file stderr) write: "Usage: llcompile FILE\n"
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
362 1
f987bb2a1911 WIP native compiler work
Michael Pavone <pavone@retrodev.com>
parents: 310
diff changeset
363 }
310
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
364 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
365 }
2308336790d4 WIP compiler module for low-level dialect
Michael Pavone <pavone@retrodev.com>
parents:
diff changeset
366 }