Add compilation of constructors and basic values

9 files changed, 671 insertions, 3 deletions

diff --git a/driver.s b/driver.s
new file mode 100644
index 0000000..429b147
--- /dev/null
+++ b/driver.s
@@ -0,0 +1,225 @@
+	.data
+
+	.align 3
+_cINT:
+	.word	0x100	# arity
+	.word	3	# name
+	.ascii	"Int"
+
+	.align 2
+PRINTROOT:
+	.word	_nroot
+	.word	0	# to be filled in
+EVALROOT:
+	.word	_nroot
+	.word	0	# to be filled in
+
+	.align 2
+heap:
+
+	.text
+main:
+	la	$gp,heap
+
+	la	$t0,__main_ntest
+	sw	$t0,($gp)
+
+	la	$s0,PRINTROOT
+	ori	$s1,$gp,0
+	sw	$s1,4($s0)
+
+	jal	driver
+	addi	$gp,$gp,8
+
+	li	$a0,'\n'
+	li	$v0,11	# print_char
+	syscall
+	li	$v0,10	# exit
+	syscall
+
+driver:
+	addi	$sp,$sp,-4
+	sw	$ra,($sp)
+print:
+	lw	$t0,($s1)
+	andi	$t0,$t0,2
+	bne	$t0,$0,print_hnf
+	nop
+	la	$s2,EVALROOT
+	addi	$s3,$s1,0
+	sw	$s3,4($s2)
+	jal	eval
+	nop
+	addi	$s1,$s3,0
+print_hnf:
+	lw	$t0,($s1)
+	la	$t1,_cINT+2
+	beq	$t0,$t1,print_int
+	lw	$t1,2($t0)	# name length
+	addi	$t2,$t0,6	# name
+	add	$t1,$t1,$t2
+print_cons:
+	lw	$t3,-2($t0)	# arity
+	beq	$t3,$0,print_cons_no_paren
+	li	$a0,'('
+	li	$v0,11	# print_char
+	syscall
+print_cons_no_paren:
+	lb	$a0,($t2)
+	li	$v0,11	# print_char
+	syscall
+	addi	$t2,$t2,1
+	bne	$t1,$t2,print_cons_no_paren
+	nop
+	beq	$t3,$0,print_rewind
+	li	$a0,' '
+	li	$v0,11	# print_char
+	syscall
+	# continue with printing the arguments
+	addi	$t2,$s0,1
+	addi	$s0,$s1,0
+	lw	$s1,4($s1)
+	sw	$t2,4($s0)
+	j	print
+	nop
+
+print_int:
+	lw	$a0,4($s1)
+	li	$v0,1	# print_int
+	syscall
+	j	print_rewind
+	nop
+
+print_rewind:
+	la	$t5,PRINTROOT
+	beq	$s0,$t5,print_rewind_root
+	addi	$t0,$s0,0
+	addi	$t1,$s0,0	# argument pointer
+	lw	$t2,($t0)
+	lw	$t2,-2($t2)	# arity
+print_rewind_loop:
+	addi	$t1,$t1,4
+	lw	$t3,($t1)
+	andi	$t4,$t3,1
+	beq	$t4,$0,print_rewind_loop
+	addi	$t2,$t2,-1
+	# we have found the argument that was being printed
+	beq	$t2,$0,print_rewind_done
+	# there is a next argument to print
+	li	$a0,' '
+	li	$v0,11	# print_char
+	syscall
+	sw	$s1,($t1)
+	lw	$s1,4($t1)
+	sw	$t3,4($t1)
+	j	print
+	nop
+print_rewind_done:
+	# this node is fully printed; go up to the parent
+	li	$a0,')'
+	li	$v0,11	# print_char
+	syscall
+	xori	$s0,$t3,1
+	sw	$s1,($t1)
+	addi	$s1,$t0,0
+	j	print_rewind
+	nop
+print_rewind_root:
+	lw	$ra,($sp)
+	jr	$ra
+	addi	$sp,$sp,4
+
+eval:
+	lw	$t0,($s3)
+	# Exit early in case of hnf
+	andi	$t1,$t0,2
+	bne	$t1,$0,eval_rewind
+	# Walk through indirections
+	la	$t1,_nindir
+	bne	$t0,$t1,eval_indir_done
+	addi	$t2,$s3,0
+eval_indir:
+	lw	$s3,4($s3)
+	lw	$t0,($s3)
+	beq	$t0,$t1,eval_indir
+	sw	$s3,4($t2)	# update original indir; optimizes chained indirs
+	# Check again for hnf
+	andi	$t1,$t0,2
+	bne	$t1,$0,eval_rewind
+	nop
+eval_indir_done:
+	lw	$t1,-4($t0)	# load arity
+	lw	$t2,-8($t0)	# strictness
+	addi	$t3,$s3,4	# argument pointer
+eval_arg_loop:
+	beq	$t1,$0,eval_args_done
+	andi	$t4,$t2,1
+	bne	$t4,$0,eval_arg_strict
+	srl	$t2,$t2,1
+	addi	$t1,$t1,-1
+	j	eval_arg_loop
+	addi	$t3,$t3,4
+eval_arg_strict:
+	lw	$t4,($t3)
+	lw	$t4,($t4)
+	andi	$t4,$t4,2
+	beq	$t4,$0,eval_arg
+	addi	$t1,$t1,-1
+	j	eval_arg_loop
+	addi	$t3,$t3,4
+eval_arg:
+	lw	$t4,($t3)	# reverse pointers
+	addi	$s2,$s2,1
+	sw	$s2,($t3)
+	addi	$s2,$s3,0
+	addi	$s3,$t4,0
+	j	eval		# continue evaluating argument
+	nop
+eval_args_done:
+	jr	$t0
+	nop
+
+eval_rewind:
+	la	$t4,EVALROOT
+	beq	$s2,$t4,eval_rewind_root
+	addi	$t0,$s2,0
+	addi	$t1,$s2,0
+eval_rewind_loop:
+	addi	$t1,$t1,4
+	lw	$t2,($t1)
+	andi	$t3,$t2,1
+	beq	$t3,$0,eval_rewind_loop
+	nop
+	xori	$s2,$t2,1
+	sw	$s3,($t1)
+	addi	$s3,$t0,0
+	j	eval
+	nop
+eval_rewind_root:
+	jr	$ra
+	nop
+
+	.data
+cycle_error:
+	.asciiz	"error: cycle in spine detected\n"
+	.text
+	.word	0	# strictness
+	.word	1	# arity
+_nroot:
+	la	$a0,cycle_error
+	li	$v0,4	# print_string
+	syscall
+	break	0
+
+	.data
+indir_error:
+	.asciiz	"error: indirection evaluated\n"
+	.text
+	.word	0x1	# strictness
+	.word	1	# arity
+_nindir:
+	# indirections are handled in eval
+	la	$a0,indir_error
+	li	$v0,4	# print_string
+	syscall
+	break	0
diff --git a/example.txt b/example.txt
index b36c823..251aab3 100644
--- a/example.txt
+++ b/example.txt
@@ -64,3 +64,6 @@
 			(Cons (CaseAlternative (ConstructorPattern (Cons 'N' (Cons 'i' (Cons 'l' Nil))) Nil) (Ident (Cons 'n' Nil)))
 				(Cons (CaseAlternative (ConstructorPattern (Cons 'C' (Cons 'o' (Cons 'n' (Cons 's' Nil)))) (Cons Wildcard (Cons (IdentPattern (Cons 'x' (Cons 's' Nil))) Nil))))
 				Nil)))))
