diff modules/llcompile.tp @ 310:2308336790d4

WIP compiler module for low-level dialect
author Michael Pavone <pavone@retrodev.com>
date Fri, 01 Aug 2014 18:56:39 -0700
parents
children f987bb2a1911
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/modules/llcompile.tp	Fri Aug 01 18:56:39 2014 -0700
@@ -0,0 +1,135 @@
+{
+	_compileError <- :_msg _line {
+		#{
+			isError? <- { true }
+			msg <- { _msg }
+			line <- { _line }
+		}
+	}
+
+	_notError <- :vals ifnoterr {
+		maybeErr <- vals find: :val {
+			(object does: val understand?: "isError?") && val isError?
+		}
+		maybErr value: :err {
+			err
+		} none: ifnoterr
+	}
+
+	_ilFun <- :_name {
+		_buff <- #[]
+		_nextReg <- 0
+		#{
+			name <- { _name }
+			add <- :inst { _buff append: inst }
+			getReg <- {
+				r <- il reg: _nextReg
+				_nextReg <- _nextReg + 1
+				r
+			}
+		}
+	}
+
+	_exprHandlers <- dict hash
+	_compileExpr:syms:ilfun:dest <- :expr :syms :ilf :dst {
+		_exprHandlers ifget: (expr nodeType) :handler {
+			handler: expr syms ilf dst
+		} else: {
+			_compileError: "Expression with node type " . (expr nodeType) . " not implemented yet"
+		}
+	}
+	_opMap <- dict hash
+	mapOp <- macro: :op ilfun {
+		quote: (opMap set: op :ina inb out size {
+			il ilfun: ina inb out size
+		})
+	}
+	mapOp: "+" add
+	mapOp: "-" sub
+	mapOp: "*" mul
+	mapOp: "/" div
+	mapOp: "and" and
+	mapOp: "or" or
+	mapOp: "xor" xor
+
+	_compOps <- dict hash
+	_compOps set: "=" :signed? { il eq }
+	_compOps set: "!=" :signed? { il ne }
+	_compOps set: ">" :signed? { if: signed? { il gr } else: { il ugr } }
+	_compOps set: "<" :signed? { if: signed? { il ls } else: { il uls } }
+	_compOps set: ">=" :signed? { if: signed? { il ge } else: { il uge } }
+	_compOps set: "<=" :signed? { if: signed? { il le } else: { il ule } }
+
+	_compileBinary <- :expr syms ilf assignTo {
+		_assignSize? <- false
+		_asize <- 0
+		dest <- option value: assignTo :asn {
+			_assignSize? <- true
+			_asize <- asn size
+			asn
+		} none: {
+			ilf getReg
+		}
+		l <- _compileExpr: (expr left) syms: syms ilfun: ilf assign: (option value: dest)
+		r <- _compileExpr: (expr right) syms: syms ilfun: ilf assign: (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?)
+			_opMap ifget: (expr op) :ingen {
+				ilf add: (ingen: lv rv (dest val) _size)
+				#{
+					val <- dest
+					size <- _size
+					signed? <- _signed
+				}
+			} else: {
+				_compOps ifget: (expr op) :cond {
+					ilf add: (il bool: cond dest)
+					#{
+						val <- dest
+						size <- il b
+						signed? <- false
+					}
+				} else: {
+					_compileError: "Operator " . (expr op) . " is not supported yet\n" 0
+				}
+			}
+		}
+	}
+	_compileString <- :expr syms ilf assignTo {
+
+	}
+	_compileInt <- :expr syms ilf assignTo {
+		expr
+	}
+	_compileSym <- :expr syms ilf assignTo {
+		syms ifDefined: (expr name) :def {
+			def
+		} else: {
+			_compileError: "Symbol " . (expr name) . " is not defined in " . (ilf name)
+		}
+	}
+
+	_exprHandlers set: binary _compileBinary
+	_exprHandlers set: stringlit _compileString
+	#{
+		import: [
+			binary
+			stringlit
+			intlit
+			sym
+			call
+			obj
+			sequence
+			assignment
+			lambda
+		] from: ast
+		llFun <- :{
+
+		}
+	}
+}