# HG changeset patch
# User Michael Pavone <pavone@retrodev.com>
# Date 1428990147 25200
# Node ID f74ce841fd1e375ab08c2b656d8c67242cad1e3a
# Parent  04ba2118c5fe62daa8e6e9bb9c389519debb1b2d
Produce something resembling correct il from low level dialect

diff -r 04ba2118c5fe -r f74ce841fd1e modules/il.tp
--- a/modules/il.tp	Mon Apr 13 22:41:00 2015 -0700
+++ b/modules/il.tp	Mon Apr 13 22:42:27 2015 -0700
@@ -210,6 +210,14 @@
 		w <- { word }
 		l <- { long }
 		q <- { quad }
+		
+		sizeFromBytes <- :bytes {
+			if: bytes < 4 {
+				if: bytes = 1 { b } else: { w }
+			} else: {
+				if: bytes = 4 { l } else: { q }
+			}
+		}
 
 		eq <- { _eq }
 		neq <- { _neq }
@@ -296,7 +304,7 @@
 		}
 
 		cmp <- :ina inb size {
-			op2: _cmp a: ina out: inb size: size
+			op2: _cmp in: ina out: inb size: size
 		}
 
 		band <- :ina inb out size {
@@ -511,9 +519,11 @@
 				opcode <- { _bool }
 				cond <- { _cond }
 				out <- { _out }
-				name <- { _names get: _save }
+				name <- { _names get: _bool }
 				numops <- { 0 }
-
+				string <- {
+					name . " " . cond . " " . out
+				}
 			}
 		}
 
diff -r 04ba2118c5fe -r f74ce841fd1e modules/llcompile.tp
--- a/modules/llcompile.tp	Mon Apr 13 22:41:00 2015 -0700
+++ b/modules/llcompile.tp	Mon Apr 13 22:42:27 2015 -0700
@@ -7,16 +7,20 @@
 		}
 	}
 
-	_notError <- :vals ifnoterr {
+	_notError:else <- :vals ifnoterr iferror {
 		if: (object does: vals understand?: "find") {
 			maybeErr <- vals find: :val {
-				(object does: val understand?: "isError?") && val isError?
+				(object does: val understand?: "isError?") && (val isError?)
 			}
 			maybeErr value: :err {
-				err
+				iferror: err
 			} none: ifnoterr
 		} else: ifnoterr
 	}
+	
+	_notError <- :vals ifnoterr {
+		_notError: vals ifnoterr else: :e { e }
+	}
 
 	_ilFun <- :_name {
 		_buff <- #[]
@@ -43,6 +47,38 @@
 			buffer <- { _buff }
 		}
 	}