+
+(fun test () : Int
+	37)
diff --git a/plusplus.s b/plusplus.s
index d347a7f..02e6707 100644
--- a/plusplus.s
+++ b/plusplus.s
@@ -79,6 +79,9 @@ main:
 	jal	driver
 	addi	$gp,$gp,60
 
+	li	$a0,'\n'
+	li	$v0,11	# print_char
+	syscall
 	li	$v0,10	# exit
 	syscall
 
diff --git a/snug-clean/nitrile.yml b/snug-clean/nitrile.yml
index 6f05a65..4ab5699 100644
--- a/snug-clean/nitrile.yml
+++ b/snug-clean/nitrile.yml
@@ -18,5 +18,5 @@ build:
       - clm:
           main: snug
           target: snug
-            #print_result: false
+          print_result: false
           print_time: false
diff --git a/snug-clean/src/MIPS/MIPS32.dcl b/snug-clean/src/MIPS/MIPS32.dcl
new file mode 100644
index 0000000..4789507
--- /dev/null
+++ b/snug-clean/src/MIPS/MIPS32.dcl
@@ -0,0 +1,96 @@
+definition module MIPS.MIPS32
+
+from StdOverloaded import class toString
+
+:: Line
+	= StartSection !String
+	| Align !Int
+	| Label !Label
+	| Instr !Instruction
+	| RawWord !Int
+	| RawAscii !String
+
+instance toString Line
+
+:: Instruction
+	= LoadByte !Signedness !TargetRegister !Offset !Base
+	| LoadHalfword !Signedness !TargetRegister !Offset !Base
+	| LoadWord !TargetRegister !Offset !Base
+	| StoreByte !TargetRegister !Offset !Base
+	| StoreHalfword !TargetRegister !Offset !Base
+	| StoreWord !TargetRegister !Offset !Base
+
+	| AddImmediate !Signedness !DestinationRegister !SourceRegister !Immediate
+	| AndImmediate !DestinationRegister !SourceRegister !Immediate
+	| LoadUpperImmediate !DestinationRegister !Immediate
+	| OrImmediate !DestinationRegister !SourceRegister !Immediate
+	| XorImmediate !DestinationRegister !SourceRegister !Immediate
+
+	| AddWord !Signedness !DestinationRegister !SourceRegister !TargetRegister
+	| AndWord !DestinationRegister !SourceRegister !TargetRegister
+	| NorWord !DestinationRegister !SourceRegister !TargetRegister
+	| OrWord !DestinationRegister !SourceRegister !TargetRegister
+	| SubWord !Signedness !DestinationRegister !SourceRegister !TargetRegister
+	| XorWord !DestinationRegister !SourceRegister !TargetRegister
+
+	| Jump !Link !JumpTarget
+	| BranchOn1 !BranchCondition1 !SourceRegister !Offset
+	| BranchOn2 !BranchCondition2 !SourceRegister !TargetRegister !Offset
+
+	| Break !Int
+	| Syscall !Int /* applications should also set v0 to the syscall argument */
+
+	| LoadAddress !DestinationRegister !Immediate
+	| Nop
+
+Move rd rs :== OrImmediate rd rs (Immediate 0)
+
+instance toString Instruction
+
+:: Signedness
+	= Signed
+	| Unsigned
+
+:: Base :== Register
+:: Offset :== Int /* 16-bit signed */
+
+:: DestinationRegister :== Register
+:: SourceRegister :== Register
+:: TargetRegister :== Register
+
+:: Register
+	= R0 /* always zero */
+	| AT /* reserved for assembler; do not use */
+	| V0 | V1 /* expression evaluations, integer results, static link for nested procedures */
+	| A !Int /* 0-3, integer arguments, values not preserved */
+	| T !Int /* 0-9, temporary, values not preserved */
+	| S !Int /* 0-7, saved, values preserved */
+	| K0 | K1 /* reserved for the kernel */
+	| GP /* global (heap) pointer */
+	| SP /* stack pointer */
+	| FP /* frame pointer if needed; otherwise saved register */
+	| RA /* return address; temporary */
+
+:: Immediate
+	= Immediate !Int /* 16-bit */
+	| Address !Offset !Label
+
+:: Link
+	= Link
+	| NoLink
+
+:: JumpTarget
+	= Direct !Immediate
+	| Register !Register
+
+:: Label :== String
+
+:: BranchCondition1
+	= BCGeZero !Link
+	| BCGtZero
+	| BCLeZero
+	| BCLtZero !Link
+
+:: BranchCondition2
+	= BCEq
+	| BCNe
diff --git a/snug-clean/src/MIPS/MIPS32.icl b/snug-clean/src/MIPS/MIPS32.icl
new file mode 100644
index 0000000..a124007
--- /dev/null
+++ b/snug-clean/src/MIPS/MIPS32.icl
@@ -0,0 +1,162 @@
+implementation module MIPS.MIPS32
+
+import StdEnv
+
+import Text
+
+instance toString Line
+where
+	toString (StartSection s) = "\t." +++ s
+	toString (Align i) = "\t.align\t" +++ toString i
+	toString (Label l) = l +++ ":"
+	toString (Instr i) = "\t" +++ toString i
+	toString (RawWord i) = "\t.word\t" +++ toString i
+	toString (RawAscii s) = concat3 "\t.ascii\t\"" s "\"" // TODO: escaping
+
+instance toString Instruction
+where
+	toString (LoadByte signed rt offset base) =
+		memInstrS (if (signed=:Signed) "lb" "lbu") rt (checkOffset offset) base
+	toString (LoadHalfword signed rt offset base) =
+		memInstrS (if (signed=:Signed) "lh" "lhu") rt (checkOffset offset) base
+	toString (LoadWord rt offset base) =
+		memInstrS "lw" rt (checkOffset offset) base
+	toString (StoreByte rt offset base) =
+		memInstrS "sb" rt (checkOffset offset) base
+	toString (StoreHalfword rt offset base) =
+		memInstrS "sh" rt (checkOffset offset) base
+	toString (StoreWord rt offset base) =
+		memInstrS "sw" rt (checkOffset offset) base
+
+	toString (AddImmediate signed rt rs imm) =
+		immediateInstrS (if (signed=:Signed) "addi" "addiu") rt rs (checkImmediate signed imm)
+	toString (AndImmediate rt rs imm) =
+		immediateInstrS "andi" rt rs (checkImmediate Unsigned imm)
+	toString (LoadUpperImmediate rt imm) =
+		concat ["lui\t",toString rt,",",toString (checkImmediate Unsigned imm)]
+	toString (OrImmediate rt rs imm) =
+		immediateInstrS "ori" rt rs (checkImmediate Unsigned imm)
+	toString (XorImmediate rt rs imm) =
+		immediateInstrS "xori" rt rs (checkImmediate Unsigned imm)
+
+	toString (AddWord signed rd rs rt) =
+		threeRegInstrS (if (signed=:Signed) "add" "addu") rd rs rt
+	toString (AndWord rd rs rt) =
+		threeRegInstrS "and" rd rs rt
+	toString (NorWord rd rs rt) =
+		threeRegInstrS "nor" rd rs rt
+	toString (OrWord rd rs rt) =
+		threeRegInstrS "or" rd rs rt
+	toString (SubWord signed rd rs rt) =
+		threeRegInstrS (if (signed=:Signed) "sub" "subu") rd rs rt
+	toString (XorWord rd rs rt) =
+		threeRegInstrS "xor" rd rs rt
+
+	toString (Jump link target) =
+		instr +++ toString target
+	where
+		instr = case (link, target) of
+			(NoLink, Direct _) -> "j\t"
+			(Link, Direct _) -> "jal\t"
+			(NoLink, Register _) -> "jr\t"
+			(Link, Register _) -> "jalr\t"
+	toString (BranchOn1 (BCGeZero link) rs offset) =
+		branch1InstrS (if (link=:Link) "bgezal" "bgez") rs (checkOffset offset)
+	toString (BranchOn1 BCGtZero rs offset) =
+		branch1InstrS "bgtz" rs (checkOffset offset)
+	toString (BranchOn1 BCLeZero rs offset) =
+		branch1InstrS "blez" rs (checkOffset offset)
+	toString (BranchOn1 (BCLtZero link) rs offset) =
+		branch1InstrS (if (link=:Link) "bltzal" "bltz") rs (checkOffset offset)
+	toString (BranchOn2 cond rs rt offset) =
+		immediateInstrS (if (cond=:BCEq) "beq" "bne") rs rt (Immediate (checkOffset offset))
+
+	toString (Break arg) =
+		"break\t" +++ toString arg
+	toString (Syscall arg) =
+		"syscall\t" +++ toString arg
+
+	toString (LoadAddress rd imm) =
+		concat4 "la\t" (toString rd) "," (toString imm)
+	toString Nop =
+		"nop"
+
+instance toString JumpTarget
+where
+	toString (Direct imm)
+		= toString imm
+	toString (Register r)
+		= toString r
+
+instance toString Immediate
+where
+	toString (Immediate i)
+		= toString i
+	toString (Address offset label)
+		| offset == 0
+			= label
+		| offset > 0
+			= concat3 label "+" (toString offset)
+			= concat3 label "-" (toString offset)
+
+memInstrS :: !String !Register !Offset !Base -> String
+memInstrS opcode rt 0 base = concat [opcode,"\t",toString rt,",(",toString base,")"]
+memInstrS opcode rt offset base = concat [opcode,"\t",toString rt,",",toString offset,"(",toString base,")"]
+
+immediateInstrS :: !String !TargetRegister !SourceRegister !Immediate -> String
+immediateInstrS opcode rt rs imm = concat [opcode,"\t",toString rt,",",toString rs,",",toString imm]
+
+threeRegInstrS :: !String !DestinationRegister !SourceRegister !TargetRegister -> String
+threeRegInstrS opcode rd rs rt = concat [opcode,"\t",toString rd,",",toString rs,",",toString rt]
+
+branch1InstrS :: !String !SourceRegister !Offset -> String
+branch1InstrS opcode rs offset = concat [opcode,"\t",toString rs,",",toString offset]
+
+instance toString Register
+where
+	toString reg = toString` (checkReg reg)
+	where
+		/* Sorted by estimated frequency for efficiency */
+		toString` (T n) = "$t" +++ toString n
+		toString` (S n) = "$s" +++ toString n
+		toString` (A n) = "$a" +++ toString n
+		toString` R0 = "$0"
+		toString` GP = "$gp"
+		toString` SP = "$sp"
+		toString` FP = "$fp"
+		toString` RA = "$ra"
+		toString` AT = "$at"
+		toString` V0 = "$v0"
+		toString` V1 = "$v1"
+		toString` K0 = "$k0"
+		toString` K1 = "$k1"
+
+checkReg :: !Register -> Register
+checkReg (T n) | not (0 <= n && n <= 9)
+	= abort ("non-existing register $t" +++ toString n +++ "\n")
+checkReg (S n) | not (0 <= n && n <= 7)
+	= abort ("non-existing register $s" +++ toString n +++ "\n")
+checkReg (A n) | not (0 <= n && n <= 3)
+	= abort ("non-existing register $a" +++ toString n +++ "\n")
+checkReg reg
+	= reg
+
+checkOffset :: !Int -> Int
+checkOffset offset
+	| 0 <= offset && offset <= 0x7fff
+		= offset
+	| offset >= -0x8000
+		= offset bitand 0xffff
+		= abort ("offset " +++ toString offset +++ " out of bounds\n")
+
+checkImmediate :: !Signedness !Immediate -> Immediate
+checkImmediate Signed (Immediate imm)
+	| 0 <= imm && imm <= 0x7fff
+		= Immediate imm
+	| imm >= -0x8000
+		= Immediate (imm bitand 0xffff)
+		= abort ("signed immediate " +++ toString imm +++ " out of bounds\n")
+checkImmediate Unsigned (Immediate imm)
+	| 0 <= imm && imm <= 0xffff
+		= Immediate imm
+		= abort ("unsigned immediate " +++ toString imm +++ " out of bounds\n")
diff --git a/snug-clean/src/Snug/Compile.dcl b/snug-clean/src/Snug/Compile.dcl
new file mode 100644
index 0000000..d329156
--- /dev/null
+++ b/snug-clean/src/Snug/Compile.dcl
@@ -0,0 +1,28 @@
+definition module Snug.Compile
+
+from Data.Map import :: Map
+
+from MIPS.MIPS32 import :: Line
+from Snug.Syntax import :: ConstructorDef, :: ConstructorIdent, :: Definition,
+	:: SymbolIdent, :: Type
+
+:: Namespace :== String
+
+:: Namespaced id =
+	{ ns :: !Namespace
+	, id :: !id
+	}
+
+:: Globals =
+	{ constructors :: !Map (Namespaced ConstructorIdent) ConstructorDef
+	, functions    :: !Map (Namespaced SymbolIdent) FunctionInfo
+	}
+
+:: FunctionInfo =
+	{ arity :: !Int
+	, type :: !Type
+	}
+
+compile :: !Namespace ![Definition] -> [Line]
+
+compileDefinition :: !Namespace !Globals !Definition -> [Line]
diff --git a/snug-clean/src/Snug/Compile.icl b/snug-clean/src/Snug/Compile.icl
new file mode 100644
index 0000000..2a9d9e4
--- /dev/null
+++ b/snug-clean/src/Snug/Compile.icl
@@ -0,0 +1,130 @@
+implementation module Snug.Compile
+
+import StdEnv
+
+import Data.List
+import qualified Data.Map
+from Data.Map import :: Map
+import Text
+
+import MIPS.MIPS32
+import Snug.Syntax
+
+:: Locals :== Map SymbolIdent MemoryLocation
+
+:: MemoryLocation
+	= InRegister !Register
+	| Indirect !Register !Offset
+
+:: EntryPoint
+	= NodeEntry
+
+BackPrintPtr :== S 0
+FrontPrintPtr :== S 1
+BackEvalPtr :== S 2
+FrontEvalPtr :== S 3
+HeapPtr :== GP
+
+instance == (Namespaced id) | == id
+where
+	(==) x y = x.id == y.id && x.ns == y.ns
+
+instance < (Namespaced id) | < id
+where
+	(<) x y
+		| x.id < y.id = True
+		| x.id > y.id = False
+		| otherwise = x.ns < y.ns
+
+compile :: !Namespace ![Definition] -> [Line]
+compile ns defs =
+	concatMap (compileDefinition ns globals) defs
+where
+	globals =
+		{ constructors = 'Data.Map'.fromList
+			[ ({ns="", id="INT"}, ConstructorDef "INT" [])
+			]
+		, functions = 'Data.Map'.newMap
+		}
+
+compileDefinition :: !Namespace !Globals !Definition -> [Line]
+compileDefinition _ _ (TypeDef _ _) =
+	[]
+compileDefinition ns globals (DataDef _ _ constructors) =
+	[ StartSection "data"
+	: concatMap (compileConstructor ns globals) constructors
+	]
+compileDefinition ns globals (FunDef id args ret expr) =
+	[ StartSection "text"
+	, Align 3 // to have 3 bits unused in addresses
+	, RawWord (sum [2^i \\ i <- [0..] & _ <- args]) // all strict for now, TODO change
+	, RawWord (length args) // arity
+	, Label (functionLabel ns NodeEntry id)
+	: map Instr (compileExpr ns globals locals expr)
+	]
+where
+	locals = 'Data.Map'.fromList
+		[ (id, Indirect FrontEvalPtr (offset*4))
+		\\ (id,_) <- args
+		& offset <- [1..]
+		]
+
+compileConstructor :: !Namespace !Globals !ConstructorDef -> [Line]
+compileConstructor ns _ (ConstructorDef id args) =
+	[ Align 3 // to have 3 bits unused in addresses
+	, Label (constructorLabel ns id)
+	, RawWord (length args) // arity
+	, RawWord (size id) // length name
+	, RawAscii id // name
+	]
+
+compileExpr :: !Namespace !Globals !Locals !Expression -> [Instruction]
+compileExpr _ _ _ (BasicValue bv) =
+	// Build new node
+	[ LoadAddress (T 0) (Address 2 (constructorLabel "" (label bv)))
+	, StoreWord (T 0) 0 HeapPtr
+	] ++
+	loadImmediate bv ++
+	[ StoreWord (T 0) 4 HeapPtr
+	// Overwrite old node with indirection
+	, LoadAddress (T 0) (Address 0 (functionLabel "" NodeEntry "indir"))
+	, StoreWord (T 0) 0 FrontEvalPtr
+	, StoreWord HeapPtr 4 FrontEvalPtr
+	// Update front and heap pointers; return
+	, Move FrontEvalPtr HeapPtr
+	, Jump NoLink (Direct (Address 0 "eval"))
+	, AddImmediate Signed GP GP (Immediate 8)
+	]
+where
+	label (BVInt _) = "INT"
+	label (BVChar _) = "CHAR"
+
+	loadImmediate (BVInt i)
+		| 0 <= i && i < 0x10000 =
+			[ OrImmediate (T 0) R0 (Immediate i)
+			]
+		| 0 > i && i >= -0x8000 =
+			[ AddImmediate Signed (T 0) R0 (Immediate i)
+			]
+		| otherwise =
+			[ LoadUpperImmediate (T 0) (Immediate (i >> 16))
+			, OrImmediate (T 0) (T 0) (Immediate (i bitand 0xffff))
+			]
+compileExpr _ _ _ _ = [Nop]// TODO
+//	| Symbol !SymbolIdent
+//	| Constructor !ConstructorIdent
+//	| Case !Expression ![CaseAlternative]
+//	| ExpApp !Expression !Expression
+
+constructorLabel :: !Namespace !ConstructorIdent -> Label
+constructorLabel "" id = "_c" +++ id // for built-in constructors
+constructorLabel ns id = concat4 "__" ns "_c" id // TODO escaping
+
+functionLabel :: !Namespace !EntryPoint !ConstructorIdent -> Label
+functionLabel ns entry_point id // TODO escaping
+	| size ns == 0
+		= {#'_',e} +++ id
+		= concat4 "__" ns {#'_',e} id
+where
+	e = case entry_point of
+		NodeEntry -> 'n'
diff --git a/snug-clean/src/snug.icl b/snug-clean/src/snug.icl
index 1cdfcf6..23d24d0 100644
--- a/snug-clean/src/snug.icl
+++ b/snug-clean/src/snug.icl
@@ -3,20 +3,41 @@ module snug
 import StdEnv
 import StdMaybe
 
+import Data.Error
+import Data.List
 import System.CommandLine
+import System.File
+import System.FilePath
+import Text
 
+import MIPS.MIPS32
+import Snug.Compile
 import Snug.Parse
 
+/* Note: after compiling with
+ *   snug program.snug
+ * an assembly file program.s is generated, which can be run with SPIM using
+ *   spim -delayed_branches <(cat driver.s program.s)
+ */
+
 Start w
 	# ([prog:args],w) = getCommandLine w
 	| length args <> 1 = abort ("Usage: " +++ prog +++ " INPUT\n")
 	# input = hd args
+	  output = dropExtension input +++ ".s"
 	# (mbInput,w) = readFile input w
 	  input = fromJust mbInput
 	| isNone mbInput = abort "Failed to read input\n"
-	| otherwise = parseSnug input
+	# mbDefs = parseSnug input
+	  defs = fromOk mbDefs
+	| isError mbDefs = abort ("Failed to parse: " +++ fromError mbDefs +++ "\n")
+	# assembly = compile "main" defs
+	# assembly = join "\n" (map toString assembly)
+	# (mbErr,w) = writeFile output assembly w
+	| isError mbErr = abort ("Failed to write output: " +++ toString (fromError mbErr) +++ "\n")
+	| otherwise = w
 
-readFile :: !String !*World -> (!?[Char], !*World)
+readFile :: !FilePath !*World -> (!?[Char], !*World)
 readFile path w
 	# (ok,f,w) = fopen path FReadData w
 	| not ok = (?None, w)