changeset 3:a9a2ad99adfb

Rework lmc a bit to support labels in generated code. Add support for certain special funcall expressions, namely: if:else, isInteger? value and tail which translate to SEL ATOM CAR and CDR respectively
author Michael Pavone <pavone@retrodev.com>
date Fri, 25 Jul 2014 10:52:17 -0700
parents 71e8d638da5c
children eaf0a014d18b
files code/lmc.tp code/test.lm
diffstat 2 files changed, 116 insertions(+), 7 deletions(-) [+]
line wrap: on
line diff
--- a/code/lmc.tp	Fri Jul 25 09:32:12 2014 -0700
+++ b/code/lmc.tp	Fri Jul 25 10:52:17 2014 -0700
@@ -1,4 +1,62 @@
 {
+	inst <- :_name _args {
+		#{
+			name <- _name
+			args <- _args
+			translateLabels <- :labelDict {
+				missing <- #[]
+				foreach: args :idx arg {
+					if: (object does: arg understand?: "isString?") && (arg isString?) {
+						labelDict ifget: arg :translated {
+							args set: idx translated
+						} else: {
+							missing append: arg
+						}
+					}
+				}
+				missing
+			}
+			label <- ""
+			string <- {
+				(if: label != "" { ";" . label . "\n  " } else: { "  " }
+				) . name . " " . (args join: " ")
+			}
+		}
+	}
+	_nextLabel <- 0
+	_setLabel <- :inst {
+		inst
+	}
+	prog <- #{
+		instructions <- #[]
+		add <- :inst {
+			instructions append: (_setLabel: inst)
+		}
+		makeLabel <- :suffix {
+			num <- _nextLabel
+			_nextLabel <- _nextLabel + 1
+			"" . num . "_" . suffix
+		}
+		labels <- dict hash
+		setLabel <- :name {
+			labels set: name pc
+			_setLabel <- :inst {
+				_setLabel <- :i { i }
+				inst label!: name
+			}
+		}
+		pc <- { instructions length }
+		print <- {
+			foreach: instructions :idx i {
+				missing <- i translateLabels: labels
+				if: (missing length) > 0 {
+					error: "Undefined labels " . (missing join: ", ") . " at address " . idx
+				}
+				print: (string: i) . "\n"
+			}
+			
+		}
+	}
 	error <- :msg {
 		(file stderr) write: "Error - " . msg . "\n"
 	}
@@ -14,7 +72,7 @@
 	}
 	
 	_exprHandlers set: (ast intlit) :expr {
-		print: "  LDC " . (expr val) . "\n"
+		prog add: (inst: "LDC" #[(expr val)])
 	}
 	
 	_exprHandlers set: (ast sequence) :expr {
@@ -26,10 +84,10 @@
 		if: (expr array?) {
 			count <- count - 1
 		} else: {
-			print: "  LDC 0\n"
+			prog add: (inst: "LDC" #[0])
 		}
 		while: { count > 0} do: {
-			print: "  CONS\n"
+			prog add: (inst: "CONS" #[])
 			count <- count - 1
 		}
 	}
@@ -52,12 +110,58 @@
 			compileExpr: (expr right)
 			compileExpr: (expr left)
 		}
-		_opNames ifget: (expr op) :inst {
-			print: "  " . inst . "\n"
+		_opNames ifget: (expr op) :i {
+			prog add: (inst: i #[])
 		} else: {
 			error: "operator " . (expr op) . " is not supported"
 		}
 	}
+	
+	_funHandlers <- dict hash
+	_funHandlers set: "if:else" :args {
+		compileExpr: (args value)
+		args <- args tail
+		tlabel <- prog makeLabel: "true"
+		flabel <- prog makeLabel: "false"
+		prog add: (inst: "SEL" #[
+			tlabel 
+			flabel
+		])
+		prog setLabel: tlabel
+		foreach: ((args value) expressions) :idx expr {
+			compileExpr: expr
+		}
+		args <- args tail
+		prog setLabel: flabel
+		foreach: ((args value) expressions) :idx expr {
+			compileExpr: expr
+		}
+	}
+	_funHandlers set: "isInteger?" :args {
+		compileExpr: (args value)
+		prog add: (inst: "ATOM" #[])
+	}
+	_funHandlers set: "value" :args {
+		compileExpr: (args value)
+		prog add: (inst: "CAR" #[])
+	}
+	_funHandlers set: "tail" :args {
+		compileExpr: (args value)
+		prog add: (inst: "CDR" #[])
+	}
+	
+	_exprHandlers set: (ast call) :expr {
+		tc <- (expr tocall)
+		if: (tc nodeType) = (ast sym) {
+			_funHandlers ifget: (tc name) :handler {
+				handler: (expr args)
+			} else: {
+				error: "function calls not implemented yet"
+			}
+		} else: {
+			error: "call expression to value not implemented yet - " . tc
+		}
+	}
 	#{
 		compile <- :code {
 			res <- parser top: code
@@ -76,11 +180,12 @@
 					compileExpr: expr
 				}
 				foreach: others :name fun {
-					print: ";" . name . "\n"
+					prog setLabel: name
 					foreach: (fun expressions) :idx expr {
 						compileExpr: expr
 					}
 				}
+				print: prog
 			} else: {
 				error: "Parse failed!"
 			}
--- a/code/test.lm	Fri Jul 25 09:32:12 2014 -0700
+++ b/code/test.lm	Fri Jul 25 10:52:17 2014 -0700
@@ -4,6 +4,10 @@
 	}
 	
 	main <- {
-		1 | [(2 + 32 * 8) 3 4]
+		if: (isInteger?: 1 | [(2 + 32 * 8) 3 4]) {
+			42
+		} else: {
+			24
+		}
 	}
 }