+	
+	_sizeMap <- dict hash
+	_sizeMap set: "8" (il b)
+	_sizeMap set: "16" (il w)
+	_sizeMap set: "32" (il l)
+	_sizeMap set: "64" (il q)
+	
+	_parseType <- :expr {
+		if: (expr nodeType) = (ast sym) {
+			name <- expr name
+			_signed? <- true
+			if: (name startsWith?: "u") {
+				_signed? <- false
+				name <- name from: 1
+			}
+			if: (name startsWith?: "int") &&  ((name length) <= 5) {
+				size <- name from: 3
+				_sizeMap ifget: size :llsize {
+					#{
+						size <- llsize
+						signed? <- _signed?
+					}
+				} else: {
+					_compileError: "LL integer type " . (expr name) . " has an invalid size"
+				}
+			} else: {
+				_compileError: "LL Type " . (expr name) . " not implemented yet"
+			}
+		} else: {
+			_compileError: "LL Type with node type " . (expr nodeType) . " not implemented yet"
+		}
+	}
 
 	_exprHandlers <- false
 	_compileExpr:syms:ilfun:dest <- :expr :syms :ilf :dst {
@@ -58,35 +94,51 @@
 
 	_compileBinary <- :expr syms ilf assignTo {
 		_assignSize? <- false
-		_asize <- 0
-		dest <- option value: assignTo :asn {
+		_asize <- il b
+		dest <- assignTo value: :asn {
 			_assignSize? <- true
 			_asize <- asn size
 			asn
 		} none: {
-			ilf getReg
+			#{
+				val <- ilf getReg
+				signed? <- true
+				size <- _asize
+			}
 		}
-		l <- _compileExpr: (expr left) syms: syms ilfun: ilf assign: (option value: dest)
-		r <- _compileExpr: (expr right) syms: syms ilfun: ilf assign: (option none)
+		l <- _compileExpr: (expr left) syms: syms ilfun: ilf dest: (option value: dest)
+		r <- _compileExpr: (expr right) syms: syms ilfun: ilf dest: (option none)
 		_notError: [(l) (r)] {
 			lv <- l val
 			ls <- l size
 			rv <- r val
 			rs <- r size
-			_size <- if: ls > rs { ls } else: { rs }
-			_signed <- (ls signed?) || (rs signed?)
+			_size <- if: ls > rs { 
+				ls
+				//TODO: sign/zero extend rv
+			} else: {
+				rs
+				//TODO: sign/zero extend lv if rs > ls
+			}
+			if: _assignSize? && _asize > _size {
+				_size <- _asize
+				//TODO: sign/zero extend result
+			}
+			_signed <- (l signed?) || (r signed?)
 			_opMap ifget: (expr op) :ingen {
 				ilf add: (ingen: lv rv (dest val) _size)
 				#{
-					val <- dest
+					val <- dest val
 					size <- _size
 					signed? <- _signed
 				}
 			} else: {
-				_compOps ifget: (expr op) :cond {
-					ilf add: (il bool: cond dest)
+				_compOps ifget: (expr op) :condFun {
+					ilf add: (il cmp: lv rv _size)
+					cond <- condFun: _signed
+					ilf add: (il bool: cond (dest val))
 					#{
-						val <- dest
+						val <- dest val
 						size <- il b
 						signed? <- false
 					}
@@ -100,11 +152,29 @@
 
 	}
 	_compileInt <- :expr syms ilf assignTo {
-		expr
+		sz <- il sizeFromBytes: (expr size)
+		assignTo value: :asn {
+			ilf add: (il mov: (expr val) (asn val) sz)
+			#{
+				val <- asn val
+				signed? <- expr signed?
+				size <- sz
+			}
+		} none: {
+			#{
+				val <- expr val
+				signed? <- expr signed?
+				size <- sz
+			}
+		}
 	}
 	_compileSym <- :expr syms ilf assignTo {
-		syms ifDefined: (expr name) :def {
-			def
+		syms ifDefined: (expr name) :syminfo {
+			if: (syminfo isLocal?) {
+				syminfo def
+			} else: {
+				print: "Symbol " . (expr name) . " is not local and other types are not yet supported in LL dialect\n"
+			}
 		} else: {
 			_compileError: "Symbol " . (expr name) . " is not defined in " . (ilf name)
 		}
@@ -120,21 +190,36 @@
 				if: (blockArg nodeType) != (ast lambda) {
 					_compileError: "second argument to if must be a lambda"
 				} else: {
-					ilf add: (il cmp: condArg 0 (condArg size))
-					//TODO: Deal with if in return position
+					ilf add: (il cmp: 0 (cond val) (cond size))
+					dest <- if: (assignTo none?) {
+						option value: #{
+							val <- ilf reg
+							//TODO: FIXME
+							size <- il q
+							signed? <- true
+						}
+					} else: {
+						assignTo
+					}
 					ilf startBlock
 					foreach: (blockArg expressions) :idx expr{
-						_compileExpr: expr syms: syms ilfun: ilf dest: (option none)
+						asn <- if: idx = ((blockArg expressions) length) - 1 {
+							dest
+						} else: {
+							option none
+						}
+						_compileExpr: expr syms: syms ilfun: ilf dest: asn
 					}
 					block <- ilf popBlock
 					ilf add: (il skipIf: (il neq) block)
+					dest value: :d { d } none: { _compileError: "Something went wrong" }
 				}
 			}
 		}
 	}
 	_compileIfElse <- :expr syms ilf assignTo {
-		if: ((expr args) length) != 2 {
-			_compileError: "if takes exactly 2 arguments" 0
+		if: ((expr args) length) != 3 {
+			_compileError: "if:else takes exactly 3 arguments" 0
 		} else: {
 			condArg <- (expr args) value
 			blockArg <- ((expr args) tail) value
@@ -147,19 +232,39 @@
 					if: (elseArg nodeType) != (ast lambda) {
 						_compileError: "third argument to if:else must be a lambda"
 					} else: {
-						ilf add: (il cmp: condArg 0 (condArg size))
-						//TODO: Deal with if:else in return position
+						ilf add: (il cmp: 0 (cond val) (cond size))
+						dest <- if: (assignTo none?) {
+							option value: #{
+								val <- ilf reg
+								//TODO: FIXME
+								size <- il q
+								signed? <- true
+							}
+						} else: {
+							assignTo
+						}
 						ilf startBlock
 						foreach: (blockArg expressions) :idx expr {
-							_compileExpr: expr syms: syms ilfun: ilf dest: (option none)
+							asn <- if: idx = ((blockArg expressions) length) - 1 {
+								dest
+							} else: {
+								option none
+							}
+							_compileExpr: expr syms: syms ilfun: ilf dest: asn
 						}
 						block <- ilf popBlock
 						ilf startBlock
 						foreach: (elseArg expressions) :idx expr {
+							asn <- if: idx = ((elseArg expressions) length) - 1 {
+								dest
+							} else: {
+								option none
+							}
 							_compileExpr: expr syms: syms ilfun: ilf dest: (option none)
 						}
 						elseblock <- ilf popBlock
 						ilf add: (il skipIf: (il neq) block else: elseblock)
+						dest value: :d { d } none: { _compileError: "Something went wrong" }
 					}
 				}
 			}
@@ -171,13 +276,29 @@
 			handler <- _funMap get: ((expr tocall) name) else: { false }
 			handler: expr syms ilf assignTo
 		} else: {
-			ctocall <- _compileExpr: (expr tocall) syms: syms ilfuN: ilf dest: (option none)
+			ctocall <- if: ((expr tocall) nodeType) = (ast sym) {
+				ctocall <- (expr tocall) name
+			} else: {
+				_compileExpr: (expr tocall) syms: syms ilfun: ilf dest: (option none)
+			}
 			cargs <- (expr args) map: :arg {
 				_compileExpr: arg syms: syms ilfun: ilf dest: (option none)
 			}
 			_notError: ctocall | cargs {
-				ilf add: (il call: ctocall withArgs: cargs)
-				il retr
+				ilf add: (il call: ctocall withArgs: (cargs map: :arg { arg val } ))
+				
+				retval <- assignTo value: :asn {
+					ilf add: (il mov: (il retr) (asn val) (asn size))
+					asn
+				} none: {
+					#{
+						val <- il retr
+						//TODO: Use correct values based on return type
+						size <- il q
+						signed? <- true
+					}
+				}
+				retval
 			}
 		}
 	}
@@ -188,7 +309,7 @@
 			value <- _compileExpr: (expr assign) syms: syms ilfun: ilf dest: dest
 			_notError: [value] {
 				//TODO: adjust size of value if necessary
-				ilf add: (il mov: (value val) (dest val) (dest size))
+				//ilf add: (il mov: (value val) (dest val) (dest size))
 				value
 			}
 		}
@@ -254,38 +375,54 @@
 				if: (arg startsWith?: ":") {
 					arg <- arg from: 1
 				}
-				argnames set: arg true
+				argnames set: arg idx
 			}
 			ilf <- _ilFun: name
 			_nextReg <- 0
-			foreach: vars :idx var {
+			varErrors <- (vars expressions) fold: [] with: :acc var {
 				type <- _parseType: (var assign)
-				varname <- ((var to) name)
-				v <- argnames ifget: varname :argnum {
-					il arg: argnum
-				} else: {
-					ilf getReg
-				}
-				syms define: varname #{
-					val <- v
-					size <- (type size)
+				_notError: [type] {
+					varname <- ((var to) name)
+					v <- argnames ifget: varname :argnum {
+						il arg: argnum
+					} else: {
+						ilf getReg
+					}
+					syms define: varname #{
+						val <- v
+						size <- (type size)
+						signed? <- (type signed?)
+					}
+					acc
+				} else: :err {
+					err | acc
 				}
 			}
-			last <- option none
-			numexprs <- code length
-			foreach: code :idx expr {
-				asn <- option none
-				if: idx = numexprs - 1 {
-					option value: (il retr)
+			if: (varErrors empty?) {
+				last <- option none
+				numexprs <- (code expressions) length
+				foreach: (code expressions) :idx expr {
+					asn <- if: idx = numexprs - 1 {
+						option value: #{
+							val <- ilf getReg
+							//TODO: FIxme
+							size <- il q
+							signed? <- true
+						}
+					} else: {
+						option none
+					}
+					last <- option value: (_compileExpr: expr syms: syms ilfun: ilf dest: asn)
 				}
-				last <- option value: (_compileExpr: expr syms: syms ilfun: ilf dest: asn)
+				last value: :v {
+					ilf add: (il return: (v val) (v size))
+				} none: {
+					ilf add: (il return: 0 (il l))
+				}
+				ilf
+			} else: {
+				varErrors
 			}
-			last value: :v {
-				ilf add: (il return: (v val) (v size))
-			} none: {
-				ilf add: (il return: 0 (il l))
-			}
-			ilf
 		}
 
 		compileText <- :text {
@@ -295,18 +432,19 @@
 				if: (tree nodeType) = obj {
 					errors <- []
 					syms <- symbols table
-					functions <- tree messages fold: [] :curfuncs msg {
+					functions <- (tree messages) fold: [] with: :curfuncs msg {
 						if: (msg nodeType) = call {
 							if: ((msg tocall) name) = "llFun:withVars:andCode" {
 								if: ((msg args) length) = 3 {
-									fname <- ((msg args) get: 0) name
+									fname <- ((msg args) value) name
 									syms define: fname #{
 										type <- "topfun"
 									}
+									rest <- (msg args) tail
 									#{
 										name <- fname
-										vars <- (msg args) get: 1
-										body <- (msg args) get: 2
+										vars <- rest value
+										body <- (rest tail) value
 									} | curfuncs
 								} else: {
 									errors <- (
@@ -328,15 +466,28 @@
 						}
 					}
 					if: (errors empty?) {
+						errors <- []
 						fmap <- functions fold: (dict hash) with: :acc func {
-							_notError: acc {
-								ilf <- llFun: (func name) syms: syms vars: (func vars) code: (func body)
-								_notError: ilf {
-									acc set: (func name) (ilf buffer)
+							ilf <- llFun: (func name) syms: syms vars: (func vars) code: (func body)
+							_notError: ilf {
+								acc set: (func name) (ilf buffer)
+							} else: {
+								errors <- ilf . errors
+							}
+							acc
+						}
+						if: (errors empty?) {
+							foreach: fmap :name instarr {
+								print: "Function: " . name . "\n"
+								foreach: instarr :_ inst {
+									print: "\t" . inst . "\n"
 								}
 							}
+							print: "Translating IL to x86\n"
+							il toBackend: fmap x86
+						} else: {
+							errors
 						}
-						fmap toBackend: x86
 					} else: {
 						errors
 					}
@@ -356,6 +507,8 @@
 					ba <- bytearray executableFromBytes: mcode
 					arg <- if: (length: args) > 2 { int32: (args get: 2) } else: {0}
 					ba runWithArg: (arg i64)
+				} else: :err {
+					(file stderr) write: (err msg) . "\n"
 				}
 			} else: {
 				(file stderr) write: "Usage: llcompile FILE\n"