commit 642fcbd636584b9e24c651a9b9fe8bab18340a7c Author: NikolajDanger Date: Wed May 4 10:40:19 2022 +0200 fasto unzipped diff --git a/fasto/Fasto/AbSyn.fs b/fasto/Fasto/AbSyn.fs new file mode 100644 index 0000000..c0bf3bd --- /dev/null +++ b/fasto/Fasto/AbSyn.fs @@ -0,0 +1,303 @@ +module AbSyn + +(* + Types and utilities for the abstract syntax tree (AbSyn) of Fasto. + Fasto er et funktionelt array-sprog til oversættelse, F-A-S-T-O. + Fasto er også et spansk ord, der betyder "pomp" eller "pragt". + Derfor skal vi programmere en "pragtfuld" oversætter for Fasto. + + The abstract syntax of a (Fasto) program is a representation of the (Fasto) + program in terms of a data type in another programming language (F#). + + Some expressions in Fasto (e.g. array constants, indexing operations, map, + reduce) are implicitly typed, their types are not explicitly stated in the + program text. Their types are infered at run-time by an interpreter, or at + compile-time by a type-checker. + + In support of this, this module defines type-parameterized datatypes for + expressions "Exp<'T>", let declarations "Dec<'T>", function arguments + "FunArg<'T>", function declaration "FunDec<'T>", and program "Prog<'T>". + These datatypes are instantiated over the "unit" and "Type" types to provide + an abstract syntax tree without type information, e.g., "UntypedProg = Prog", + and another abstract syntax tree in which the inferred type information + is made explicit in the representation "TypedProg = Prog". + + For example: + - interpretation uses the untyped version "TypedProg", + - the type checking phase receives as input an untype program ("UntypedProg") + and produces a typed program ("TypedProg") + - the other compiler phases work on the typed program. + + Note that semantically we use two different AbSyns, but we avoid code duplication + by means of the afore-mentioned type parameterization. + + Also our AbSyn stores not just the program structure, but also the positions of + the program substructures in the original program text. This is useful for + reporting errors at later passes of the compiler, e.g. type errors. + + This module also provides pretty printing functionality, printing a valid Fasto + program given its abstract syntax. "pp" is used in this module as a shorthand + for "prettyPrint". +*) + +(*** Helper Functions ***) +let toCString (s : string) : string = + let escape c = + match c with + | '\\' -> "\\\\" + | '"' -> "\\\"" + | '\n' -> "\\n" + | '\t' -> "\\t" + | _ -> System.String.Concat [c] + String.collect escape s + +// Doesn't actually support all escapes. Too badefacilliteter. +let fromCString (s : string) : string = + let rec unescape l: char list = + match l with + | [] -> [] + | '\\' :: 'n' :: l' -> '\n' :: unescape l' + | '\\' :: 't' :: l' -> '\t' :: unescape l' + | '\\' :: c :: l' -> c :: unescape l' + | c :: l' -> c :: unescape l' + Seq.toList s |> unescape |> System.String.Concat + +(* position: (line, column) *) +type Position = int * int + +type Type = + Int + | Bool + | Char + | Array of Type + +type Value = + IntVal of int + | BoolVal of bool + | CharVal of char + | ArrayVal of Value list * Type + (* Type corresponds to the element-type of the array *) + +(* Indentifies value types (for type checking) *) +let valueType = function + | (IntVal _) -> Int + | (BoolVal _) -> Bool + | (CharVal _) -> Char + | (ArrayVal (_,tp)) -> Array tp + +(* pretty printing types *) +let rec ppType = function + | Int -> "int" + | Char -> "char" + | Bool -> "bool" + | Array tp -> "[" + ppType tp + "]" + +(* Parameter declaration *) +type Param = + Param of string * Type + +type Exp<'T> = + Constant of Value * Position + | StringLit of string * Position + | ArrayLit of Exp<'T> list * 'T * Position + | Var of string * Position + | Plus of Exp<'T> * Exp<'T> * Position + | Minus of Exp<'T> * Exp<'T> * Position + | Equal of Exp<'T> * Exp<'T> * Position + | Less of Exp<'T> * Exp<'T> * Position + | If of Exp<'T> * Exp<'T> * Exp<'T> * Position + | Apply of string * Exp<'T> list * Position + | Let of Dec<'T> * Exp<'T> * Position + | Index of string * Exp<'T> * 'T * Position + + (* dirty I/O *) + | Read of Type * Position + | Write of Exp<'T> * 'T * Position + + (* Project implementations *) + | Times of Exp<'T> * Exp<'T> * Position + | Divide of Exp<'T> * Exp<'T> * Position + | Negate of Exp<'T> * Position + | And of Exp<'T> * Exp<'T> * Position + | Or of Exp<'T> * Exp<'T> * Position + | Not of Exp<'T> * Position + + (* Array constructors/combinators implementations *) + | Iota of Exp<'T> * Position + + (* map (f, array) + the first 'T corresponds to the mapped array element type, + which is the same as the f's input type; + the second 'T corresponds to the result-array element type, + which is the same as the f's result type. + *) + | Map of FunArg<'T> * Exp<'T> * 'T * 'T * Position + + (* reduce (f, acc, array) + the 'T argument corresponds to the array element type, + which is the same as the f's result type. + *) + | Reduce of FunArg<'T> * Exp<'T> * Exp<'T> * 'T * Position + + (* replicate(n, a); the 'T argument is the type of the + the second expression (i.e., a's type) + *) + | Replicate of Exp<'T> * Exp<'T> * 'T * Position + + (* filter (p, array) + p is a predicate, i.e., a function of type alpha -> bool + the 'T argument corresponds to the array element type, + which is the same as the f's input type (alpha); + *) + | Filter of FunArg<'T> * Exp<'T> * 'T * Position + + (* scan (f, acc, array); the 'T argument is as in reduce's case *) + | Scan of FunArg<'T> * Exp<'T> * Exp<'T> * 'T * Position + +and Dec<'T> = + Dec of string * Exp<'T> * Position + +and FunArg<'T> = + FunName of string + | Lambda of Type * Param list * Exp<'T> * Position + +(* A function declaration is a tuple of: +(i) function name, +(ii) return type, +(iii) formal arguments names & types, +(iv) function's body, +(v) Position. *) +type FunDec<'T> = + FunDec of string * Type * Param list * Exp<'T> * Position + + +(* Functions for extracting function properties *) +let getFunName (FunDec(fid, _, _, _, _)) = fid +let getFunRTP (FunDec(_, rtp, _, _, _)) = rtp +let getFunArgs (FunDec(_, _, arg, _, _)) = arg +let getFunBody (FunDec(_, _, _, bdy, _)) = bdy +let getFunPos (FunDec(_, _, _, _, pos)) = pos + +type Prog<'T> = FunDec<'T> list + +(****************************************************) +(********** Pretty-Printing Functionality ***********) +(****************************************************) + +let rec indent = function + | 0 -> "" + | n -> " " + indent (n-1) + +let ppParam = function + | Param(id, tp) -> ppType tp + " " + id + +let rec ppParams = function + | [] -> "" + | [bd] -> ppParam bd + | bd::l -> ppParam bd + ", " + ppParams l + +let rec ppVal d = function + | IntVal n -> sprintf "%i" n + | BoolVal b -> sprintf "%b" b + | CharVal c -> "'" + toCString (string c) + "'" + | ArrayVal (vals, t) -> "{ " + (String.concat ", " (List.map (ppVal d) vals)) + " }" + +let newLine exp = match exp with + | Let _ -> "" + | _ -> "\n" + +let rec ppExp d = function + | Constant(v, _) -> ppVal d v + | StringLit(s,_) -> "\"" + toCString s + "\"" + | ArrayLit(es, t, _) -> "{ " + (String.concat ", " (List.map (ppExp d) es)) + " }" + | Var (id, _) -> id + | Plus (e1, e2, _) -> "(" + ppExp d e1 + " + " + ppExp d e2 + ")" + | Minus (e1, e2, _) -> "(" + ppExp d e1 + " - " + ppExp d e2 + ")" + | Times (e1, e2, _) -> "(" + ppExp d e1 + " * " + ppExp d e2 + ")" + | Divide (e1, e2, _) -> "(" + ppExp d e1 + " / " + ppExp d e2 + ")" + | And (e1, e2, _) -> "(" + ppExp d e1 + " && " + ppExp d e2 + ")" + | Or (e1, e2, _) -> "(" + ppExp d e1 + " || " + ppExp d e2 + ")" + | Not (e, _) -> "not("+ppExp d e + ")" + | Negate (e, _) -> "~(" + ppExp d e + ")" + | Equal (e1, e2, _) -> "(" + ppExp d e1 + " == " + ppExp d e2 + ")" + | Less (e1, e2, _) -> "(" + ppExp d e1 + " < " + ppExp d e2 + ")" + | If (e1, e2, e3, _) -> ("if (" + ppExp d e1 + ")\n" + + indent (d+2) + "then " + ppExp (d+2) e2 + "\n" + + indent (d+2) + "else " + ppExp (d+2) e3 + "\n" + + indent d) + | Apply (id, args, _) -> (id + "(" + + (String.concat ", " (List.map (ppExp d) args)) + ")") + | Let (Dec(id, e1, _), e2, _) -> ("\n" + indent (d+1) + "let " + id + " = " + + ppExp (d+2) e1 + " in" + newLine e2 + + indent (d+1) + ppExp d e2) + | Index (id, e, t, _) -> id + "[" + ppExp d e + "]" + | Iota (e, _) -> "iota(" + ppExp d e + ")" + | Replicate (e, el, t, pos) -> "replicate(" + ppExp d e + ", " + ppExp d el + ")" + | Map (f, e, _, _, _) -> "map(" + ppFunArg d f + ", " + ppExp d e + ")" + | Filter (f, arr, _, _) -> ("filter(" + ppFunArg d f + ", " + ppExp d arr + ")") + | Reduce (f, el, lst, _, _) -> + "reduce(" + ppFunArg d f + ", " + ppExp d el + ", " + ppExp d lst + ")" + | Scan (f, acc, arr, _, pos) -> ("scan(" + ppFunArg d f + + ", " + ppExp d acc + + ", " + ppExp d arr + ")") + | Read (t, _) -> "read(" + ppType t + ")" + | Write (e, t, _) -> "write(" + ppExp d e + ")" + +and ppFunArg d = function + | FunName s -> s + | Lambda (rtp, args, body, _) -> ("fn " + ppType rtp + " (" + + ppParams args + ") => " + ppExp (d+2) body) + +(* pretty prints a function declaration *) +let ppFun d = function + | FunDec(id, rtp, args, body, _) -> ( "fun " + ppType rtp + " " + id + + "(" + ppParams args + ") =" + + indent (d+1) + ppExp(d+1) body ) + +(* Pretty pringint a program *) +let ppProg (p : Prog<'T>) = (String.concat "\n\n" (List.map (ppFun 0) p)) + "\n" + +let expPos = function + | Constant (_, p) -> p + | StringLit (_, p) -> p + | ArrayLit (_, _, p) -> p + | Var (_, p) -> p + | Plus (_, _, p) -> p + | Minus (_, _, p) -> p + | Equal (_, _, p) -> p + | Less (_, _, p) -> p + | If (_, _, _, p) -> p + | Apply (_, _, p) -> p + | Let (_, _, p) -> p + | Index (_, _, _, p) -> p + | Iota (_, p) -> p + | Replicate (_, _, _, p) -> p + | Map (_, _, _, _, p) -> p + | Filter (_, _, _, p) -> p + | Reduce (_, _, _, _, p) -> p + | Scan (_, _, _, _, p) -> p + | Read (_, p) -> p + | Write (_, _, p) -> p + | Times (_, _, p) -> p + | Divide (_, _, p) -> p + | And (_, _, p) -> p + | Or (_, _, p) -> p + | Not (_, p) -> p + | Negate (_, p) -> p + + + +type UntypedExp = Exp +type TypedExp = Exp + +type UntypedDec = Dec +type TypedDec = Dec + +type UntypedFunDec = FunDec +type TypedFunDec = FunDec + +type UntypedFunArg = FunArg +type TypedFunArg = FunArg + +type UntypedProg = Prog +type TypedProg = Prog diff --git a/fasto/Fasto/CallGraph.fs b/fasto/Fasto/CallGraph.fs new file mode 100644 index 0000000..0178adb --- /dev/null +++ b/fasto/Fasto/CallGraph.fs @@ -0,0 +1,87 @@ +module CallGraph + +type CallGraph = (string * string list) list + + +let callsOf (caller : string) + (graph : CallGraph) = + match List.tryFind (fun (x,_) -> x = caller) graph with + | None -> [] + | Some (_, calls) -> calls + +let calls (caller : string) + (callee : string) + (graph : CallGraph) = + List.exists (fun x -> x=callee) (callsOf caller graph) + +open AbSyn + + +(* Remove duplicate elements in a list. Quite slow - O(n^2) - + but our lists here will be small. *) +let rec nub = function + | [] -> [] + | x::xs -> if List.exists (fun y -> y = x) xs + then nub xs + else x :: nub xs + +let rec expCalls = function + | Constant _ -> [] + | StringLit _ -> [] + | ArrayLit (es, _, _) -> List.concat (List.map expCalls es) + | Var _ -> [] + | Plus (e1, e2, _) -> expCalls e1 @ expCalls e2 + | Minus (e1, e2, _) -> expCalls e1 @ expCalls e2 + | Equal (e1, e2, _) -> expCalls e1 @ expCalls e2 + | Less (e1, e2, _) -> expCalls e1 @ expCalls e2 + | If (e1, e2, e3, _) -> expCalls e1 @ expCalls e2 @ expCalls e3 + | Apply (fname, es, _) -> fname :: List.concat (List.map expCalls es) + | Let ( Dec(_, e, _), body, _) -> expCalls e @ expCalls body + | Index (_, e, _, _) -> expCalls e + | Iota (e, _) -> expCalls e + | Map (farg, e, _, _, _) -> fargCalls farg @ expCalls e + | Filter (farg, e, _, _) -> fargCalls farg @ expCalls e + | Reduce (farg, e1, e2, _, _) -> fargCalls farg @ expCalls e1 @ expCalls e2 + | Replicate (n, e, _, _) -> expCalls n @ expCalls e + | Scan (farg, e1, e2, _, _) -> fargCalls farg @ expCalls e1 @ expCalls e2 + | Times (e1, e2, _) -> expCalls e1 @ expCalls e2 + | Divide (e1, e2, _) -> expCalls e1 @ expCalls e2 + | And (e1, e2, _) -> expCalls e1 @ expCalls e2 + | Or (e1, e2, _) -> expCalls e1 @ expCalls e2 + | Not (e, _) -> expCalls e + | Negate (e, _) -> expCalls e + | Read _ -> [] + | Write (e, _, _) -> expCalls e + +and fargCalls = function + | Lambda (_, _, body, _) -> expCalls body + | FunName s -> [s] + +(* Get the direct function calls of a single function *) + +let functionCalls = function + | FunDec (fname, _, _, body, _) -> (fname, nub (expCalls body)) + +(* Expand the direct function call graph to its transitive closure. *) +let rec transitiveClosure (graph : CallGraph) = + let grow ((caller : string), + (callees : string list)) = + let calleecalls = + List.concat (List.map (fun callee -> + callsOf callee graph) callees) + let newCalls = (List.filter (fun call -> + not (List.exists (fun x -> x = call) callees) + ) calleecalls) + if List.isEmpty newCalls + then ((caller, callees), + false) + else ((caller, callees @ nub newCalls), + true) + let (graph', changes) = List.unzip (List.map grow graph) + let changed = List.exists (fun x -> x) changes + if changed + then transitiveClosure graph' + else graph' + +let callGraph (prog : TypedProg) = + transitiveClosure (List.map functionCalls prog) diff --git a/fasto/Fasto/CodeGen.fs b/fasto/Fasto/CodeGen.fs new file mode 100644 index 0000000..d4dc31d --- /dev/null +++ b/fasto/Fasto/CodeGen.fs @@ -0,0 +1,877 @@ +(* Code generator for Fasto *) + +module CodeGen + +(* + compile : TypedProg -> Mips.Instruction list + + (* for debugging *) + compileExp : TypedExp + -> SymTab + -> Mips.reg + -> Mips.Instruction list +*) + +open AbSyn + +exception MyError of string * Position + +type VarTable = SymTab.SymTab + +(* Name generator for labels and temporary symbolic registers *) +(* Example usage: val tmp = newName "tmp" (* might produce _tmp_5_ *) *) + +let mutable counter = 0 + +let newName base_name = + counter <- counter + 1 + "_" + base_name + "_" + string counter + "_" + +let newReg reg_name = Mips.RS (newName reg_name) + +let newLab lab_name = newName lab_name + +(* Table storing all string literals, with labels given to them *) +let stringTable : ((Mips.addr*string) list) ref = ref [] +(* could also contain "\n", ",", "Index out of bounds in line ", but the + format is a bit different (length and dummy pointer come first) *) + +(* Building a string in the heap, including initialisation code *) +let buildString ( label : Mips.addr + , str : string + ) : (Mips.Instruction list * Mips.Instruction list) = + let data = [ Mips.ALIGN 2 (* means: word-align *) + ; Mips.LABEL label (* pointer *) + ; Mips.SPACE 4 (* sizeof(Int) *) + ; Mips.ASCIIZ str] + let initR = Mips.RS (label + "_init") + let addrR = Mips.RS (label + "_addr") + let initcode = [ Mips.LA(addrR, label) + ; Mips.LI(initR, String.length str) + ; Mips.SW(initR, addrR, 0) ] + (initcode, data) + +(* Link register *) +let RA = Mips.RN 31 +(* Register for stack pointer *) +let SP = Mips.RN 29 +(* Register for heap pointer *) +let HP = Mips.RN 28 +(* Constant-zero register *) +let RZ = Mips.RN 0 + +(* General scratch-pad registers *) +let RN2 = Mips.RN 2 +let RN4 = Mips.RN 4 +let RN5 = Mips.RN 5 +let RN6 = Mips.RN 6 + +(* Suggested register division *) +let minReg = 2 (* lowest usable register *) +let maxCaller = 15 (* highest caller-saves register *) +let maxReg = 25 (* highest allocatable register *) + +(* Syscall numbers for MARS, to be put in $2 *) +let sysPrintInt = 1 (* print integer in $4 *) +let sysPrintString = 4 (* print NUL-terminated string starting at $4 *) +let sysReadInt = 5 (* read integer into $2 *) +let sysExit = 10 (* terminate execution *) +let sysPrintChar = 11 (* print character in $4 *) +let sysReadChar = 12 (* read character into $2 *) + +(* Determine the size of an element in an array based on its type *) +type ElemSize = ESByte | ESWord + +let getElemSize (tp : Type) : ElemSize = + match tp with + | Char -> ESByte + | Bool -> ESByte + | _ -> ESWord + +let elemSizeToInt (elmsz : ElemSize) : int = + match elmsz with + | ESByte -> 1 + | ESWord -> 4 + +(* Pick the correct instruction from the element size. *) +let mipsLoad elem_size = match elem_size with + | ESByte -> Mips.LB + | ESWord -> Mips.LW + +let mipsStore elem_size = match elem_size with + | ESByte -> Mips.SB + | ESWord -> Mips.SW + +(* generates the code to check that the array index is within bounds *) +let checkBounds ( arr_beg : Mips.reg + , ind_reg : Mips.reg + , (line : int, c : int) + ) : Mips.Instruction list = + let size_reg = newReg "size_reg" + let tmp_reg = newReg "tmp_reg" + let err_lab = newLab "error_lab" + let safe_lab = newLab "safe_lab" + [ Mips.LW(size_reg, arr_beg, 0) + ; Mips.BGEZ(ind_reg, safe_lab) (* check that ind_reg >= 0 *) + ; Mips.LABEL(err_lab) + ; Mips.LI(RN5, line) + ; Mips.LA(RN6, "_Msg_IllegalIndex_") + ; Mips.J "_RuntimeError_" + ; Mips.LABEL(safe_lab) + ; Mips.SUB(tmp_reg, ind_reg, size_reg) + ; Mips.BGEZ(tmp_reg, err_lab) (* check that ind_reg < -size_reg *) + ] + +(* dynalloc(size_reg, place, ty) generates code for allocating arrays of heap + memory by incrementing the HP register (heap pointer) by a number of words. + The arguments for this function are as follows: + + size_reg: contains the logical array size (number of array elements) + place: will contain the address of new allocation (old HP) + ty: char/bool elements take 1 byte, int elements take 4 bytes + *) +let dynalloc (size_reg : Mips.reg, + place : Mips.reg, + ty : Type ) + : Mips.Instruction list = + let tmp_reg = newReg "tmp" + + (* Use old HP as allocation address. *) + let code1 = [ Mips.MOVE (place, HP) ] + + (* For char/bool: Align address to 4-byte boundary by rounding up. *) + (* (By adding 3 and rounding down using SRA/SLL.) *) + (* For int and arrays: Multiply logical size by 4, no alignment. *) + let code2 = + match getElemSize ty with + | ESByte -> [ Mips.ADDI(tmp_reg, size_reg, 3) + ; Mips.SRA (tmp_reg, tmp_reg, 2) + ; Mips.SLL (tmp_reg, tmp_reg, 2) ] + | ESWord -> [ Mips.SLL (tmp_reg, size_reg, 2) ] + + (* Make space for array size (+4). Increase HP. *) + (* Save size of allocation in header. *) + let code3 = + [ Mips.ADDI (tmp_reg, tmp_reg, 4) + ; Mips.ADD (HP, HP, tmp_reg) + ; Mips.SW (size_reg, place, 0) ] + + code1 @ code2 @ code3 + +(* Pushing arguments on the stack: *) +(* For each register 'r' in 'rs', copy them to registers from +'firstReg' and counting up. Return the full code and the next unused +register (firstReg + num_args). *) +let applyRegs ( fid : Mips.addr + , args : Mips.reg list + , place: Mips.reg + , pos : Position ) + : Mips.Instruction list = + let regs_num = List.length args + let caller_regs = List.map (fun n -> Mips.RN (n + minReg)) [0..regs_num-1] + // List.tabulate (regs_num, fun n -> n + minReg) + (* zipWith Mips.MOVE = + zipWith (fun (regDest, regSrc) -> Mips.MOVE (regDest, regSrc)) *) + let move_code = List.map Mips.MOVE (List.zip caller_regs args) + if regs_num > maxCaller - minReg + then raise (MyError("Number of arguments passed to " + fid + + " exceeds number of caller registers", pos)) + else move_code @ [ Mips.JAL(fid,caller_regs); Mips.MOVE(place, RN2) ] + + +(* Compile 'e' under bindings 'vtable', putting the result in register 'place'. *) +let rec compileExp (e : TypedExp) + (vtable : VarTable) + (place : Mips.reg) + : Mips.Instruction list = + match e with + | Constant (IntVal n, pos) -> + if n < 0 then + compileExp (Negate (Constant (IntVal (-n), pos), pos)) vtable place + else if n < 32768 then + [ Mips.LI (place, n) ] + else + [ Mips.LUI (place, n / 65536) + ; Mips.ORI (place, place, n % 65536) ] + | Constant (BoolVal p, _) -> + (* TODO project task 1: represent `true`/`false` values as `1`/`0` *) + failwith "Unimplemented code generation of boolean constants" + | Constant (CharVal c, pos) -> [ Mips.LI (place, int c) ] + + (* Create/return a label here, collect all string literals of the program + (in stringTable), and create them in the data section before the heap + (Mips.ASCIIZ) *) + | StringLit (strLit, pos) -> + (* Convert string literal into label; only use valid characters. *) + let normalChars0 = //String.filter System.Char.IsLetterOrDigit strLit + String.map (fun c -> if System.Char.IsLetterOrDigit c then c else 'a') strLit + let normalChars = normalChars0 + "__str__" + let label = newLab (normalChars.Substring (0, 7)) + let () = stringTable := (label, strLit)::(!stringTable) + [ Mips.LA (place, label) + ; Mips.COMMENT (label + ": string \"" + toCString strLit + "\"") ] + + | Constant (ArrayVal (vs, tp), pos) -> + (* Create corresponding ArrayLit expression to re-use code. *) + let arraylit = ArrayLit (List.map (fun v -> Constant (v, pos)) vs, tp, pos) + compileExp arraylit vtable place + + | ArrayLit (elems, tp, pos) -> + let elem_size = getElemSize tp + let size_reg = newReg "size_reg" + let addr_reg = newReg "addr_reg" + let tmp_reg = newReg "tmp_reg" + + (* Store size of literal in size_reg, dynamically allocate that. *) + (* Let addr_reg contain the address for the first array element. *) + let header = [ Mips.LI (size_reg, List.length elems) ] @ + dynalloc (size_reg, place, tp) @ + [ Mips.ADDI (addr_reg, place, 4) ] + + let compileElem elem_exp = + let elem_code = compileExp elem_exp vtable tmp_reg + elem_code @ + [ mipsStore elem_size (tmp_reg, addr_reg, 0) + ; Mips.ADDI (addr_reg, addr_reg, elemSizeToInt elem_size) ] + + let elems_code = List.concat (List.map compileElem elems) + header @ elems_code + + | Var (vname, pos) -> + match SymTab.lookup vname vtable with + | None -> raise (MyError ("Name " + vname + " not found", pos)) + | Some reg_name -> [Mips.MOVE (place, reg_name)] + + | Plus (e1, e2, pos) -> + let t1 = newReg "plus_L" + let t2 = newReg "plus_R" + let code1 = compileExp e1 vtable t1 + let code2 = compileExp e2 vtable t2 + code1 @ code2 @ [Mips.ADD (place,t1,t2)] + + | Minus (e1, e2, pos) -> + let t1 = newReg "minus_L" + let t2 = newReg "minus_R" + let code1 = compileExp e1 vtable t1 + let code2 = compileExp e2 vtable t2 + code1 @ code2 @ [Mips.SUB (place,t1,t2)] + + (* TODO project task 1: + Look in `AbSyn.fs` for the expression constructors `Times`, ... + `Times` is very similar to `Plus`/`Minus`. + For `Divide`, you may ignore division by zero for a quick first + version, but remember to come back and clean it up later. + `Not` and `Negate` are simpler; you can use `Mips.XORI` for `Not` + *) + | Times (_, _, _) -> + failwith "Unimplemented code generation of multiplication" + + | Divide (_, _, _) -> + failwith "Unimplemented code generation of division" + + | Not (_, _) -> + failwith "Unimplemented code generation of not" + + | Negate (_, _) -> + failwith "Unimplemented code generation of negate" + + | Let (dec, e1, pos) -> + let (code1, vtable1) = compileDec dec vtable + let code2 = compileExp e1 vtable1 place + code1 @ code2 + + | If (e1, e2, e3, pos) -> + let thenLabel = newLab "then" + let elseLabel = newLab "else" + let endLabel = newLab "endif" + let code1 = compileCond e1 vtable thenLabel elseLabel + let code2 = compileExp e2 vtable place + let code3 = compileExp e3 vtable place + code1 @ [Mips.LABEL thenLabel] @ code2 @ + [ Mips.J endLabel; Mips.LABEL elseLabel ] @ + code3 @ [Mips.LABEL endLabel] + + (* special case for length *) + | Apply ("length", [arr], pos) -> + let arr_addr = newReg "len_arr" + let code1 = compileExp arr vtable arr_addr + code1 @ [ Mips.LW(place,arr_addr, 0) ] + | Apply (f, args, pos) -> + (* Convention: args in regs (2..15), result in reg 2 *) + let compileArg arg = + let arg_reg = newReg "arg" + (arg_reg, compileExp arg vtable arg_reg) + let (arg_regs, argcode) = List.unzip (List.map compileArg args) + let applyCode = applyRegs(f, arg_regs, place, pos) + List.concat argcode @ (* Evaluate args *) + applyCode (* Jump to function and store result in place *) + + (* dirty I/O. Read and Write: supported for basic types: Int, Char, + Bool via system calls. Write of an Array(Chars) is also + supported. The others are the user's responsibility. + *) + | Read(tp, pos) -> + match tp with + | Int -> [ Mips.JAL ("getint", [RN2]) + ; Mips.MOVE(place, RN2) + ] + | Char -> [ Mips.JAL ("getchar", [RN2]) + ; Mips.MOVE(place, RN2) + ] + | Bool -> + (* Note: the following inputs booleans as integers, with 0 + interpreted as false and everything else as true. This + differs from the interpreter! *) + let tl = newLab "true_lab" + let fl = newLab "false_lab" + let ml = newLab "merge_lab" + let v = newReg "bool_var" + [ Mips.JAL ("getint", [RN2]) + ; Mips.MOVE(v, RN2) + ; Mips.BEQ (v, RZ,fl) + ; Mips.J tl + ; Mips.LABEL fl + ; Mips.MOVE(place, RZ) + ; Mips.J ml + ; Mips.LABEL tl + ; Mips.LI (place, 1) + ; Mips.J ml + ; Mips.LABEL ml + ] + | _ -> raise (MyError("Read on an incompatible type: " + ppType tp, pos)) + + | Write(e, tp, pos) -> + let tmp = newReg "tmp" + let codeexp = compileExp e vtable tmp @ [ Mips.MOVE (place, tmp) ] + match tp with + | Int -> codeexp @ [ Mips.MOVE(RN2,place); Mips.JAL("putint", [RN2]) ] + | Char -> codeexp @ [ Mips.MOVE(RN2,place); Mips.JAL("putchar",[RN2]) ] + | Bool -> + let tlab = newLab "wBoolF" + codeexp @ + [ Mips.LA (RN2, "_true") + ; Mips.BNE (place, RZ, tlab) + ; Mips.LA (RN2, "_false") + ; Mips.LABEL tlab + ; Mips.JAL ("putstring", [RN2]) + ] + + | Array Char -> + codeexp @ [ Mips.MOVE (RN2, tmp) + ; Mips.JAL("putstring", [RN2]) ] + | _ -> raise (MyError("Write on an incompatible type: " + ppType tp, pos)) + + (* Comparison checking, later similar code for And and Or. *) + | Equal (e1, e2, pos) -> + let t1 = newReg "eq_L" + let t2 = newReg "eq_R" + let code1 = compileExp e1 vtable t1 + let code2 = compileExp e2 vtable t2 + let falseLabel = newLab "false" + code1 @ code2 @ + [ Mips.LI (place, 0) + ; Mips.BNE (t1,t2,falseLabel) + ; Mips.LI (place, 1) + ; Mips.LABEL falseLabel + ] + + | Less (e1, e2, pos) -> + let t1 = newReg "lt_L" + let t2 = newReg "lt_R" + let code1 = compileExp e1 vtable t1 + let code2 = compileExp e2 vtable t2 + code1 @ code2 @ [Mips.SLT (place,t1,t2)] + + (* TODO project task 1: + Look in `AbSyn.fs` for the expression constructors of `And` and `Or`. + The implementation of `And` and `Or` is more complicated than `Plus` + because you need to ensure the short-circuit semantics, e.g., + in `e1 || e2` if the execution of `e1` will evaluate to `true` then + the code of `e2` must not be executed. Similarly for `And` (&&). + *) + | And (_, _, _) -> + failwith "Unimplemented code generation of &&" + + | Or (_, _, _) -> + failwith "Unimplemented code generation of ||" + + (* Indexing: + 1. generate code to compute the index + 2. check index within bounds + 3. add the start address with the index + 4. get the element at that address + *) + | Index (arr_name, i_exp, ty, pos) -> + let ind_reg = newReg "arr_ind" + let ind_code = compileExp i_exp vtable ind_reg + let arr_reg = newReg "arr_reg" + + (* Let arr_reg be the start of the data segment *) + let arr_beg = + match SymTab.lookup arr_name vtable with + | None -> raise (MyError ("Name " + arr_name + " not found", pos)) + | Some reg_name -> reg_name + let init_code = [ Mips.ADDI(arr_reg, arr_beg, 4) ] + + (* code to check bounds *) + let check_code = checkBounds(arr_beg, ind_reg, pos) + + (* for INT/ARRAY: ind *= 4 else ind is unchanged *) + (* array_var += index; place = *array_var *) + let load_code = + match getElemSize ty with + | ESByte -> [ Mips.ADD(arr_reg, arr_reg, ind_reg) + ; Mips.LB(place, arr_reg, 0) ] + | ESWord -> [ Mips.SLL(ind_reg, ind_reg, 2) + ; Mips.ADD(arr_reg, arr_reg, ind_reg) + ; Mips.LW(place, arr_reg, 0) ] + ind_code @ init_code @ check_code @ load_code + + (* Second-Order Array Combinators (SOACs): + iota, map, reduce + *) + | Iota (n_exp, (line, _)) -> + let size_reg = newReg "size_reg" + let n_code = compileExp n_exp vtable size_reg + (* size_reg is now the integer n. *) + + (* Check that array size N >= 0: + if N >= 0 then jumpto safe_lab + jumpto "_IllegalArrSizeError_" + safe_lab: ... + *) + let safe_lab = newLab "safe_lab" + let checksize = [ Mips.BGEZ (size_reg, safe_lab) + ; Mips.LI (RN5, line) + ; Mips.LA (RN6, "_Msg_IllegalArraySize_") + ; Mips.J "_RuntimeError_" + ; Mips.LABEL (safe_lab) + ] + + let addr_reg = newReg "addr_reg" + let i_reg = newReg "i_reg" + let init_regs = [ Mips.ADDI (addr_reg, place, 4) + ; Mips.MOVE (i_reg, RZ) ] + (* addr_reg is now the position of the first array element. *) + + (* Run a loop. Keep jumping back to loop_beg until it is not the + case that i_reg < size_reg, and then jump to loop_end. *) + let loop_beg = newLab "loop_beg" + let loop_end = newLab "loop_end" + let tmp_reg = newReg "tmp_reg" + let loop_header = [ Mips.LABEL (loop_beg) + ; Mips.SUB (tmp_reg, i_reg, size_reg) + ; Mips.BGEZ (tmp_reg, loop_end) + ] + (* iota is just 'arr[i] = i'. arr[i] is addr_reg. *) + let loop_iota = [ Mips.SW (i_reg, addr_reg, 0) ] + let loop_footer = [ Mips.ADDI (addr_reg, addr_reg, 4) + ; Mips.ADDI (i_reg, i_reg, 1) + ; Mips.J loop_beg + ; Mips.LABEL loop_end + ] + n_code + @ checksize + @ dynalloc (size_reg, place, Int) + @ init_regs + @ loop_header + @ loop_iota + @ loop_footer + + | Map (farg, arr_exp, elem_type, ret_type, pos) -> + let size_reg = newReg "size_reg" (* size of input/output array *) + let arr_reg = newReg "arr_reg" (* address of array *) + let elem_reg = newReg "elem_reg" (* address of single element *) + let res_reg = newReg "res_reg" + let arr_code = compileExp arr_exp vtable arr_reg + + let get_size = [ Mips.LW (size_reg, arr_reg, 0) ] + + let addr_reg = newReg "addr_reg" (* address of element in new array *) + let i_reg = newReg "i_reg" + let init_regs = [ Mips.ADDI (addr_reg, place, 4) + ; Mips.MOVE (i_reg, RZ) + ; Mips.ADDI (elem_reg, arr_reg, 4) + ] + let loop_beg = newLab "loop_beg" + let loop_end = newLab "loop_end" + let tmp_reg = newReg "tmp_reg" + let loop_header = [ Mips.LABEL (loop_beg) + ; Mips.SUB (tmp_reg, i_reg, size_reg) + ; Mips.BGEZ (tmp_reg, loop_end) ] + (* map is 'arr[i] = f(old_arr[i])'. *) + let src_size = getElemSize elem_type + let dst_size = getElemSize ret_type + let loop_map = + [ mipsLoad src_size (res_reg, elem_reg, 0) + ; Mips.ADDI(elem_reg, elem_reg, elemSizeToInt src_size) + ] + @ applyFunArg(farg, [res_reg], vtable, res_reg, pos) + @ + [ mipsStore dst_size (res_reg, addr_reg, 0) + ; Mips.ADDI (addr_reg, addr_reg, elemSizeToInt dst_size) + ] + + let loop_footer = + [ Mips.ADDI (i_reg, i_reg, 1) + ; Mips.J loop_beg + ; Mips.LABEL loop_end + ] + arr_code + @ get_size + @ dynalloc (size_reg, place, ret_type) + @ init_regs + @ loop_header + @ loop_map + @ loop_footer + + (* reduce(f, acc, {x1, x2, ...xn}) = f(f(f(acc,x1),x2),...xn) *) + | Reduce (binop, acc_exp, arr_exp, tp, pos) -> + let arr_reg = newReg "arr_reg" (* address of array *) + let size_reg = newReg "size_reg" (* size of input array *) + let i_reg = newReg "ind_var" (* loop counter *) + let tmp_reg = newReg "tmp_reg" (* several purposes *) + let loop_beg = newLab "loop_beg" + let loop_end = newLab "loop_end" + + let arr_code = compileExp arr_exp vtable arr_reg + let header1 = [ Mips.LW(size_reg, arr_reg, 0) ] + + (* Compile initial value into place (will be updated below) *) + let acc_code = compileExp acc_exp vtable place + + (* Set arr_reg to address of first element instead. *) + (* Set i_reg to 0. While i < size_reg, loop. *) + let loop_code = + [ Mips.ADDI(arr_reg, arr_reg, 4) + ; Mips.MOVE(i_reg, RZ) + ; Mips.LABEL(loop_beg) + ; Mips.SUB(tmp_reg, i_reg, size_reg) + ; Mips.BGEZ(tmp_reg, loop_end) + ] + (* Load arr[i] into tmp_reg *) + let elem_size = getElemSize tp + let load_code = + [ mipsLoad elem_size (tmp_reg, arr_reg, 0) + ; Mips.ADDI (arr_reg, arr_reg, elemSizeToInt elem_size) + ] + (* place := binop(place, tmp_reg) *) + let apply_code = + applyFunArg(binop, [place; tmp_reg], vtable, place, pos) + + arr_code @ header1 @ acc_code @ loop_code @ load_code @ apply_code @ + [ Mips.ADDI(i_reg, i_reg, 1) + ; Mips.J loop_beg + ; Mips.LABEL loop_end + ] + + (* TODO project task 2: + `replicate (n, a)` + `filter (f, arr)` + `scan (f, ne, arr)` + Look in `AbSyn.fs` for the shape of expression constructors + `Replicate`, `Filter`, `Scan`. + General Hint: write down on a piece of paper the C-like pseudocode + for implementing them, then translate that to Mips pseudocode. + To allocate heap space for an array you may use `dynalloc` defined + above. For example, if `sz_reg` is a register containing an integer `n`, + and `ret_type` is the element-type of the to-be-allocated array, then + `dynalloc (sz_reg, arr_reg, ret_type)` will alocate enough space for + an n-element array of element-type `ret_type` (including the first + word that holds the length, and the necessary allignment padding), and + will place in register `arr_reg` the start address of the new array. + Since you need to allocate space for the result arrays of `Replicate`, + `Map` and `Scan`, then `arr_reg` should probably be `place` ... + + `replicate(n,a)`: You should allocate a new (result) array, and execute a + loop of count `n`, in which you store the value hold into the register + corresponding to `a` into each memory location corresponding to an + element of the result array. + If `n` is less than `0` then remember to terminate the program with + an error -- see implementation of `iota`. + *) + | Replicate (_, _, _, _) -> + failwith "Unimplemented code generation of replicate" + + (* TODO project task 2: see also the comment to replicate. + (a) `filter(f, arr)`: has some similarity with the implementation of map. + (b) Use `applyFunArg` to call `f(a)` in a loop, for every element `a` of `arr`. + (c) If `f(a)` succeeds (result in the `true` value) then (and only then): + - set the next element of the result array to `a`, and + - increment a counter (initialized before the loop) + (d) It is useful to maintain two array iterators: one for the input array `arr` + and one for the result array. (The latter increases slower because + some of the elements of the input array are skipped because they fail + under the predicate). + (e) The last step (after the loop writing the elments of the result array) + is to update the logical size of the result array to the value of the + counter computed in step (c). You do this of course with a + `Mips.SW(counter_reg, place, 0)` instruction. + *) + | Filter (_, _, _, _) -> + failwith "Unimplemented code generation of filter" + + (* TODO project task 2: see also the comment to replicate. + `scan(f, ne, arr)`: you can inspire yourself from the implementation of + `reduce`, but in the case of `scan` you will need to also maintain + an iterator through the result array, and write the accumulator in + the current location of the result iterator at every iteration of + the loop. + *) + | Scan (_, _, _, _, _) -> + failwith "Unimplemented code generation of scan" + +and applyFunArg ( ff : TypedFunArg + , args : Mips.reg list + , vtable : VarTable + , place : Mips.reg + , pos : Position + ) : Mips.Instruction list = + match ff with + | FunName s -> + let tmp_reg = newReg "tmp_reg" + applyRegs(s, args, tmp_reg, pos) @ [Mips.MOVE(place, tmp_reg)] + + | Lambda (_, parms, body, lampos) -> + let rec bindParams parms args vtable' = + match (parms, args) with + | (Param (pname,_)::parms', arg::args') -> + bindParams parms' args' (SymTab.bind pname arg vtable') + | _ -> vtable' + let vtable' = bindParams parms args vtable + let t = newReg "fun_arg_res" + compileExp body vtable' t @ [ Mips.MOVE(place, t) ] + +(* compile condition *) +and compileCond (c : TypedExp) + (vtable : VarTable) + (tlab : Mips.addr) + (flab : Mips.addr) + : Mips.Instruction list = + let t1 = newReg "cond" + let code1 = compileExp c vtable t1 + code1 @ [Mips.BNE (t1, RZ, tlab); Mips.J flab] + +(* compile let declaration *) +and compileDec (dec : TypedDec) + (vtable : VarTable) + : (Mips.Instruction list * VarTable) = + let (Dec (s,e,pos)) = dec + let t = newReg "letBind" + let code = compileExp e vtable t + let new_vtable = SymTab.bind s t vtable + (code, new_vtable) + +(* code for saving and restoring callee-saves registers *) +let rec stackSave (currentReg : int) + (maxReg : int) + (savecode : Mips.Instruction list) + (restorecode : Mips.Instruction list) + (offset : int) + : (Mips.Instruction list * Mips.Instruction list * int) = + if currentReg > maxReg + then (savecode, restorecode, offset) (* done *) + else stackSave (currentReg+1) + maxReg + (Mips.SW (Mips.RN currentReg, SP, offset) + :: savecode) (* save register *) + (Mips.LW (Mips.RN currentReg, SP, offset) + :: restorecode) (* restore register *) + (offset-4) (* adjust offset *) + +(* add function arguments to symbol table *) +and getArgs (parms : Param list) + (vtable : VarTable) + (nextReg : int) + : (Mips.Instruction list * VarTable) = + match parms with + | [] -> ([], vtable) + | (Param (v,_)::vs) -> + if nextReg > maxCaller + then raise (MyError ("Passing too many arguments!", (0,0))) + else let vname = newReg ("param_" + v) + let vtable1 = SymTab.bind v vname vtable (* (v,vname)::vtable *) + let (code2,vtable2) = getArgs vs vtable1 (nextReg + 1) + ([Mips.MOVE (vname, Mips.RN nextReg)] @ code2, vtable2) + +(* compile function declaration *) +and compileFun (fundec : TypedFunDec) : Mips.Prog = + let (FunDec (fname, resty, args, exp, (line,col))) = fundec + (* make a vtable from bound formal parameters, + then evaluate expression in this context, return it *) + (* arguments passed in registers, "move" into local vars. *) + let (argcode, vtable_local) = getArgs args (SymTab.empty ()) minReg + (* return value in register 2 *) + let rtmp = newReg (fname + "res") + let returncode = [Mips.MOVE (RN2,rtmp)] (* move return val to R2 *) + let body = compileExp exp vtable_local rtmp (* target expr *) + let (body1, _, maxr, spilled) = + RegAlloc.registerAlloc (* call register allocator *) + (argcode @ body @ returncode) + (Set.singleton (RN2)) 2 maxCaller maxReg 0 + let (savecode, restorecode, offset) = (* save/restore callee-saves *) + stackSave (maxCaller+1) maxr [] [] (-8 + (-4 * spilled)) + [Mips.COMMENT ("Function " + fname); + Mips.LABEL fname; (* function label *) + Mips.SW (RA, SP, -4)] (* save return address *) + @ savecode (* save callee-saves registers *) + @ [Mips.ADDI (SP,SP,offset)] (* SP adjustment *) + @ body1 (* code for function body *) + @ [Mips.ADDI (SP,SP,-offset)] (* move SP up *) + @ restorecode (* restore callee-saves registers *) + @ [Mips.LW (RA, SP, -4); (* restore return addr *) + Mips.JR (RA, [])] (* return *) + + +(* compile program *) +let compile (funs : TypedProg) : Mips.Instruction list = + let () = stringTable := [("_true","true"); ("_false","false")] + let funsCode = List.concat (List.map compileFun funs) + let (stringinit_sym, stringdata) = + List.unzip (List.map buildString (!stringTable)) + let (stringinit,_,_,_) = + match stringinit_sym with + | [] -> ([],Set.empty,0,0) + | _ -> RegAlloc.registerAlloc (* call register allocator *) + (List.concat stringinit_sym) + (Set.singleton (RN2)) 2 maxCaller maxReg 0 + let mips_prog = + [Mips.TEXT "0x00400000"; + Mips.GLOBL "main"] + (* initialisation: heap pointer and string pointers *) + @ (Mips.LA (HP, "_heap_"):: stringinit) + (* jump to main (and stop after returning) *) + @ [Mips.JAL ("main",[])] + @ (* stop code *) + [Mips.LABEL "_stop_"; + Mips.LI (RN2, sysExit); + Mips.SYSCALL] + @ (* code for functions *) + funsCode + (* pre-defined ord: char -> int and chr: int -> char *) + @ [Mips.LABEL "ord"; (* char returned unmodified, interpreted as int *) + Mips.JR (RA,[]); + Mips.LABEL "chr"; (* int values are truncated to 8 bit (ASCII), *) + Mips.ANDI (RN2, RN2, 255); + Mips.JR (RA,[])] + (* built-in read and write functions *) + @ [Mips.LABEL "putint"; (* putint function *) + Mips.ADDI(SP,SP,-8); + Mips.SW (RN2,SP,0); (* save used registers *) + Mips.SW (RN4,SP,4); + Mips.MOVE (RN4, RN2); (* convention: number to be written in r2 *) + Mips.LI (RN2, sysPrintInt); + Mips.SYSCALL; + Mips.LI (RN2, sysPrintString); + Mips.LA(RN4,"_space_"); + Mips.SYSCALL; (* write CR *) + Mips.LW (RN2,SP,0); (* reload used registers *) + Mips.LW (RN4,SP,4); + Mips.ADDI(SP,SP,8); + Mips.JR (RA,[]); + + Mips.LABEL "getint"; (* getint function *) + Mips.LI (RN2,sysReadInt); + Mips.SYSCALL; + Mips.JR (RA,[])] + @ (* putchar *) + [ Mips.LABEL "putchar"; + Mips.ADDI(SP,SP,-8); (* make space for 2 registers on the stack *) + Mips.SW (RN2,SP,0); (* save registers $2 and $4 to stack *) + Mips.SW (RN4,SP,4); + Mips.MOVE (RN4, RN2); (* put char in $4 for syscall to work on *) + Mips.LI(RN2, sysPrintChar); + Mips.SYSCALL; + Mips.LI (RN2, sysPrintString); + Mips.LA(RN4,"_space_"); (* the string we'll write is a space *) + Mips.SYSCALL; + Mips.LW (RN2,SP,0); (* reload registers $2 and $4 from stack *) + Mips.LW (RN4,SP,4); + Mips.ADDI(SP,SP,8); (* free stack space again *) + Mips.JR (RA,[]) + ] + @ (* getchar *) + [ Mips.LABEL "getchar"; + Mips.ADDI(SP,SP,-8); (* make space for 2 registers on the stack *) + Mips.SW (RN4,SP,0); (* save registers $4 and $5 to stack *) + Mips.SW (RN5,SP,4); + Mips.LI(RN2, sysReadChar); + Mips.SYSCALL; + Mips.MOVE(RN5,RN2); (* temporarily move the result in reg $5*) + Mips.LI (RN2, sysPrintString); + Mips.LA(RN4,"_cr_"); + Mips.SYSCALL; (* write CR *) + Mips.MOVE(RN2, RN5); (* put the result back in $2*) + Mips.LW (RN4, SP, 0); (* restore registers *) + Mips.LW (RN5, SP, 4); + Mips.ADDI(SP,SP,8); (* free stack space again *) + Mips.JR (RA,[]) + ] + @ (* putstring *) + [ Mips.LABEL "putstring"; + Mips.ADDI(SP, SP, -16); (* make space on stack for registers *) + Mips.SW (RN2, SP, 0); (* save registers $2,$4,$5,$6 to stack *) + Mips.SW (RN4, SP, 4); + Mips.SW (RN5, SP, 8); + Mips.SW (RN6, SP, 12); + Mips.LW (RN4, RN2, 0); (* $4 := size($2) *) + Mips.ADDI(RN5, RN2, 4); (* $5 := $2 + 4 *) + Mips.ADD (RN6, RN5, RN4); (* $6 := $5 + $4 *) + Mips.LI (RN2, sysPrintChar); + Mips.LABEL "putstring_begin"; + Mips.SUB (RN4, RN5, RN6); (* while ($5 < $6) { *) + Mips.BGEZ(RN4, "putstring_done"); (* *) + Mips.LB(RN4, RN5, 0); (* $4 := M[$5] *) + Mips.SYSCALL; (* putchar($4) *) + Mips.ADDI(RN5, RN5, 1); (* $5 := $5 + 1 *) + Mips.J "putstring_begin"; (* } *) + Mips.LABEL "putstring_done"; + Mips.LW (RN2, SP, 0); (* restore registers $2,$4,$5,$6 *) + Mips.LW (RN4, SP, 4); + Mips.LW (RN5, SP, 8); + Mips.LW (RN6, SP, 12); + Mips.ADDI(SP, SP, 16); (* free stack space again *) + Mips.JR (RA,[]) + ] + @ (* Fixed code for reporting runtime errors. + expects source line number in $5, pointer to error message in $6 *) + [Mips.LABEL "_RuntimeError_"; + Mips.LA (RN4, "_ErrMsg_"); + Mips.LI (RN2, sysPrintString); Mips.SYSCALL; + Mips.MOVE (RN4, RN5); + Mips.LI (RN2, sysPrintInt); Mips.SYSCALL; + Mips.LA (RN4, "_colon_space_"); + Mips.LI (RN2, sysPrintString); Mips.SYSCALL; + Mips.MOVE (RN4, RN6); + Mips.LI (RN2, sysPrintString); Mips.SYSCALL; + Mips.LA (RN4, "_cr_"); + Mips.LI (RN2, sysPrintString); Mips.SYSCALL; + Mips.J "_stop_"] + @ + [Mips.DATA ""; + Mips.COMMENT "Fixed strings for I/O"; + Mips.LABEL "_ErrMsg_"; + Mips.ASCIIZ "Runtime error at line "; + Mips.LABEL "_colon_space_"; + Mips.ASCIIZ ": "; + Mips.LABEL "_cr_"; + Mips.ASCIIZ "\n"; + Mips.LABEL "_space_"; + Mips.ASCIIZ " "] + @ + [Mips.COMMENT "Message strings for specific errors"; + Mips.LABEL "_Msg_IllegalArraySize_"; + Mips.ASCIIZ "negative array size"; + Mips.LABEL "_Msg_IllegalIndex_"; + Mips.ASCIIZ "array index out of bounds" + Mips.LABEL "_Msg_DivZero_"; + Mips.ASCIIZ "division by zero" + ] + @ (* String literals *) + (Mips.COMMENT "String Literals" :: + List.concat stringdata) + (* Heap (to allocate arrays in, word-aligned) *) + @ [Mips.ALIGN 2; + Mips.LABEL "_heap_"; + Mips.SPACE 100000] + mips_prog diff --git a/fasto/Fasto/CopyConstPropFold.fs b/fasto/Fasto/CopyConstPropFold.fs new file mode 100644 index 0000000..0afe02f --- /dev/null +++ b/fasto/Fasto/CopyConstPropFold.fs @@ -0,0 +1,208 @@ +module CopyConstPropFold + + +(* + (* An optimisation takes a program and returns a new program. *) + val optimiseProgram : Fasto.KnownTypes.Prog -> Fasto.KnownTypes.Prog +*) + +open AbSyn + +(* A propagatee is something that we can propagate - either a variable + name or a constant value. *) +type Propagatee = + ConstProp of Value + | VarProp of string + +type VarTable = SymTab.SymTab + +let rec copyConstPropFoldExp (vtable : VarTable) + (e : TypedExp) = + match e with + (* Copy propagation is handled entirely in the following three + cases for variables, array indexing, and let-bindings. *) + | Var (name, pos) -> + (* TODO project task 3: + Should probably look in the symbol table to see if + a binding corresponding to the current variable `name` + exists and if so, it should replace the current expression + with the variable or constant to be propagated. + *) + failwith "Unimplemented copyConstPropFold for Var" + | Index (name, e, t, pos) -> + (* TODO project task 3: + Should probably do the same as the `Var` case, for + the array name, and optimize the index expression `e` as well. + *) + failwith "Unimplemented copyConstPropFold for Index" + | Let (Dec (name, e, decpos), body, pos) -> + let e' = copyConstPropFoldExp vtable e + match e' with + | Var (_, _) -> + (* TODO project task 3: + Hint: I have discovered a variable-copy statement `let x = a`. + I should probably record it in the `vtable` by + associating `x` with a variable-propagatee binding, + and optimize the `body` of the let. + *) + failwith "Unimplemented copyConstPropFold for Let with Var" + | Constant (_, _) -> + (* TODO project task 3: + Hint: I have discovered a constant-copy statement `let x = 5`. + I should probably record it in the `vtable` by + associating `x` with a constant-propagatee binding, + and optimize the `body` of the let. + *) + failwith "Unimplemented copyConstPropFold for Let with Constant" + | Let (_, _, _) -> + (* TODO project task 3: + Hint: this has the structure + `let y = (let x = e1 in e2) in e3` + Problem is, in this form, `e2` may simplify + to a variable or constant, but I will miss + identifying the resulting variable/constant-copy + statement on `y`. + A potential solution is to optimize directly the + restructured, semantically-equivalent expression: + `let x = e1 in let y = e2 in e3` + *) + failwith "Unimplemented copyConstPropFold for Let with Let" + | _ -> (* Fallthrough - for everything else, do nothing *) + let body' = copyConstPropFoldExp vtable body + Let (Dec (name, e', decpos), body', pos) + + | Times (_, _, _) -> + (* TODO project task 3: implement as many safe algebraic + simplifications as you can think of. You may inspire + yourself from the case of `Plus`. For example: + 1 * x = ? + x * 0 = ? + *) + failwith "Unimplemented copyConstPropFold for multiplication" + | And (e1, e2, pos) -> + (* TODO project task 3: see above. You may inspire yourself from + `Or` below, but that only scratches the surface of what's possible *) + failwith "Unimplemented copyConstPropFold for &&" + | Constant (x,pos) -> Constant (x,pos) + | StringLit (x,pos) -> StringLit (x,pos) + | ArrayLit (es, t, pos) -> + ArrayLit (List.map (copyConstPropFoldExp vtable) es, t, pos) + | Plus (e1, e2, pos) -> + let e1' = copyConstPropFoldExp vtable e1 + let e2' = copyConstPropFoldExp vtable e2 + match (e1', e2') with + | (Constant (IntVal x, _), Constant (IntVal y, _)) -> + Constant (IntVal (x + y), pos) + | (Constant (IntVal 0, _), _) -> e2' + | (_, Constant (IntVal 0, _)) -> e1' + | _ -> Plus (e1', e2', pos) + | Minus (e1, e2, pos) -> + let e1' = copyConstPropFoldExp vtable e1 + let e2' = copyConstPropFoldExp vtable e2 + match (e1', e2') with + | (Constant (IntVal x, _), Constant (IntVal y, _)) -> + Constant (IntVal (x - y), pos) + | (_, Constant (IntVal 0, _)) -> e1' + | _ -> Minus (e1', e2', pos) + | Equal (e1, e2, pos) -> + let e1' = copyConstPropFoldExp vtable e1 + let e2' = copyConstPropFoldExp vtable e2 + match (e1', e2') with + | (Constant (IntVal v1, _), Constant (IntVal v2, _)) -> + Constant (BoolVal (v1 = v2), pos) + | _ -> + if false (* e1' = e2' *) (* <- this would be unsafe! (why?) *) + then Constant (BoolVal true, pos) + else Equal (e1', e2', pos) + | Less (e1, e2, pos) -> + let e1' = copyConstPropFoldExp vtable e1 + let e2' = copyConstPropFoldExp vtable e2 + match (e1', e2') with + | (Constant (IntVal v1, _), Constant (IntVal v2, _)) -> + Constant (BoolVal (v1 < v2), pos) + | _ -> + if false (* e1' = e2' *) (* <- as above *) + then Constant (BoolVal false, pos) + else Less (e1', e2', pos) + | If (e1, e2, e3, pos) -> + let e1' = copyConstPropFoldExp vtable e1 + match e1' with + | Constant (BoolVal b, _) -> + if b + then copyConstPropFoldExp vtable e2 + else copyConstPropFoldExp vtable e3 + | _ -> + If (e1', + copyConstPropFoldExp vtable e2, + copyConstPropFoldExp vtable e3, + pos) + | Apply (fname, es, pos) -> + Apply (fname, List.map (copyConstPropFoldExp vtable) es, pos) + | Iota (e, pos) -> + Iota (copyConstPropFoldExp vtable e, pos) + | Replicate (n, e, t, pos) -> + Replicate (copyConstPropFoldExp vtable n, + copyConstPropFoldExp vtable e, + t, pos) + | Map (farg, e, t1, t2, pos) -> + Map (copyConstPropFoldFunArg vtable farg, + copyConstPropFoldExp vtable e, + t1, t2, pos) + | Filter (farg, e, t1, pos) -> + Filter (copyConstPropFoldFunArg vtable farg, + copyConstPropFoldExp vtable e, + t1, pos) + | Reduce (farg, e1, e2, t, pos) -> + Reduce (copyConstPropFoldFunArg vtable farg, + copyConstPropFoldExp vtable e1, + copyConstPropFoldExp vtable e2, + t, pos) + | Scan (farg, e1, e2, t, pos) -> + Scan (copyConstPropFoldFunArg vtable farg, + copyConstPropFoldExp vtable e1, + copyConstPropFoldExp vtable e2, + t, pos) + | Divide (e1, e2, pos) -> + let e1' = copyConstPropFoldExp vtable e1 + let e2' = copyConstPropFoldExp vtable e2 + match (e1', e2') with + | (Constant (IntVal x, _), Constant (IntVal y, _)) when y <> 0 -> + Constant (IntVal (x / y), pos) + | _ -> Divide (e1', e2', pos) + | Or (e1, e2, pos) -> + let e1' = copyConstPropFoldExp vtable e1 + let e2' = copyConstPropFoldExp vtable e2 + match (e1', e2') with + | (Constant (BoolVal a, _), Constant (BoolVal b, _)) -> + Constant (BoolVal (a || b), pos) + | _ -> Or (e1', e2', pos) + | Not (e, pos) -> + let e' = copyConstPropFoldExp vtable e + match e' with + | Constant (BoolVal a, _) -> Constant (BoolVal (not a), pos) + | _ -> Not (e', pos) + | Negate (e, pos) -> + let e' = copyConstPropFoldExp vtable e + match e' with + | Constant (IntVal x, _) -> Constant (IntVal (-x), pos) + | _ -> Negate (e', pos) + | Read (t, pos) -> Read (t, pos) + | Write (e, t, pos) -> Write (copyConstPropFoldExp vtable e, t, pos) + +and copyConstPropFoldFunArg (vtable : VarTable) + (farg : TypedFunArg) = + match farg with + | FunName fname -> FunName fname + | Lambda (rettype, paramls, body, pos) -> + (* Remove any bindings with the same names as the parameters. *) + let paramNames = (List.map (fun (Param (name, _)) -> name) paramls) + let vtable' = SymTab.removeMany paramNames vtable + Lambda (rettype, paramls, copyConstPropFoldExp vtable' body, pos) + +let copyConstPropFoldFunDec = function + | FunDec (fname, rettype, paramls, body, loc) -> + let body' = copyConstPropFoldExp (SymTab.empty ()) body + FunDec (fname, rettype, paramls, body', loc) + +let optimiseProgram (prog : TypedProg) = + List.map copyConstPropFoldFunDec prog diff --git a/fasto/Fasto/DeadBindingRemoval.fs b/fasto/Fasto/DeadBindingRemoval.fs new file mode 100644 index 0000000..4d73ec8 --- /dev/null +++ b/fasto/Fasto/DeadBindingRemoval.fs @@ -0,0 +1,239 @@ +module DeadBindingRemoval + +(* + val removeDeadBindings : Fasto.KnownTypes.Prog -> Fasto.KnownTypes.Prog +*) + +open AbSyn + +type DBRtab = SymTab.SymTab + +let isUsed (name : string) (stab : DBRtab) = + match SymTab.lookup name stab with + | None -> false + | Some _ -> true + +let recordUse (name : string) (stab : DBRtab) = + match SymTab.lookup name stab with + | None -> SymTab.bind name () stab + | Some _ -> stab + +let rec unzip3 = function + | [] -> ([], [], []) + | (x,y,z)::l -> + let (xs, ys, zs) = unzip3 l + (x::xs, y::ys, z::zs) +let anytrue = List.exists (fun x -> x) + +(* Input: the expression to be optimised (by removing inner dead bindings) + The result is a three-tuple: + - bool refers to whether the expression _may_ contain I/O + operations (directly or indirectly). We always err on the safe side; + that is, we only return false if we are certain that + a dead binding to this expression is safe to remove. + - DBRtab is the symbol table that is synthesized from processing the + subexpressions -- its keys are the names that were used in subexpressions. + - the TypedExp is the resulting (optimised) expression + The idea is that you do a bottom-up traversal of AbSyn, and you record + any (variable) names that you find in the symbol table. You find such + names when (1) the expression is a `Var` expression or (2) an `Index` + expression. + Then, whenever you reach a `Let` expression, you check whether the body + of the let has used the variable name currently defined. If not, then + the current binding is unused and can be omitted/removed, _if_ + it contains no I/O operations. For example, assume the original + program is: + `let x = (let y = 4 + 5 in 6) in x * 2` + then one can observe that `y` is unused and the binding `let y = 4 + 5` + can be removed (because `y` is not subsequently used), resulting in the + optimised program: `let x = 6 in x * 2`. + The rest of the expression constructors mainly perform the AbSyn (bottom-up) + traversal by recursively calling `removeDeadBindingsInExp` on subexpressions + and joining the results. +*) +let rec removeDeadBindingsInExp (e : TypedExp) : (bool * DBRtab * TypedExp) = + match e with + | Constant (x, pos) -> (false, SymTab.empty(), Constant (x, pos)) + | StringLit (x, pos) -> (false, SymTab.empty(), StringLit (x, pos)) + | ArrayLit (es, t, pos) -> + let (ios, uses, es') = unzip3 (List.map removeDeadBindingsInExp es) + (anytrue ios, + List.fold SymTab.combine (SymTab.empty()) uses, + ArrayLit (es', t, pos) ) + (* ToDO: Task 3: implement the cases of `Var`, `Index` and `Let` expressions below *) + | Var (name, pos) -> + (* Task 3, Hints for the `Var` case: + - 1st element of result tuple: can a variable name contain IO? + - 2nd element of result tuple: you have discovered a name, hence + you need to record it in a new symbol table. + - 3rd element of the tuple: should be the optimised expression. + *) + failwith "Unimplemented removeDeadBindingsInExp for Var" + | Plus (x, y, pos) -> + let (xios, xuses, x') = removeDeadBindingsInExp x + let (yios, yuses, y') = removeDeadBindingsInExp y + (xios || yios, + SymTab.combine xuses yuses, + Plus (x', y', pos)) + | Minus (x, y, pos) -> + let (xios, xuses, x') = removeDeadBindingsInExp x + let (yios, yuses, y') = removeDeadBindingsInExp y + (xios || yios, + SymTab.combine xuses yuses, + Minus (x', y', pos)) + | Equal (x, y, pos) -> + let (xios, xuses, x') = removeDeadBindingsInExp x + let (yios, yuses, y') = removeDeadBindingsInExp y + (xios || yios, + SymTab.combine xuses yuses, + Equal (x', y', pos)) + | Less (x, y, pos) -> + let (xios, xuses, x') = removeDeadBindingsInExp x + let (yios, yuses, y') = removeDeadBindingsInExp y + (xios || yios, + SymTab.combine xuses yuses, + Less (x', y', pos)) + | If (e1, e2, e3, pos) -> + let (ios1, uses1, e1') = removeDeadBindingsInExp e1 + let (ios2, uses2, e2') = removeDeadBindingsInExp e2 + let (ios3, uses3, e3') = removeDeadBindingsInExp e3 + (ios1 || ios2 || ios3, + SymTab.combine (SymTab.combine uses1 uses2) uses3, + If (e1', e2', e3', pos)) + | Apply (fname, args, pos) -> + let (ios, uses, args') = unzip3 (List.map removeDeadBindingsInExp args) + (* Since we don't currently analyze the body of the called function, + we don't know if it might contain I/O. Thus, we always mark + a function call as non-removable, unless it is to a + known-safe builtin function, such as "length". + (However, if we perform function inlining before removing + dead bindings, being overly cautious here will generally + not cause us to miss many optimization opportunities.) *) + (anytrue ios || fname <> "length", + List.fold SymTab.combine (SymTab.empty()) uses, + Apply (fname, args', pos)) + | Index (name, e, t, pos) -> + (* Task 3, `Index` case: is similar to the `Var` case, except that, + additionally, you also need to recursively optimize the index + expression `e` and to propagate its results (in addition + to recording the use of `name`). + *) + failwith "Unimplemented removeDeadBindingsInExp for Index" + + | Let (Dec (name, e, decpos), body, pos) -> + (* Task 3, Hints for the `Let` case: + - recursively process the `e` and `body` subexpressions + of the Let-binding + - a Let-binding contains IO if at least one of `e` + and `body` does. + - a variable is used in a Let-binding if it is used + in either `e` or `body`, except that any uses in + `body` do not count if they refer to the local + binding of `name`. For example, in + `let x = y+1 in x*z`, + `x` is _not_ considered to be used in the + Let-expression, but `y` and `z` are. Consider how + to express this with the SymTab operations. + - the optimized expression will be either just the + optimized body (if it doesn't use `name` _and_ `e` + does not contain IO), or a new Let-expression + built from the optimized subexpressions + (otherwise). Note that the returned IO-flag and + used-variable table should describe the expression + *resulting* from the optmization, not the original + Let-expression. + + *) + failwith "Unimplemented removeDeadBindingsInExp for Let" + | Iota (e, pos) -> + let (io, uses, e') = removeDeadBindingsInExp e + (io, + uses, + Iota (e', pos)) + | Map (farg, e, t1, t2, pos) -> + let (eio, euses, e') = removeDeadBindingsInExp e + let (fio, fuses, farg') = removeDeadBindingsInFunArg farg + (eio || fio, + SymTab.combine euses fuses, + Map (farg', e', t1, t2, pos)) + | Filter (farg, e, t1, pos) -> + let (eio, euses, e') = removeDeadBindingsInExp e + let (fio, fuses, farg') = removeDeadBindingsInFunArg farg + (eio || fio, + SymTab.combine euses fuses, + Filter (farg', e', t1, pos)) + | Reduce (farg, e1, e2, t, pos) -> + let (io1, uses1, e1') = removeDeadBindingsInExp e1 + let (io2, uses2, e2') = removeDeadBindingsInExp e2 + let (fio, fuses, farg') = removeDeadBindingsInFunArg farg + (io1 || io2 || fio, + SymTab.combine (SymTab.combine uses1 uses2) fuses, + Reduce(farg', e1', e2', t, pos)) + | Replicate (n, e, t, pos) -> + let (nio, nuses, n') = removeDeadBindingsInExp n + let (eio, euses, e') = removeDeadBindingsInExp e + (nio || eio, + SymTab.combine nuses euses, + Replicate (n', e', t, pos)) + | Scan (farg, e1, e2, t, pos) -> + let (io1, uses1, e1') = removeDeadBindingsInExp e1 + let (io2, uses2, e2') = removeDeadBindingsInExp e2 + let (fio, fuses, farg') = removeDeadBindingsInFunArg farg + (io1 || io2 || fio, + SymTab.combine (SymTab.combine uses1 uses2) fuses, + Scan(farg', e1', e2', t, pos)) + | Times (x, y, pos) -> + let (xios, xuses, x') = removeDeadBindingsInExp x + let (yios, yuses, y') = removeDeadBindingsInExp y + (xios || yios, + SymTab.combine xuses yuses, + Times (x', y', pos)) + | Divide (x, y, pos) -> + let (xios, xuses, x') = removeDeadBindingsInExp x + let (yios, yuses, y') = removeDeadBindingsInExp y + (xios || yios, + SymTab.combine xuses yuses, + Divide (x', y', pos)) + | And (x, y, pos) -> + let (xios, xuses, x') = removeDeadBindingsInExp x + let (yios, yuses, y') = removeDeadBindingsInExp y + (xios || yios, + SymTab.combine xuses yuses, + And (x', y', pos)) + | Or (x, y, pos) -> + let (xios, xuses, x') = removeDeadBindingsInExp x + let (yios, yuses, y') = removeDeadBindingsInExp y + (xios || yios, + SymTab.combine xuses yuses, + Or (x', y', pos)) + | Not (e, pos) -> + let (ios, uses, e') = removeDeadBindingsInExp e + (ios, uses, Not (e', pos)) + | Negate (e, pos) -> + let (ios, uses, e') = removeDeadBindingsInExp e + (ios, uses, Negate (e', pos)) + | Read (x, pos) -> + (true, SymTab.empty(), Read (x, pos)) + | Write (e, t, pos) -> + let (_, uses, e') = removeDeadBindingsInExp e + (true, uses, Write (e', t, pos)) + +and removeDeadBindingsInFunArg (farg : TypedFunArg) = + match farg with + | FunName fname -> (false, SymTab.empty(), FunName fname) + | Lambda (rettype, paramls, body, pos) -> + let (io, uses, body') = removeDeadBindingsInExp body + let uses' = List.fold (fun acc (Param (pname,_)) -> + SymTab.remove pname acc + ) uses paramls + (io, + uses', + Lambda (rettype, paramls, body', pos)) + +let removeDeadBindingsInFunDec (FunDec (fname, rettype, paramls, body, pos)) = + let (_, _, body') = removeDeadBindingsInExp body + FunDec (fname, rettype, paramls, body', pos) + +(* Entrypoint: remove dead bindings from the whole program *) +let removeDeadBindings (prog : TypedProg) = + List.map removeDeadBindingsInFunDec prog diff --git a/fasto/Fasto/DeadFunctionRemoval.fs b/fasto/Fasto/DeadFunctionRemoval.fs new file mode 100644 index 0000000..b975748 --- /dev/null +++ b/fasto/Fasto/DeadFunctionRemoval.fs @@ -0,0 +1,10 @@ +module DeadFunctionRemoval + +open AbSyn +open CallGraph + +let removeDeadFunction (prog : TypedProg) = + let graph = callGraph prog + let alive (FunDec (fname, _, _, _, _)) = + fname = "main" || calls "main" fname graph + List.filter alive prog diff --git a/fasto/Fasto/Fasto.fsproj b/fasto/Fasto/Fasto.fsproj new file mode 100644 index 0000000..c4c05c1 --- /dev/null +++ b/fasto/Fasto/Fasto.fsproj @@ -0,0 +1,38 @@ + + + + Exe + net6.0 + + + + + + + + + -v --module Parser + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/fasto/Fasto/Fasto.fsx b/fasto/Fasto/Fasto.fsx new file mode 100644 index 0000000..32a0840 --- /dev/null +++ b/fasto/Fasto/Fasto.fsx @@ -0,0 +1,252 @@ +// The Fasto compiler command-line interface. +// +// This is the main program for when this compiler is turned into an executable. +// It ties together all the compiler modules. You can build the compiler by +// running 'make' or 'dotnet build Fasto' in the top-level directory. + +open System.Text +open FSharp.Text.Lexing +open System.IO + +open AbSyn +open Inlining +open DeadFunctionRemoval +open DeadBindingRemoval +open CopyConstPropFold + + +// YOU DO NOT NEED TO UNDERSTAND THIS; IT IS A HACK: State machine for getting +// line and position numbers from a Parser error string. This is really nasty. +// The problem is that we can only define the needed 'parse_error_rich' function +// in Parser.fsp at the top of the file, which means that we have not defined +// the actual tokens yet, so we cannot pattern match on them for extracting +// their source code positions, although we *can* print them. An alternative +// solution is to inject a proper 'parse_error_rich' function in the bottom of +// the generated Parser.fs. +exception SyntaxError of int * int +let printPos (errString : string) : unit = + let rec state3 (s : string) (p : int) (lin : string) (col : int) = + (* read digits until not *) + let c = s.[p] + if System.Char.IsDigit c + then state3 s (p-1) (System.Char.ToString c + lin) col + else raise (SyntaxError (System.Int32.Parse lin, col)) + + let rec state2 (s : string) (p : int) (col : string) = + (* skip from position until digit *) + let c = s.[p] + if System.Char.IsDigit c + then state3 s (p-1) (System.Char.ToString c) (System.Int32.Parse col) + else state2 s (p-1) col + + let rec state1 (s : string) (p : int) (col : string) = + (* read digits until not *) + let c = s.[p] + if System.Char.IsDigit c + then state1 s (p-1) (System.Char.ToString c + col) + else state2 s (p-1) col + + let rec state0 (s : string) (p : int) = + (* skip from end until digit *) + let c = s.[p] + if System.Char.IsDigit c + then state1 s (p-1) (System.Char.ToString c) + else state0 s (p-1) + + state0 errString (String.length errString - 1) + +// Parse program from string. +let parseString (s : string) : AbSyn.UntypedProg = + Parser.Prog Lexer.Token + <| LexBuffer<_>.FromBytes (Encoding.UTF8.GetBytes s) + +//////////////////// +/// Usage helper /// +//////////////////// +let usage = + [ " fasto -i tests/fib.fo\n" + ; " Run 'fib.fo' in the 'tests' directory in interpreted mode.\n" + ; " and print the result.\n" + ; "\n" + ; " fasto -r tests/fib.fo\n" + ; " Run 'fib.fo' in interpreted mode, but do not print the result.\n" + ; "\n" + ; " fasto -c tests/fib.fo\n" + ; " Compile 'tests/fib.fo' into the MIPS program 'tests/fib.asm'.\n" + ; "\n" + ; " fasto -o [opts] tests/fib.fo\n" + ; " Compile the optimised 'tests/fib.fo' into 'tests/fib.asm'.\n" + ; "\n" + ; " fasto -p [opts] tests/fib.fo\n" + ; " Optimise 'tests/fib.fo' and print the result on standard output.\n" + ; " is a sequence of characters corresponding to optimisation\n" + ; " passes, where: \n" + ; " i - Inline functions.\n" + ; " c - Copy propagation and constant folding.\n" + ; " d - Remove dead bindings.\n" + ; " D - Remove dead functions.\n" + ] + + +// Print error message to the standard error channel. +let errorMessage (message : string) : Unit = + printfn "%s\n" message + +let errorMessage' (errorType : string, message : string, line : int, col : int) = + printfn "%s: %s at line %d, column %d" errorType message line col + +let bad () : Unit = + errorMessage "Unknown command-line arguments. Usage:\n" + errorMessage (usage |> List.fold (+) "") + +exception FileProblem of string + +// Remove trailing .fo from filename. +let sanitiseFilename (argFilename : string) : string = + if argFilename.EndsWith ".fo" + then argFilename.Substring(0, (String.length argFilename)-3) + else argFilename + +// Save the content of a string to file. +let saveFile (filename : string) (content : string) : Unit = + try + let outFile = File.CreateText filename + // Generate code here. + outFile.Write content + outFile.Close() + with + | ex -> + printfn "Problem writing file named: %s, error: %s,\n where content is:\n %s\n" filename ex.Message content + System.Environment.Exit 1 + + +let parseFastoFile (filename : string) : AbSyn.UntypedProg = + let txt = try // read text from file given as parameter with added extension + let inStream = File.OpenText (filename + ".fo") + let txt = inStream.ReadToEnd() + inStream.Close() + txt + with // or return empty string + | ex -> "" + if txt <> "" then // valid file content + let program = + try + parseString txt + with + | Lexer.LexicalError (info,(line,col)) -> + printfn "%s at line %d, position %d\n" info line col + System.Environment.Exit 1 + [] + | ex -> + if ex.Message = "parse error" + then printPos Parser.ErrorContextDescriptor + else printfn "%s" ex.Message + System.Environment.Exit 1 + [] + program + else failwith "Invalid file name or empty file" + +let compile (filename : string) optimiser : Unit = + let pgm = parseFastoFile filename + let pgm_decorated = TypeChecker.checkProg pgm + let pgm_optimised = optimiser pgm_decorated + let mips_code = CodeGen.compile pgm_optimised + let mips_code_text = Mips.ppMipsProg mips_code + saveFile (filename + ".asm") mips_code_text + +let interpret (filename : string) : Unit = + let pgm = parseFastoFile filename + printfn "Program is:\n\n%s" (AbSyn.ppProg pgm) + printfn "\n+-----------------------------------------+" + printfn "\n| You might need to enter some input now. |" + printfn "\n+-----------------------------------------+" + printfn "\n" + let res = Interpreter.evalProg pgm + printfn "\n\nResult of 'main': %s\n" (AbSyn.ppVal 0 res) + +let interpretSimple (filename : string) : AbSyn.Value = + let pgm = parseFastoFile filename + Interpreter.evalProg pgm + +let printOptimised (argFilename : string) optimiser : Unit = + let pgm = parseFastoFile argFilename + let pgm_decorated = TypeChecker.checkProg pgm + let pgm_optimised = optimiser pgm_decorated + printfn "%s\n" (ppProg pgm_optimised) + +let withoutOptimisations (prog : TypedProg) = prog + +let defaultOptimisations (prog : TypedProg) = + (removeDeadFunction << + removeDeadBindings << + optimiseProgram << + inlineOptimiseProgram) prog + +type opt = char + +let rec extractOpts (opts : opt list) = + match opts with + | [] -> Some (fun x -> x) + | opt::opls -> + let extractOpt (op : opt) = + match op with + | 'i' -> Some inlineOptimiseProgram + | 'c' -> Some optimiseProgram + | 'd' -> Some removeDeadBindings + | 'D' -> Some removeDeadFunction + | _ -> None + match (extractOpt opt, extractOpts opls) with + | (Some opt', Some opts') -> Some (fun x -> opts' (opt' x)) + | _ -> None + +let explode (s:string) = + [for c in s -> c] + +[] +let main (paramList: string[]) : int = + try + match paramList with + | [|"-i"; file|] -> interpret (sanitiseFilename file) + | [|"-r"; file|] -> let res = interpretSimple (sanitiseFilename file) + printfn "\n\nResult of 'main': %s\n" (AbSyn.ppVal 0 res) + | [|"-c"; file|] -> compile (sanitiseFilename file) (fun x -> x) + | [|"-o"; file|] -> compile (sanitiseFilename file) defaultOptimisations + | [|"-o"; opts; file|] -> + match extractOpts (explode opts) with + | Some (opts') -> compile (sanitiseFilename file) opts' + | None -> bad () + | [|"-P"; file|] -> + printOptimised (sanitiseFilename file) withoutOptimisations + | [|"-p"; file|] -> + printOptimised (sanitiseFilename file) defaultOptimisations + | [|"-p"; opts; file|] -> + match extractOpts (explode opts) with + | Some (opts') -> printOptimised (sanitiseFilename file) opts' + | None -> bad () + | _ -> bad () + 0 + with + | SyntaxError (line, col) -> + errorMessage' ("Parse error", "Error", line, col) + System.Environment.Exit 1 + 1 + | Lexer.LexicalError (message, (line, col)) -> + errorMessage' ("Lexical error", message, line, col) + System.Environment.Exit 1 + 1 + | Interpreter.MyError (message, (line, col)) -> + errorMessage' ("Interpreter error", message, line, col) + System.Environment.Exit 1 + 1 + | CodeGen.MyError (message, (line, col)) -> + errorMessage' ("Code generator error", message, line, col) + System.Environment.Exit 1 + 1 + | TypeChecker.MyError (message, (line, col)) -> + errorMessage' ("Type error", message, line, col) + System.Environment.Exit 1 + 1 + | FileProblem filename -> + errorMessage ("There was a problem with the file: " + filename) + System.Environment.Exit 1 + 1 diff --git a/fasto/Fasto/Inlining.fs b/fasto/Fasto/Inlining.fs new file mode 100644 index 0000000..63b3d4a --- /dev/null +++ b/fasto/Fasto/Inlining.fs @@ -0,0 +1,140 @@ +(* We will inline any function that does not call itselt. *) +module Inlining + +open AbSyn +open CallGraph + +let mutable inlining_ctr = 0 (* for generating fresh variable names *) + +let newSuffix () = + inlining_ctr <- inlining_ctr + 1 + "_I" + string inlining_ctr + +let rec inlineInExp (graph : CallGraph) + (prog : TypedProg) + (e : TypedExp) = + match e with + | Constant _ -> e + | StringLit _ -> e + | ArrayLit (es, t, pos) -> + ArrayLit (List.map (inlineInExp graph prog) es, t, pos) + | Var _ -> e + | Plus (e1, e2, pos) -> + Plus (inlineInExp graph prog e1, + inlineInExp graph prog e2, pos) + | Minus (e1, e2, pos) -> + Minus (inlineInExp graph prog e1, + inlineInExp graph prog e2, pos) + | Equal (e1, e2, pos) -> + Equal (inlineInExp graph prog e1, + inlineInExp graph prog e2, pos) + | Less (e1, e2, pos) -> + Less (inlineInExp graph prog e1, + inlineInExp graph prog e2, pos) + | If (e1, e2, e3, pos) -> + If (inlineInExp graph prog e1, + inlineInExp graph prog e2, + inlineInExp graph prog e3, + pos) + | Apply (fname, es, pos) -> + if calls fname fname graph then + (* Function is recursive - do not inline. *) + Apply (fname, List.map (inlineInExp graph prog) es, pos) + else (* OK - inline. *) + inlineFuncall fname graph prog es pos + | Let (Dec (name, e, decpos), body, pos) -> + Let (Dec (name, inlineInExp graph prog e, decpos), + inlineInExp graph prog body, + pos) + | Index (name, e, t, pos) -> + Index (name, inlineInExp graph prog e, t, pos) + | Iota (e, pos) -> + Iota (e, pos) + | Map (farg, e, t1, t2, pos) -> + Map (inlineInFunArg graph prog farg, + inlineInExp graph prog e, + t1, t2, pos) + | Filter (farg, e, t1, pos) -> + Filter (inlineInFunArg graph prog farg, + inlineInExp graph prog e, + t1, pos) + | Reduce (farg, e1, e2, t, pos) -> + Reduce (inlineInFunArg graph prog farg, + inlineInExp graph prog e1, + inlineInExp graph prog e2, + t, pos) + | Replicate (n, e, t, pos) -> + Replicate (inlineInExp graph prog n, + inlineInExp graph prog e, + t, pos) + | Scan (farg, e1, e2, t, pos) -> + Scan (inlineInFunArg graph prog farg, + inlineInExp graph prog e1, + inlineInExp graph prog e2, + t, pos) + | Times (e1, e2, pos) -> + Times (inlineInExp graph prog e1, + inlineInExp graph prog e2, + pos) + | Divide (e1, e2, pos) -> + Divide (inlineInExp graph prog e1, + inlineInExp graph prog e2, + pos) + | And (e1, e2, pos) -> + And (inlineInExp graph prog e1, + inlineInExp graph prog e2, + pos) + | Or (e1, e2, pos) -> + Or (inlineInExp graph prog e1, + inlineInExp graph prog e2, + pos) + | Not (e, pos) -> + Not (inlineInExp graph prog e, pos) + | Negate (e, pos) -> + Negate (inlineInExp graph prog e, pos) + | Read (t, pos) -> + Read (t, pos) + | Write (e, t, pos) -> + Write (inlineInExp graph prog e, t, pos) + +and inlineInFunArg (graph : CallGraph) + (prog : TypedProg) = function + | Lambda (rettype, paramls, body, pos) -> + Lambda (rettype, paramls, inlineInExp graph prog body, pos) + | FunName fname -> + match List.tryFind (fun (FunDec (x, _, _, _, _)) -> x = fname) prog with + | None -> FunName fname + | Some (FunDec (_, rettype, paramls, body, pos)) -> + inlineInFunArg graph prog (Lambda (rettype, paramls, body, pos)) + +and inlineFuncall (fname : string) + (graph : CallGraph) + (prog : TypedProg) + (args : TypedExp list) + (pos : Position) = + match List.tryFind (fun (FunDec(x, _, _, _, _)) -> x = fname) prog with + | None -> Apply (fname, List.map ( inlineInExp graph prog) args, pos) + | Some (FunDec (_, _, paramls, body, _)) -> + let parNames = List.map (fun (Param (v,t)) -> v) paramls + // let paramBindings = List.zip parNames args (* too simplistic *) + let uniq = newSuffix () (* can use same suffix for all pars *) + let parNames1 = List.map (fun v -> v + uniq) parNames + let paramBindings = + List.zip parNames1 args @ + List.zip parNames (List.map (fun v -> Var (v,pos)) parNames1) + let rec mkLetsAroundBody = function + | [] -> body + | ((paramname, arg) :: rest) -> + Let ( Dec ( paramname, arg, pos), + mkLetsAroundBody rest, + pos) + inlineInExp graph prog (mkLetsAroundBody paramBindings) + +let inlineInFunction (graph : CallGraph) + (prog : TypedProg) + (FunDec (fname, rettype, paramls, body, pos)) = + FunDec (fname, rettype, paramls, inlineInExp graph prog body, pos) + +let inlineOptimiseProgram (prog : TypedProg) = + let graph = callGraph prog + List.map (inlineInFunction graph prog) prog diff --git a/fasto/Fasto/Interpreter.fs b/fasto/Fasto/Interpreter.fs new file mode 100644 index 0000000..4d4ae4b --- /dev/null +++ b/fasto/Fasto/Interpreter.fs @@ -0,0 +1,376 @@ +(* An interpreter for Fasto. *) + +module Interpreter + +(* + +An interpreter executes a (Fasto) program by inspecting the abstract syntax +tree of the program, and doing what needs to be done in another programming +language (F#). + +As mentioned in AbSyn.fs, some Fasto expressions are implicitly typed. The +interpreter infers the missing types, and checks the types of the operands +before performing any Fasto operation. Some type errors might still occur though. + +Any valid Fasto program must contain a "main" function, which is the entry +point of the program. The return value of this function is the result of the +Fasto program. + +The main function of interest in this module is: + + val evalProg : AbSyn.UntypedProg -> AbSyn.Value + +*) + +open System +open AbSyn + +(* An exception for reporting run-time errors. *) +exception MyError of string * Position + +type FunTable = SymTab.SymTab +type VarTable = SymTab.SymTab + +(* Build a function table, which associates a function names with function + declarations. *) +let rec buildFtab (fdecs : UntypedFunDec list) : FunTable = + match fdecs with + | [] -> let p = (0, 0) + let ch = 'a' + let fdec_chr = FunDec ("chr", Char, [Param ("n", Int) ], Constant (CharVal ch, p), p) + let fdec_ord = FunDec ("ord", Int, [Param ("c", Char)], Constant (IntVal 1, p), p) + SymTab.fromList [("chr", fdec_chr); ("ord", fdec_ord)] + | ( fdcl::fs ) -> + (* Bind the user-defined functions, in reverse order. *) + let fid = getFunName fdcl + let pos = getFunPos fdcl + let ftab = buildFtab fs + match SymTab.lookup fid ftab with + | None -> SymTab.bind fid fdcl ftab + | Some ofdecl -> + (* Report the first occurrence of the name. *) + raise (MyError ("Already defined function: "+fid, getFunPos ofdecl)) + +(* Check whether a value matches a type. *) +let rec typeMatch (tpval : Type * Value) : bool = + match tpval with + | ( Int, IntVal _ ) -> true + | ( Bool, BoolVal _) -> true + | ( Char, CharVal _) -> true + | ( Array t, ArrayVal (vals, tp) ) -> + (t = tp) && (List.map (fun value -> typeMatch (t, value)) vals |> List.fold (&&) true) + | (_, _) -> false + +let reportBadType (str : string) + (want : string) + (v : Value) + (pos : Position) = + let msg = "Bad type for " + str + ": expected " + want + ", but got " + + ppType (valueType v) + " (" + (ppVal 0 v) + ")" + raise (MyError(msg, pos)) + +let reportWrongType str tp v pos = reportBadType str (ppType tp) v pos + +let reportNonArray str v pos = reportBadType str "an array" v pos + +(* Bind the formal parameters of a function declaration to actual parameters in + a new vtab. *) + +let rec bindParams (fargs : Param list) + (aargs : Value list) + (fid : String) + (pdec : Position) + (pcall : Position) : VarTable = + match (fargs, aargs) with + | ([], []) -> SymTab.empty () + | (Param (faid, fatp) :: fargs, v :: aargs) -> + let vtab = bindParams fargs aargs fid pdec pcall + if typeMatch(fatp, v) + then match SymTab.lookup faid vtab with + None -> SymTab.bind faid v vtab + | Some m -> raise (MyError( "Formal argument is already in symbol table!"+ + " In function: "+fid+" formal argument: "+faid + , pdec )) + else reportWrongType ("argument " + faid + " of function " + fid) + fatp v pcall + | (_, _) -> raise (MyError("Number of formal and actual params do not match in call to "+fid, + pcall)) + + +(* Interpreter for Fasto expressions: + 1. vtab holds bindings between variable names and + their interpreted value (Fasto.Value). + 2. ftab holds bindings between function names and + function declarations (Fasto.FunDec). + 3. Returns the interpreted value. *) +let rec evalExp (e : UntypedExp, vtab : VarTable, ftab : FunTable) : Value = + match e with + | Constant (v,_) -> v + | ArrayLit (l, t, pos) -> + let els = (List.map (fun x -> evalExp(x, vtab, ftab)) l) + let elt = match els with + | [] -> Int (* Arbitrary *) + | v::_ -> valueType v + ArrayVal (els, elt) + | StringLit(s, pos) -> + let cvs = List.map (fun c -> CharVal c) (Seq.toList s) + ArrayVal (cvs, Char) + | Var(id, pos) -> + let res = SymTab.lookup id vtab + match res with + | None -> raise (MyError("Unknown variable "+id, pos)) + | Some m -> m + | Plus(e1, e2, pos) -> + let res1 = evalExp(e1, vtab, ftab) + let res2 = evalExp(e2, vtab, ftab) + match (res1, res2) with + | (IntVal n1, IntVal n2) -> IntVal (n1+n2) + | (IntVal _, _) -> reportWrongType "right operand of +" Int res2 (expPos e2) + | (_, _) -> reportWrongType "left operand of +" Int res1 (expPos e1) + | Minus(e1, e2, pos) -> + let res1 = evalExp(e1, vtab, ftab) + let res2 = evalExp(e2, vtab, ftab) + match (res1, res2) with + | (IntVal n1, IntVal n2) -> IntVal (n1-n2) + | (IntVal _, _) -> reportWrongType "right operand of -" Int res2 (expPos e2) + | (_, _) -> reportWrongType "left operand of -" Int res1 (expPos e1) + (* TODO: project task 1: + Look in `AbSyn.fs` for the arguments of the `Times` + (`Divide`,...) expression constructors. + Implementation similar to the cases of Plus/Minus. + Try to pattern match the code above. + For `Divide`, remember to check for attempts to divide by zero. + For `And`/`Or`: make sure to implement the short-circuit semantics, + e.g., `And (e1, e2, pos)` should not evaluate `e2` if `e1` already + evaluates to false. + *) + | Times(_, _, _) -> + failwith "Unimplemented interpretation of multiplication" + | Divide(_, _, _) -> + failwith "Unimplemented interpretation of division" + | And (_, _, _) -> + failwith "Unimplemented interpretation of &&" + | Or (_, _, _) -> + failwith "Unimplemented interpretation of ||" + | Not(_, _) -> + failwith "Unimplemented interpretation of not" + | Negate(_, _) -> + failwith "Unimplemented interpretation of negate" + | Equal(e1, e2, pos) -> + let r1 = evalExp(e1, vtab, ftab) + let r2 = evalExp(e2, vtab, ftab) + match (r1, r2) with + | (IntVal n1, IntVal n2) -> BoolVal (n1 = n2) + | (BoolVal b1, BoolVal b2) -> BoolVal (b1 = b2) + | (CharVal c1, CharVal c2) -> BoolVal (c1 = c2) + | (ArrayVal _, _) -> reportBadType "left operand of =" "a base type" r1 pos + | (_, _) -> reportWrongType "right operand of =" (valueType r1) r2 pos + | Less(e1, e2, pos) -> + let r1 = evalExp(e1, vtab, ftab) + let r2 = evalExp(e2, vtab, ftab) + match (r1, r2) with + | (IntVal n1, IntVal n2 ) -> BoolVal (n1 < n2) + | (BoolVal false, BoolVal true) -> BoolVal true + | (BoolVal _, BoolVal _ ) -> BoolVal false + | (CharVal c1, CharVal c2 ) -> BoolVal ( (int c1) < (int c2) ) + | (ArrayVal _, _) -> reportBadType "left operand of <" "a base type" r1 pos + | (_, _) -> reportWrongType "right operand of <" (valueType r1) r2 pos + | If(e1, e2, e3, pos) -> + let cond = evalExp(e1, vtab, ftab) + match cond with + | BoolVal true -> evalExp(e2, vtab, ftab) + | BoolVal false -> evalExp(e3, vtab, ftab) + | other -> reportWrongType "if condition" Bool cond (expPos e1) + //raise (MyError("If condition is not a boolean", pos)) + (* The case of length receives special treatment below *) + | Apply("length", [arg], pos) -> + let evarg = evalExp(arg, vtab, ftab) + match evarg with + | ArrayVal (lst, _) -> IntVal (List.length lst) + | otherwise -> reportNonArray "argument of length" evarg pos + | Apply("length", args, pos) -> + let msg = sprintf "Call to length function expects exactly one arg, given: %i" (List.length args) + raise (MyError(msg, pos)) + (* general case of function application *) + | Apply(fid, args, pos) -> + let evargs = List.map (fun e -> evalExp(e, vtab, ftab)) args + match (SymTab.lookup fid ftab) with + | Some f -> callFunWithVtable(f, evargs, SymTab.empty(), ftab, pos) + | None -> raise (MyError("Call to unknown function "+fid, pos)) + | Let(Dec(id,e,p), exp, pos) -> + let res = evalExp(e, vtab, ftab) + let nvtab = SymTab.bind id res vtab + evalExp(exp, nvtab, ftab) + | Index(id, e, tp, pos) -> + let indv = evalExp(e, vtab, ftab) + let arr = SymTab.lookup id vtab + match (arr, indv) with + | (None, _) -> raise (MyError("Unknown array variable "+id, pos)) + | (Some (ArrayVal(lst, tp)), IntVal ind) -> + let len = List.length(lst) + if( len > ind && ind >= 0 ) + then lst.Item(ind) + else let msg = sprintf "Array index out of bounds! Array length: %i, index: %i" len ind + raise (MyError( msg, pos )) + | (Some m, IntVal _) -> reportNonArray ("indexing into " + id) m pos + | (_, _) -> reportWrongType "indexing expression" Int indv pos + | Iota (e, pos) -> + let sz = evalExp(e, vtab, ftab) + match sz with + | IntVal size -> + if size >= 0 + then ArrayVal( List.map (fun x -> IntVal x) [0..size-1], Int ) + else let msg = sprintf "Argument of \"iota\" is negative: %i" size + raise (MyError(msg, pos)) + | _ -> reportWrongType "argument of \"iota\"" Int sz pos + | Map (farg, arrexp, _, _, pos) -> + let arr = evalExp(arrexp, vtab, ftab) + let farg_ret_type = rtpFunArg farg ftab pos + match arr with + | ArrayVal (lst,tp1) -> + let mlst = List.map (fun x -> evalFunArg (farg, vtab, ftab, pos, [x])) lst + ArrayVal (mlst, farg_ret_type) + | otherwise -> reportNonArray "2nd argument of \"map\"" arr pos + | Reduce (farg, ne, arrexp, tp, pos) -> + let farg_ret_type = rtpFunArg farg ftab pos + let arr = evalExp(arrexp, vtab, ftab) + let nel = evalExp(ne, vtab, ftab) + match arr with + | ArrayVal (lst,tp1) -> + List.fold (fun acc x -> evalFunArg (farg, vtab, ftab, pos, [acc;x])) nel lst + | otherwise -> reportNonArray "3rd argument of \"reduce\"" arr pos + (* TODO project task 2: `replicate(n, a)` + Look in `AbSyn.fs` for the arguments of the `Replicate` + (`Map`,`Scan`) expression constructors. + - evaluate `n` then evaluate `a`, + - check that `n` evaluates to an integer value >= 0 + - If so then create an array containing `n` replicas of + the value of `a`; otherwise raise an error (containing + a meaningful message). + *) + | Replicate (_, _, _, _) -> + failwith "Unimplemented interpretation of replicate" + + (* TODO project task 2: `filter(p, arr)` + pattern match the implementation of map: + - check that the function `p` result type (use `rtpFunArg`) is bool; + - evaluate `arr` and check that the (value) result corresponds to an array; + - use F# `List.filter` to keep only the elements `a` of `arr` which succeed + under predicate `p`, i.e., `p(a) = true`; + - create an `ArrayVal` from the (list) result of the previous step. + *) + | Filter (_, _, _, _) -> + failwith "Unimplemented interpretation of filter" + + (* TODO project task 2: `scan(f, ne, arr)` + Implementation similar to reduce, except that it produces an array + of the same type and length to the input array `arr`. + *) + | Scan (_, _, _, _, _) -> + failwith "Unimplemented interpretation of scan" + + | Read (t,p) -> + let str = Console.ReadLine() + match t with + | Int -> let v : int = int str + IntVal v + | Bool when str = "true" -> BoolVal true + | Bool when str = "false" -> BoolVal false + | Char -> let v : char = char str + CharVal v + | otherwise -> raise (MyError("Read operation is valid only on basic types ", p)) + + | Write(exp,t,p) -> + let v = evalExp(exp, vtab, ftab) + match v with + | IntVal n -> printfn "%i " n + | BoolVal b -> let res = if(b) then "true " else "false " + printfn "%s" res + | CharVal c -> printfn "%c " c + | ArrayVal (a, Char) -> + let mapfun = function + | CharVal c -> c + | otherwise -> raise (MyError("Write argument " + + ppVal 0 v + + " should have been evaluated to string", p)) + printfn "%s" ( System.String.Concat (List.map mapfun a) ) + | otherwise -> raise (MyError("Write can be called only on basic and array(char) types ", p)) + v + + + +(* finds the return type of a function argument *) +and rtpFunArg (funarg : UntypedFunArg) + (ftab : FunTable) + (callpos : Position) + : Type = + match funarg with + | FunName fid -> + match SymTab.lookup fid ftab with + | None -> raise (MyError("Call to unknown function "+fid, callpos)) + | Some (FunDec (_, rettype, _, _, _)) -> rettype + | Lambda (rettype, _, _, _) -> rettype + +(* evalFunArg takes as argument a FunArg, a vtable, an ftable, the +position where the call is performed, and the list of actual arguments. +It returns the result of calling the (lambda) function. + *) +and evalFunArg ( funarg : UntypedFunArg + , vtab : VarTable + , ftab : FunTable + , callpos : Position + , aargs : Value list + ) : Value = + match funarg with + | (FunName fid) -> + let fexp = SymTab.lookup fid ftab + match fexp with + | None -> raise (MyError("Call to known function "+fid, callpos)) + | Some f -> callFunWithVtable(f, aargs, SymTab.empty(), ftab, callpos) + | Lambda (rettype, parms, body, fpos) -> + callFunWithVtable ( FunDec ("", rettype, parms, body, fpos) + , aargs, vtab, ftab, callpos ) + +(* Interpreter for Fasto function calls: + 1. f is the function declaration. + 2. args is a list of (already interpreted) arguments. + 3. vtab is the variable symbol table + 4. ftab is the function symbol table (containing f itself). + 5. pcall is the position of the function call. *) +and callFunWithVtable (fundec : UntypedFunDec + , aargs : Value list + , vtab : VarTable + , ftab : FunTable + , pcall : Position + ) : Value = + let (FunDec (fid, rtp, fargs, body, pdcl)) = fundec + match fid with + (* treat the special functions *) + | "ord" -> match aargs with + | [CharVal c] -> IntVal (int c) + | [v] -> reportWrongType "argument of \"ord\"" Char v pcall + | _ -> raise (MyError ("Wrong argument count for \"ord\"", pcall)) + | "chr" -> match aargs with + | [IntVal n] -> CharVal (char n) + | [v] -> reportWrongType "argument of \"chr\"" Int v pcall + | _ -> raise (MyError ("Wrong argument count for \"chr\"", pcall)) + | _ -> + let vtab' = SymTab.combine (bindParams fargs aargs fid pdcl pcall) vtab + let res = evalExp (body, vtab', ftab) + if typeMatch (rtp, res) + then res + else reportWrongType ("result of function \"" + fid + "\"") rtp res pcall + +(* Interpreter for Fasto programs: + 1. builds the function symbol table, + 2. interprets the body of "main", and + 3. returns its result. *) +and evalProg (prog : UntypedProg) : Value = + let ftab = buildFtab prog + let mainf = SymTab.lookup "main" ftab + match mainf with + | None -> raise (MyError("Could not find the main function", (0,0))) + | Some m -> + match getFunArgs m with + | [] -> callFunWithVtable(m, [], SymTab.empty(), ftab, (0,0)) + | _ -> raise (MyError("The main function is not allowed to have parameters", getFunPos m)) diff --git a/fasto/Fasto/Lexer.fsl b/fasto/Fasto/Lexer.fsl new file mode 100644 index 0000000..0d1ff9b --- /dev/null +++ b/fasto/Fasto/Lexer.fsl @@ -0,0 +1,118 @@ +//////////////////////////////////////////////////////////////////// +// TODO: project task 1 +// implement lexer tokens for the new operators: +// multiplication (*), division (/), numerical negation (~), +// logical negation (not), logical and (&&), logical or (||), +// boolean literals (true, false), semicolon (;) +// +// +// TODO: project task 2 +// implement lexer tokens (keywords) for replicate, filter, scan +// +// +// TODO: project task 4 +// implement the lexer tokens (keywords) for array comprehension +//////////////////////////////////////////////////////////////////// + + +{ +module Lexer + +open System;; +open FSharp.Text.Lexing;; +open System.Text;; + +(* A lexer definition for Fasto, for use with fslex. *) + +(* boilerplate code for all lexer files... *) +let mutable currentLine = 1 +let mutable lineStartPos = [0] + +let rec getLineCol pos line = function + | (p1::ps) -> + if pos>=p1 + then (line, pos-p1) + else getLineCol pos (line-1) ps + | [] -> (0,0) (* should not happen *) + +let getPos (lexbuf : LexBuffer<'char>) = + getLineCol lexbuf.StartPos.pos_cnum + (currentLine) + (lineStartPos) + +exception LexicalError of string * (int * int) (* (message, (line, column)) *) + +let lexerError lexbuf s = + raise (LexicalError (s, getPos lexbuf)) + +(* This one is language specific, yet very common. Alternative would + be to encode every keyword as a regexp. This one is much easier. + Note that here we recognize specific keywords, and if none matches + then we assume we have found a user-defined identifier (last case). +*) +let keyword (s, pos) = + match s with + | "if" -> Parser.IF pos + | "then" -> Parser.THEN pos + | "else" -> Parser.ELSE pos + | "let" -> Parser.LET pos + | "in" -> Parser.IN pos + | "int" -> Parser.INT pos + | "bool" -> Parser.BOOL pos + | "char" -> Parser.CHAR pos + | "fun" -> Parser.FUN pos + | "fn" -> Parser.FN pos + | "op" -> Parser.OP pos + +(* specials: *) + | "iota" -> Parser.IOTA pos + | "map" -> Parser.MAP pos + | "reduce" -> Parser.REDUCE pos + | "read" -> Parser.READ pos + | "write" -> Parser.WRITE pos + | _ -> Parser.ID (s, pos) + +} + +rule Token = parse + [' ' '\t' '\r']+ { Token lexbuf } (* whitespace *) + | ['\n' '\012'] { currentLine <- currentLine + 1; + lineStartPos <- lexbuf.StartPos.pos_cnum + :: lineStartPos; + Token lexbuf } (* newlines *) + | "//" [^ '\n' '\012']* { Token lexbuf } (* comment *) + + | '0' | ['1'-'9']['0'-'9']* { Parser.NUM + ( int (Encoding.UTF8.GetString(lexbuf.Lexeme)) + , getPos lexbuf ) + } + | ['a'-'z' 'A'-'Z']['a'-'z' 'A'-'Z' '0'-'9' '_']* + { keyword ( Encoding.UTF8.GetString(lexbuf.Lexeme) + , getPos lexbuf ) } + | '\'' ( [' ' '!' '#'-'&' '('-'[' ']'-'~'] | '\\' ['n' 't' '\'' '"' '\\'] ) '\'' + { let str0 = Encoding.UTF8.GetString(lexbuf.Lexeme) + let str1 = str0.Substring (1, (String.length str0) - 2) + let str2 = AbSyn.fromCString str1 + Parser.CHARLIT (str2.Chars(0), getPos lexbuf) + } + | '"' ( [' ' '!' '#'-'&' '('-'[' ']'-'~'] | '\\' ['n' 't' '\'' '"' '\\'] )* '"' + { + let str0 = Encoding.UTF8.GetString(lexbuf.Lexeme) + let str1 = str0.Substring (1, (String.length str0) - 2) + Parser.STRINGLIT (AbSyn.fromCString str1, getPos lexbuf) + } + | '+' { Parser.PLUS (getPos lexbuf) } + | '-' { Parser.MINUS (getPos lexbuf) } + | "=>" { Parser.ARROW (getPos lexbuf) } + | "==" { Parser.DEQ (getPos lexbuf) } + | '=' { Parser.EQ (getPos lexbuf) } + | '<' { Parser.LTH (getPos lexbuf) } + | '(' { Parser.LPAR (getPos lexbuf) } + | ')' { Parser.RPAR (getPos lexbuf) } + | '[' { Parser.LBRACKET (getPos lexbuf) } + | ']' { Parser.RBRACKET (getPos lexbuf) } + | '{' { Parser.LCURLY (getPos lexbuf) } + | '}' { Parser.RCURLY (getPos lexbuf) } + | ',' { Parser.COMMA (getPos lexbuf) } + | eof { Parser.EOF (getPos lexbuf) } + | _ { lexerError lexbuf "Illegal symbol in input" } diff --git a/fasto/Fasto/Mips.fs b/fasto/Fasto/Mips.fs new file mode 100644 index 0000000..79e2a85 --- /dev/null +++ b/fasto/Fasto/Mips.fs @@ -0,0 +1,127 @@ +(* Types and utilities for the abstract syntax of MIPS. *) + +module Mips + +open AbSyn + +type reg = RN of int | RS of string +type imm = int +type addr = string + +type Instruction = + LABEL of addr (* Angiver en label, man fx kan hoppe til *) + | COMMENT of string (* Placerer en kommentar i assemblerkoden *) + + | LA of reg*addr (* LA($rd,addr): $rd = addr (label) *) + | LUI of reg*imm (* LUI($rd,imm): $rd = (imm << 16) *) + | LW of reg*reg*imm (* LW($rd,$rs,imm): $rd = Mem[$rs + imm] *) + | LB of reg*reg*imm (* LB($rd,$rs,imm): $rd = Mem[$rs + imm] *) + | SW of reg*reg*imm (* SW($rw,$rm,imm): Mem[$rm + imm] = $rw *) + | SB of reg*reg*imm (* SB($rb,$rm,imm): Mem[$rm + imm] = $rb *) + + (* Aritmetiske instruktioner *) + | ADD of reg*reg*reg (* ADD($rd,$rs,$rt): $rd = $rs + $rt. *) + | ADDI of reg*reg*imm (* ADDI($rd,$rs,imm): $rd = $rs + imm *) + | SUB of reg*reg*reg (* SUB($rd,$rs,$rt): $rd = $rs - $rt. *) + | MUL of reg*reg*reg (* MUL($rd,$rs,$rt): $rd = $rs * $rt, no overflow. *) + | DIV of reg*reg*reg (* DIV($rd,$rs,$rt): $rd = quotient($rd / $rs), no overflow. *) + + (* Bitvise operatorer *) + | AND of reg*reg*reg (* AND($rd,$rs,$rt): $rd = $rs & $rt *) + | ANDI of reg*reg*imm (* ANDI($rd,$rs,imm): $rd = $rs & imm *) + | OR of reg*reg*reg (* OR($rd,$rs,$rt): $rd = $rs | $rt *) + | ORI of reg*reg*imm (* ORI($rd,$rs,imm): $rd = $rs | imm *) + | XOR of reg*reg*reg (* XOR($rd,$rs,$rt): $rd = $rs ^ $rt *) + | XORI of reg*reg*imm (* XORI($rd,$rs,imm): $rd = $rs ^ imm *) + + (* Bit-shifting *) + | SLL of reg*reg*imm (* SLL($rd,$rs,imm): $rd = $rs << imm *) + | SRA of reg*reg*imm (* SRA($rd,$rs,imm): $rd = $rs >> imm *) + + (* Instruktioner til sammenligning *) + | SLT of reg*reg*reg (* SLT($rd,$rs,$rt): $rd = $rs < $rt *) + | SLTI of reg*reg*imm (* SLTI($rd,$rs,imm): $rd = $rs < imm *) + | BEQ of reg*reg*addr (* BEQ($rs,$rt,addr): if ($rs == $rd) goto(addr) *) + | BNE of reg*reg*addr (* BNE($rs,$rt,addr): if ($rs != $rd) goto(addr) *) + | BGEZ of reg*addr (* BGEZ($rs,addr): if ($rs >= $0) goto(addr) *) + | J of addr (* J(addr): goto(addr) *) + | JR of reg * reg list (* JR($rd,regs): goto($rd) *) + | JAL of addr* reg list (* JAL(addr,regs): $RA = $PC; goto(addr) *) + | NOP + | SYSCALL (* Udfører det systemkald som er nævnt i $2 *) + + (* Angiver direktiverne .globl, .text, .data, .space, ascii, .asciiz, .align *) + | GLOBL of addr + | TEXT of addr + | DATA of addr + | SPACE of int + | ASCII of string + | ASCIIZ of string + | ALIGN of int + +(* Diverse pseudo-instruktioner *) +let MOVE (rd,rs) = ORI (rd, rs, 0) (* MOVE($rd,$rs): $rd = $rs *) +let LI (rd,imm) = ORI (rd, RN 0, imm) (* LI($rd,imm): $rd = imm *) +let SUBI (rd, rs, imm) = ADDI (rd, rs, -imm) + +type Prog = Instruction list + +(* Pretty-print a list of MIPS instructions in the + format accepted by the MARS MIPS simulator. *) +let rec ppMipsProg instructions = + String.concat "\n" (List.map ppMips instructions) + +(* Pretty-print a single MIPS instruction for .asm output *) +and ppMips inst = + match inst with + | LABEL l -> l + ":" + | COMMENT s -> "# " + s + + | LA (rt,l) -> "\tla\t" + ppReg rt + ", " + l + | LUI (rt,v) -> "\tlui\t" + ppReg rt + ", " + imm2str v + | LW (rd,rs,v) -> "\tlw\t" + ppReg rd + ", " + imm2str v + "(" + ppReg rs + ")" + | LB (rd,rs,v) -> "\tlb\t" + ppReg rd + ", " + imm2str v + "(" + ppReg rs + ")" + | SW (rd,rs,v) -> "\tsw\t" + ppReg rd + ", " + imm2str v + "(" + ppReg rs + ")" + | SB (rd,rs,v) -> "\tsb\t" + ppReg rd + ", " + imm2str v + "(" + ppReg rs + ")" + + | ADD (rd,rs,rt) -> "\tadd\t" + ppReg rd + ", " + ppReg rs + ", " + ppReg rt + | ADDI (rd,rs,v) -> "\taddi\t" + ppReg rd + ", " + ppReg rs + ", " + imm2str v + | SUB (rd,rs,rt) -> "\tsub\t" + ppReg rd + ", " + ppReg rs + ", " + ppReg rt + | MUL (rd,rs,rt) -> "\tmul\t" + ppReg rd + ", " + ppReg rs + ", " + ppReg rt + | DIV (rd,rs,rt) -> "\tdiv\t" + ppReg rd + ", " + ppReg rs + ", " + ppReg rt + + | AND (rd,rs,rt) -> "\tand\t" + ppReg rd + ", " + ppReg rs + ", " + ppReg rt + | ANDI (rd,rs,v) -> "\tandi\t" + ppReg rd + ", " + ppReg rs + ", " + imm2str v + | OR (rd,rs,rt) -> "\tor\t" + ppReg rd + ", " + ppReg rs + ", " + ppReg rt + | ORI (rd,rs,v) -> "\tori\t" + ppReg rd + ", " + ppReg rs + ", " + imm2str v + | XOR (rd,rs,rt) -> "\txor\t" + ppReg rd + ", " + ppReg rs + ", " + ppReg rt + | XORI (rd,rs,v) -> "\txori\t" + ppReg rd + ", " + ppReg rs + ", " + imm2str v + + | SLL (rd,rt,v) -> "\tsll\t" + ppReg rd + ", " + ppReg rt + ", " + imm2str v + | SRA (rd,rt,v) -> "\tsra\t" + ppReg rd + ", " + ppReg rt + ", " + imm2str v + + | SLT (rd,rs,rt) -> "\tslt\t" + ppReg rd + ", " + ppReg rs + ", " + ppReg rt + | SLTI (rd,rs,v) -> "\tslti\t" + ppReg rd + ", " + ppReg rs + ", " + imm2str v + | BEQ (rs,rt,l) -> "\tbeq\t" + ppReg rs + ", " + ppReg rt + ", " + l + | BNE (rs,rt,l) -> "\tbne\t" + ppReg rs + ", " + ppReg rt + ", " + l + | BGEZ (rs,l) -> "\tbgez\t" + ppReg rs + ", " + l + | J l -> "\tj\t" + l + | JAL (l,argRegs) -> "\tjal\t" + l + | JR (r,resRegs) -> "\tjr\t" + ppReg r + | NOP -> "\tnop" + | SYSCALL -> "\tsyscall" + + | GLOBL s -> "\t.globl\t" + s + | TEXT s -> "\t.text\t" + s + | DATA s -> "\t.data\t" + s + | SPACE s -> "\t.space\t" + string s + | ASCII s -> "\t.ascii\t\"" + toCString s + "\"" + | ASCIIZ s -> "\t.asciiz\t\"" + toCString s + "\"" + | ALIGN s -> "\t.align\t" + string s + +and ppReg r = + match r with + | RN n -> "$" + string n + | RS s -> s + +and imm2str (i:imm) = string i (* maybe add some sanity checks here *) diff --git a/fasto/Fasto/Parser.fsp b/fasto/Fasto/Parser.fsp new file mode 100644 index 0000000..a0bad45 --- /dev/null +++ b/fasto/Fasto/Parser.fsp @@ -0,0 +1,149 @@ + +%{ + +let p0 = (0,0) + +open FSharp.Text.Parsing +open AbSyn + +(* parse-error function *) +let mutable ErrorContextDescriptor : string = "" + +let parse_error_rich = + Some (fun (ctxt: ParseErrorContext<_>) -> + ErrorContextDescriptor <- + match ctxt.CurrentToken with + | None -> "At beginning of input\n" + | Some token -> sprintf "at token %A\n" token + ) + +%} + +////////////////////////////////////////////////////////////////////// +// TODO: Add new (lexer) token definitions: +// +// TODO: project task 1 : +// - multiplication (*), division (/), numerical negation (~), +// logical negation (not), logical and (&&), logical or (||), +// boolean literals (true, false) +// - add the required precedence and associativity rules for +// *, /, ~, not, &&, || +// - generalize the syntax of let-expressions to allow +// multiple variable declarations +// +// TODO: project task 2: replicate, filter, scan +// +// TODO: project task 4: array comprehension +////////////////////////////////////////////////////////////////////// + +%token NUM +%token CHARLIT +%token ID STRINGLIT +%token IF THEN ELSE LET IN EOF +%token INT CHAR BOOL +%token PLUS MINUS LESS +%token DEQ LTH EQ OP MAP REDUCE IOTA ARROW +%token FUN FN COMMA SEMICOLON READ WRITE +%token LPAR RPAR LBRACKET RBRACKET LCURLY RCURLY + +%nonassoc ifprec letprec +%left DEQ LTH +%left PLUS MINUS + +%start Prog +%type Prog +%type FunDecs +%type Fun +%type Type +%type Exp +%type Exps +%type FunArg +// TODO: Task 1(b): add any new nonterminals here + +%% + +Prog : FunDecs EOF { $1 } +; + +FunDecs : FUN Fun FunDecs { $2 :: $3 } + | FUN Fun { $2 :: [] } +; + +Fun : Type ID LPAR Params RPAR EQ Exp + { FunDec (fst $2, $1, $4, $7, snd $2) } + | Type ID LPAR RPAR EQ Exp + { FunDec (fst $2, $1, [], $6, snd $2) } +; + +Type : INT { AbSyn.Int } + | CHAR { AbSyn.Char } + | BOOL { AbSyn.Bool } + | LBRACKET Type RBRACKET { AbSyn.Array $2 } +; + +Params : Type ID COMMA Params + { Param (fst $2, $1) :: $4 } + | Type ID { Param (fst $2, $1) :: [] } +; + + +BinOp : PLUS { (Lambda + (Int, [Param ("x", Int); + Param ("y", Int)], + Plus (Var ("x", $1), + Var ("y", $1), + $1) ,$1))} +; + +/////////////////////////////////////////////////////// +// TODO: project tasks 1,2,4: +// add grammer rules for the new expressions +/////////////////////////////////////////////////////// + +Exp : NUM { Constant (IntVal (fst $1), snd $1) } + | CHARLIT { Constant (CharVal (fst $1), snd $1) } + | ID { Var $1 } + | STRINGLIT { StringLit $1 } + | LCURLY Exps RCURLY + { ArrayLit ($2, (), $1) } + | Exp PLUS Exp { Plus ($1, $3, $2) } + | Exp MINUS Exp { Minus($1, $3, $2) } + | Exp DEQ Exp { Equal($1, $3, $2) } + | Exp LTH Exp { Less ($1, $3, $2) } + | IF Exp THEN Exp ELSE Exp %prec ifprec + { If ($2, $4, $6, $1) } + | ID LPAR Exps RPAR + { Apply (fst $1, $3, snd $1) } + | ID LPAR RPAR { Apply (fst $1, [], snd $1) } + | READ LPAR Type RPAR + { Read ($3, $1) } + | WRITE LPAR Exp RPAR + { Write ($3, (), $1) } + | IOTA LPAR Exp RPAR + { Iota ($3, $1) } + | MAP LPAR FunArg COMMA Exp RPAR + { Map ($3, $5, (), (), $1) } + | REDUCE LPAR FunArg COMMA Exp COMMA Exp RPAR + { Reduce ($3, $5, $7, (), $1) } + | REDUCE LPAR OP BinOp COMMA Exp COMMA Exp RPAR + { Reduce ($4, $6, $8, (), $1) } + | LPAR Exp RPAR { $2 } + // TODO: task 1(b): replace this with a more general production + | LET ID EQ Exp IN Exp %prec letprec + { Let (Dec (fst $2, $4, $3), $6, $1) } + | ID LBRACKET Exp RBRACKET + { Index (fst $1, $3, (), $2) } +; + +Exps : Exp COMMA Exps { $1 :: $3 } + | Exp { $1 :: [] } +; + +FunArg : ID { FunName (fst $1 ) } + | FN Type LPAR RPAR ARROW Exp + { Lambda ($2, [], $6, $1) } + | FN Type LPAR Params RPAR ARROW Exp + { Lambda ($2, $4, $7, $1) } +; + +%% diff --git a/fasto/Fasto/RegAlloc.fs b/fasto/Fasto/RegAlloc.fs new file mode 100644 index 0000000..df2eb43 --- /dev/null +++ b/fasto/Fasto/RegAlloc.fs @@ -0,0 +1,493 @@ +(* A register allocator for MIPS. *) + +module RegAlloc + +(* registerAlloc takes a list of MIPS instructions, a set of + registers that are live at the end of the code, three register + numbers: + 1) The lowest allocatable register (typically 2). + 2) The highest caller-saves register. + 3) The highest allocatable register (typically 25). + and the number of already spilled variables. This should be 0 in the initial + call unless some variables are forced to spill before register allocation. + Registers up to (and including) the highest caller-saves + register are assumed to be caller-saves. Those above are assumed to + be callee-saves. + + registerAlloc returns: + a modified instruction list where null moves have been removed, + a set of the variables that are live at entry, + plus a number indicating the highest used register number. + + The latter can be used for deciding which callee-saves registers + need to be saved. + + Limitations: + + - Works for a single procedure body only. + + - Assumes all JALs eventually return to the next instruction and + preserve callee-saves registers when doing so. + + - Does caller-saves preservation only by allocating variables that + are live across procedure calls to callee-saves registers and + variables not live across call preferably to caller-saves. + + - Can only remove null moves if they are implemented by ORI (rx,ry,"0"). + Use the pseudo-instruction MOVE (rx,ry) for this. + +*) + +open Mips + +exception MyError of string + +exception Not_colourable of string + +let spilledVars : Set ref = ref (Set.empty) + +let rec destRegs (lst : Instruction list) : Set = + match lst with + | [] -> Set.empty + | (i::ilist) -> Set.union (destReg i) (destRegs ilist) + + +(* variables and registers that can be overwritten *) +and destReg (i : Instruction) : Set = + match i with + | LA (rt,v) -> Set.singleton rt + | LUI (rt,v) -> Set.singleton rt + | ADD (rd,rs,rt) -> Set.singleton rd + | ADDI (rd,rs,v) -> Set.singleton rd + | SUB (rd,rs,rt) -> Set.singleton rd + | MUL (rd,rs,rt) -> Set.singleton rd + | DIV (rd,rs,rt) -> Set.singleton rd + | AND (rd,rs,rt) -> Set.singleton rd + | ANDI (rd,rs,v) -> Set.singleton rd + | OR (rd,rs,rt) -> Set.singleton rd + | ORI (rd,rs,v) -> Set.singleton rd + | XOR (rd,rs,rt) -> Set.singleton rd + | XORI (rd,rs,v) -> Set.singleton rd + | SLL (rd,rt,v) -> Set.singleton rd + | SRA (rd,rt,v) -> Set.singleton rd + | SLT (rd,rs,rt) -> Set.singleton rd + | SLTI (rd,rs,v) -> Set.singleton rd + | JAL (lab,argRegs) -> Set.add (RN 31) (Set.ofList argRegs) + | LW (rd,rs,v) -> Set.singleton rd + | LB (rd,rs,v) -> Set.singleton rd + | SYSCALL -> Set.singleton (RN 2) (* return value is in $2 *) + | _ -> Set.empty + +(* variables and register that can be read by i *) +let usedRegs (i : Instruction) : Set = + match i with + | ADD (rd,rs,rt) -> Set.ofList [rs;rt] + | ADDI (rd,rs,v) -> Set.singleton rs + | SUB (rd,rs,rt) -> Set.ofList [rs;rt] + | MUL (rd,rs,rt) -> Set.ofList [rs;rt] + | DIV (rd,rs,rt) -> Set.ofList [rs;rt] + | AND (rd,rs,rt) -> Set.ofList [rs;rt] + | ANDI (rd,rs,v) -> Set.singleton rs + | OR (rd,rs,rt) -> Set.ofList [rs;rt] + | ORI (rd,rs,v) -> Set.singleton rs + | XOR (rd,rs,rt) -> Set.ofList [rs;rt] + | XORI (rd,rs,v) -> Set.singleton rs + | SLL (rd,rt,v) -> Set.singleton rt + | SRA (rd,rt,v) -> Set.singleton rt + | SLT (rd,rs,rt) -> Set.ofList [rs;rt] + | SLTI (rd,rs,v) -> Set.singleton rs + | BEQ (rs,rt,v) -> Set.ofList [rs;rt] + | BNE (rs,rt,v) -> Set.ofList [rs;rt] + | BGEZ (rs,v) -> Set.singleton rs + | J lab -> Set.empty + | JAL (lab,argRegs) -> Set.ofList argRegs + (* argRegs are argument registers *) + | JR (r,resRegs) -> Set.ofList (r::resRegs) + (* r is jump register, + resRegs are registers required to be live *) + | LW (rd,rs,v) -> Set.singleton rs + | SW (rd,rs,v) -> Set.ofList [rs;rd] + | LB (rd,rs,v) -> Set.singleton rs + | SB (rd,rs,v) -> Set.ofList [rs;rd] + | SYSCALL -> Set.ofList [RN 2; RN 4; RN 5] + (* $2 is control register and $4, $5 are arguments *) + | _ -> Set.empty + + +let live_step ilist llist liveAtEnd = + let rec scan (is : Instruction list) = + match is with + | [] -> [] + | (i::is) -> + let ls1 = scan is + if List.isEmpty ls1 + then [instruct i liveAtEnd] + else (instruct i (List.head ls1)) :: ls1 + + (* live variables and registers *) + and instruct (i : Instruction) (live : Set) : Set = + match i with + | BEQ (rs,rt,v) -> Set.union (Set.ofList [rs;rt]) (Set.union live (live_at v)) + | BNE (rs,rt,v) -> Set.union (Set.ofList [rs;rt]) (Set.union live (live_at v)) + | BGEZ (rs,v) -> Set.union (Set.singleton rs) (Set.union live (live_at v)) + | J lab -> live_at lab + | JR (r,resRegs) -> Set.ofList (r::resRegs) + (* r is jump register, resRegs are registers required to be live *) + | _ -> Set.union (usedRegs i) (Set.difference live (destReg i)) + + and live_at lab : Set = search ilist llist lab + + and search a1 a2 a3 : Set = + match (a1, a2, a3) with + | ([], [], lab) -> Set.empty + | (LABEL k :: is, l::ls, lab) -> + if k = lab then l else search is ls lab + | (_::is, _::ls, lab) -> search is ls lab + | (a, b, l) -> raise (MyError "should not happen in RegAlloc.live_step.search!") + + let res = scan ilist + res + +let rec iterate_live ilist llist liveAtEnd = + let llist1 = live_step ilist llist liveAtEnd + if llist1 = llist + then llist + else iterate_live ilist llist1 liveAtEnd + +let rec init_list = function + | [] -> [] + | (i::is) -> Set.empty :: init_list is + +(* live_regs finds for each instruction those symbolic register names *) +(* that are live at entry to this instruction *) + +let live_regs ilist liveAtEnd = + iterate_live ilist (init_list ilist) liveAtEnd + +let rec regs lst (rs : Set) : Set = + match lst with + | [] -> rs + | (l :: llist) -> Set.union l (regs llist rs) + +let numerical r = + match r with + | RN _ -> true + | RS _ -> false + +let filterSymbolic rs = Set.filter (fun a -> not (numerical a)) rs + +let rec findRegs llist = filterSymbolic (regs llist Set.empty) + +(* conflicts ilist llist callerSaves r *) +(* finds those variables that interferere with r *) +(* in instructions ilist with live-out specified by llist *) +(* callerSaves are the caller-saves registers *) + +let rec conflicts = function + | ([], [], callerSaves, RN r) -> Set.remove (RN r) callerSaves + (* all numerical interfere with all other caller-saves *) + | ([], [], callerSaves, RS _) -> Set.empty + | (ORI (rd,rs,0) :: ilist, l :: llist, callerSaves, r) -> + if r=rd (* if destination *) + then Set.union (Set.remove rs (Set.remove r l)) (* interfere with live except rs *) + (conflicts (ilist, llist, callerSaves, r)) + else if r=rs (* if source, no interference *) + then conflicts (ilist, llist, callerSaves, r) + else if Set.contains r l (* otherwise, live interfere with rd *) + then Set.add rd (conflicts (ilist, llist, callerSaves, r)) + else conflicts (ilist, llist, callerSaves, r) + | (JAL (f,argRegs) :: ilist, l :: llist, callerSaves, r) -> + if (Set.contains r l) (* live vars interfere with caller-saves regs *) + then Set.union (Set.remove r callerSaves) + (conflicts (ilist, llist, callerSaves, r)) + else if Set.contains r callerSaves + then Set.union (Set.remove r l) + (conflicts (ilist, llist, callerSaves, r)) + else conflicts (ilist, llist, callerSaves, r) + | (i :: ilist, l :: llist, callerSaves, r) -> + if (Set.contains r (destReg i)) (* destination register *) + then Set.union (Set.remove r l) (* conflicts with other live vars *) + (conflicts (ilist, llist, callerSaves, r)) + else if Set.contains r l (* all live vars *) + then Set.union (destReg i) (* conflict with destination *) + (conflicts (ilist, llist, callerSaves, r)) + else conflicts (ilist, llist, callerSaves, r) + | _ -> raise (MyError "conflicts used at undefined instance") + + + +(* Interference graph is represented as a list of registers *) +(* each paired with a list of the registers with which it conflicts *) + +let graph ilist llist callerSaves = + let rs = Set.union callerSaves (findRegs llist) |> Set.toList + List.zip rs (List.map (fun r -> conflicts (ilist, ((List.tail llist)@[Set.empty]), callerSaves, r)) rs) + + + + +(* finds move-related registers *) + +let rec findMoves ilist llist = + let rs = findRegs llist |> Set.toList + List.zip rs (List.map (fun r -> findMoves1 r ilist) rs) + +and findMoves1 r = function + | [] -> Set.empty + | (ORI (rd,rs,0) :: ilist) -> + Set.union ( if rd=r then Set.singleton rs + elif rs=r then Set.singleton rd + else Set.empty) + (findMoves1 r ilist) + | (i::ilist) -> findMoves1 r ilist + + + +(* sorts by number of conflicts, but with numeric registers last *) + +let be4 (a, ac) (b, bc) = + match (a, b) with + | (RN i, RN j) -> i <= j + | (RN _, RS _) -> false + | (RS _, RN _) -> true + | (RS sa, RS sb) -> + match (Set.contains sa (!spilledVars), Set.contains sb (!spilledVars)) with + | (false, false) -> Set.count ac <= Set.count bc + | (true , false) -> false + | (false, true ) -> true + | (true , true ) -> Set.count ac <= Set.count bc + +let rec sortByOrder = function + | [] -> [] + | (g : (reg * Set<'b>) list) -> + let rec split = function + | [] -> ([],[]) + | (a::g) -> + let (l, g1) = ascending a g [] + let (g2,g3) = split g1 + (rev2 l g3, g2) + and ascending a g l = + match g with + | [] -> (a::l,[]) + | (b::g1) -> + if be4 a b + then ascending b g1 (a::l) + else (a::l,g) + and rev2 g l2 = + match g with + | [] -> l2 + | (a::l1) -> rev2 l1 (a::l2) + + let rec merge = function + | ([], l2) -> l2 + | (l1, []) -> l1 + | (a::r1, b::r2) -> + if be4 a b + then a :: merge (r1, b::r2) + else b :: merge (a::r1, r2) + + let (g1,g2) = split g + if List.isEmpty g1 then g2 + elif List.isEmpty g2 then g1 + else merge (sortByOrder g1, sortByOrder g2) + + + +(* n-colour graph using Briggs' algorithm *) + +let rec colourGraph g rmin rmax moveRelated = + select (simplify (sortByOrder g) []) + (mList rmin rmax) moveRelated [] + +and simplify h l = + match h with + | [] -> l + | (r,c) :: g -> + simplify (sortByOrder (removeNode r g)) ((r,c)::l) + +and removeNode r = function + | [] -> [] + | ((r1,c)::g) -> + (r1,Set.remove r c) :: removeNode r g + +and select rcl regs moveRelated sl = + match rcl with + | [] -> sl + | ((r,c)::l) -> + let rnum = + if numerical r then r + else let possible = NotIn c sl regs + let related = lookUp2 r moveRelated + let related2 = Set.map (fun r -> lookUp r sl) related + let mPossible= Set.intersect possible related2 + if Set.isEmpty possible then raise (Not_colourable (ppReg r)) + elif Set.isEmpty mPossible then Set.minElement possible //hd possible + else Set.minElement mPossible //hd mPossible + select l regs moveRelated ((r,rnum)::sl) + +and NotIn rcs sl regs : Set = + Set.fold (fun acc r -> Set.remove (lookUp r sl) acc) regs rcs + +and lookUp r = function + | [] -> RN 0 + | ((r1,n)::sl) -> + if numerical r then r + else if r=r1 then n else lookUp r sl + +and lookUp2 r = function + | [] -> Set.empty + | ((r1,ms)::sl) -> if r=r1 then ms else lookUp2 r sl + +and mList m n : Set = + if m > n then Set.empty + else Set.add (RN m) (mList (m+1) n) + + +let rec filterNullMoves ilist allocs = + match ilist with + | [] -> [] + + | (ORI (rd,rs,0) :: ilist_tl) -> + let rd1 = lookUp rd allocs + let rs1 = lookUp rs allocs + if rd1 = rs1 || rd1 = RN 0 + then COMMENT ("\tori\t"+ ppReg rd+","+ ppReg rs+",0") + :: filterNullMoves ilist_tl allocs + else ORI (rd,rs,0) :: filterNullMoves ilist_tl allocs + + | (i :: ilist_tl) -> + i :: filterNullMoves ilist_tl allocs + +and printList = function + | [] -> "" + | (r :: rs) -> r+" "+ printList rs + +let rec printGraph = function + | [] -> [] + | ((r,rs) :: g) -> + [COMMENT ("interferes: "+r+" with "+printList rs)] + @ printGraph g + +let renameReg allocs inst = + let renTo inst1 = [inst1; COMMENT ("was:" + ppMips inst)] + match inst with + | LA (rt,l) -> + renTo (LA (lookUp rt allocs, l)) + | LUI (rt,v) -> + renTo (LUI (lookUp rt allocs, v)) + | ADD (rd,rs,rt) -> + renTo (ADD (lookUp rd allocs, lookUp rs allocs, lookUp rt allocs)) + | ADDI (rd,rs,v) -> + renTo (ADDI (lookUp rd allocs, lookUp rs allocs, v)) + | SUB (rd,rs,rt) -> + renTo (SUB (lookUp rd allocs, lookUp rs allocs, lookUp rt allocs)) + | MUL (rd,rs,rt) -> + renTo (MUL (lookUp rd allocs, lookUp rs allocs, lookUp rt allocs)) + | DIV (rd,rs,rt) -> + renTo (DIV (lookUp rd allocs, lookUp rs allocs, lookUp rt allocs)) + | AND (rd,rs,rt) -> + renTo (AND (lookUp rd allocs, lookUp rs allocs, lookUp rt allocs)) + | ANDI (rd,rs,v) -> + renTo (ANDI (lookUp rd allocs, lookUp rs allocs, v)) + | OR (rd,rs,rt) -> + renTo (OR (lookUp rd allocs, lookUp rs allocs, lookUp rt allocs)) + | ORI (rd,rs,v) -> + renTo (ORI (lookUp rd allocs, lookUp rs allocs, v)) + | XOR (rd,rs,rt) -> + renTo (XOR (lookUp rd allocs, lookUp rs allocs, lookUp rt allocs)) + | XORI (rd,rs,v) -> + renTo (XORI (lookUp rd allocs, lookUp rs allocs, v)) + | SLL (rd,rt,v) -> + renTo (SLL (lookUp rd allocs, lookUp rt allocs, v)) + | SRA (rd,rt,v) -> + renTo (SRA (lookUp rd allocs, lookUp rt allocs, v)) + | SLT (rd,rs,rt) -> + renTo (SLT (lookUp rd allocs, lookUp rs allocs, lookUp rt allocs)) + | SLTI (rd,rs,v) -> + renTo (SLTI (lookUp rd allocs, lookUp rs allocs, v)) + | BEQ (rs,rt,l) -> + renTo (BEQ (lookUp rs allocs, lookUp rt allocs, l)) + | BGEZ(rs,l) -> + renTo (BGEZ(lookUp rs allocs, l)) + | BNE (rs,rt,l) -> + renTo (BNE (lookUp rs allocs, lookUp rt allocs, l)) + | JAL (lab,argRegs) -> + [JAL (lab, List.map (fun r -> lookUp r allocs) argRegs); + COMMENT ("was:" + ppMips inst + + ", " + String.concat " " (List.map ppReg argRegs))] + | JR (r, resRegs) -> + [JR (lookUp r allocs, List.map (fun r -> lookUp r allocs) resRegs); + COMMENT ("was:" + ppMips inst + + ", " + String.concat " " (List.map ppReg resRegs))] + | LW (rd,rs,v) -> + renTo (LW (lookUp rd allocs, lookUp rs allocs, v)) + | SW (rd,rs,v) -> + renTo (SW (lookUp rd allocs, lookUp rs allocs, v)) + | LB (rd,rs,v) -> + renTo (LB (lookUp rd allocs, lookUp rs allocs, v)) + | SB (rd,rs,v) -> + renTo (SB (lookUp rd allocs, lookUp rs allocs, v)) + | _ -> [inst] + +let spill1 i r offset = + let d = destReg i + let u = usedRegs i + let hdlst = if Set.contains r u + then [Mips.LW (r, RN 29, offset)] + else [] + let tllst = if Set.contains r d + then [Mips.SW (r, RN 29, offset)] + else [] + hdlst @ [i] @ tllst + +let rec spill ilist r offset = + match ilist with + | [] -> [] + | (i::is) -> spill1 i r offset @ spill is r offset + +let rec maxreg lst m = + match lst with + | [] -> m + | ((r,RN n)::rs) -> maxreg rs (if m < n then n else m) + | ((_,RS _)::rs) -> raise (MyError "maxreg of non-numeric register") + +(* arguments: + ilist is list of MIPS instructions + liveAtEnd is a set of variables that are live at the end of ilist + rmin is first allocable register (caller-saves) + callerMax is highest caller-saves register + rmax is highest allocable register + spilled is number of registers spilled so far -- should be 0 initially +*) +let rec registerAlloc (ilist : Mips.Instruction list) + (liveAtEnd : Set) + (rmin : int) + (callerMax : int) + (rmax : int) + (spilled : int) + : (Mips.Instruction list * Set * int * int) = + try + let llist = live_regs ilist liveAtEnd + let callerSaves = mList rmin callerMax + let iGraph = graph ilist llist callerSaves + let moveRelated = findMoves ilist llist + let allocs = colourGraph iGraph rmin rmax moveRelated + let deadRegs = Set.difference (filterSymbolic (destRegs ilist)) + ( (List.map (fun (x,_) -> x) allocs) |> Set.ofList ) + let allocs1 = allocs @ (List.map (fun r -> (r, RN 0)) (Set.toList deadRegs)) + let ilist1 = filterNullMoves ilist allocs1 + let ilist2 = List.concat (List.map (renameReg allocs1) ilist1) + (ilist2, List.head llist, maxreg allocs 0, spilled) + with + | (Not_colourable sr) -> + printfn "%s spilled\n" sr + spilledVars := Set.add sr (!spilledVars) + let offset = (4*spilled) + let ilist' = spill ilist (RS sr) offset + let ilist'' = [Mips.SW (RS sr, RN 29,offset)] + @ ilist' @ + (if Set.contains (RS sr) liveAtEnd + then [Mips.LW (RS sr, RN 29, offset)] + else []) + registerAlloc ilist'' liveAtEnd rmin callerMax rmax (spilled + 1) + diff --git a/fasto/Fasto/SymTab.fs b/fasto/Fasto/SymTab.fs new file mode 100644 index 0000000..76a53f3 --- /dev/null +++ b/fasto/Fasto/SymTab.fs @@ -0,0 +1,37 @@ +(* A polymorphic symbol table. *) + +module SymTab + +open System + +(* +A symbol table is just a list of tuples identifiers and values. This allows for +easy shadowing, as a shadowing binding can be quickly placed at the head of the +list. +*) +type SymTab<'a> = SymTab of (string * 'a) list + +let empty () = SymTab [] + +let rec lookup n tab = + match tab with + | SymTab [] -> None + | SymTab ((n1,i1)::remtab) -> + if n = n1 + then Some i1 + else lookup n (SymTab remtab) + +let bind n i (SymTab stab) = SymTab ((n,i)::stab) + +let remove n (SymTab stab) = + SymTab (List.filter (fun (x, _) -> x <> n) stab) + +let removeMany ns (SymTab stab) = + SymTab (List.filter (fun (x, _) -> + not (List.exists (fun y -> y = x) ns)) stab) + +let combine (SymTab t1) (SymTab t2) = SymTab (t1 @ t2) + +let fromList l = SymTab l + +let toList (SymTab lst) = lst diff --git a/fasto/Fasto/SymTab.fsi b/fasto/Fasto/SymTab.fsi new file mode 100644 index 0000000..cd0ec10 --- /dev/null +++ b/fasto/Fasto/SymTab.fsi @@ -0,0 +1,38 @@ +(* +A polymorphic symbol table. +A symbol table is a data structure associating names (strings) with values. It +is useful for keeping track of binidngs. Bindings can be shadowed --- the +active binding is the one made most recently. +*) + +module SymTab + (* A symbol table with values of type 'a. *) + //type SymTab<'a> = SymTab of (string * 'a) list + // when 'a : equality + + (* Create an empty symbol table. *) + val empty : unit -> SymTab<'a> when 'a : equality + + (* Look up the active binding for the name. *) + val lookup : string -> SymTab<'a> -> Option<'a> + + (* Bind the name to a value, shadowing any existing + binidngs with the same name. *) + val bind : string -> 'a -> SymTab<'a> -> SymTab<'a> + + (* Remove all existing bindings of the given name. *) + val remove : string -> SymTab<'a > -> SymTab<'a> + + (* Remove all existing bindings of all the given names. *) + val removeMany : string list -> SymTab<'a > -> SymTab<'a > + + (* Combine two symbol tables. The first table shadows the second. *) + val combine : SymTab<'a > -> SymTab<'a > -> SymTab<'a > + + (* Create a symbol table from a list of name-value pairs. + In case of duplicates, the bindings are shadowed in reverse order from + the head of the list. That is, the active binding will ne the one + closest to the head of the list. *) + val fromList : (string * 'a) list -> SymTab<'a > + val toList : SymTab<'a > -> (string * 'a) list + diff --git a/fasto/Fasto/TypeChecker.fs b/fasto/Fasto/TypeChecker.fs new file mode 100644 index 0000000..84ff77b --- /dev/null +++ b/fasto/Fasto/TypeChecker.fs @@ -0,0 +1,391 @@ +(* A type-checker for Fasto. *) + +module TypeChecker + +(* + +A type-checker checks that all operations in a (Fasto) program are performed on +operands of an appropriate type. Furthermore, a type-checker infers any types +missing in the original program text, necessary for well-defined machine code +generation. + +The main function of interest in this module is: + + val checkProg : Fasto.UnknownTypes.Prog -> Fasto.KnownTypes.Prog + +*) + +open AbSyn + +(* An exception for reporting type errors. *) +exception MyError of string * Position + +type FunTable = SymTab.SymTab<(Type * Type list * Position)> +type VarTable = SymTab.SymTab + + +(* Table of predefined conversion functions *) +let initFunctionTable : FunTable = + SymTab.fromList + [( "chr", (Char, [Int], (0,0))); + ( "ord", (Int, [Char], (0,0))) + ] + +(* Pretty-printer for function types, for error messages *) +let showFunType (args : Type list, res : Type) : string = + match args with + | [] -> " () -> " + ppType res + | args -> (String.concat " * " (List.map ppType args)) + + " -> " + ppType res + +let reportError msg pos = raise (MyError (msg, pos)) + +let reportTypeWrong place tExp tFound pos = + reportError ("Type mismatch in " + place + ": expected " + + ppType tExp + ", but got " + ppType tFound) pos + +let reportTypesDifferent place tFound1 tFound2 pos = + reportError ("Type mismatch in " + place + ": expected " + + "equal types, but got " + ppType tFound1 + + " and " + ppType tFound2) pos + +let reportTypeWrongKind place kExp tFound pos = + reportError ("Type mismatch in " + place + ": expected a(n) " + + kExp + " type, but got " + ppType tFound) pos + +let reportArityWrong place nExp (args, res) pos = + reportError ("Arity mismatch in " + place + ": expected " + + "a function of arity " + string nExp + ", but got " + + showFunType (args, res)) pos + +let reportUnknownId kind name pos = + reportError ("Unkown " + kind + " identifier: " + name) pos + +let reportOther msg pos = reportError msg pos + +(* Determine if a value of some type can be printed with write() *) +let printable (tp : Type) : bool = + match tp with + | Int -> true + | Bool -> true + | Char -> true + | Array Char -> true + | _ -> false (* For all other array types *) + +(* Type-check the two operands to a binary operator - they must both be + of type 't'. Returns the decorated operands on success. *) +let rec checkBinOp (ftab : FunTable) + (vtab : VarTable) + (pos : Position, t : Type, e1 : UntypedExp, e2 : UntypedExp) + : (TypedExp * TypedExp) = + let (t1, e1') = checkExp ftab vtab e1 + let (t2, e2') = checkExp ftab vtab e2 + if t1 <> t then + reportTypeWrong "1st argument of binary operator" t t1 pos + if t2 <> t then + reportTypeWrong "2nd argument of binary operator" t t2 pos + (e1', e2') + +(* Determine the type of an expression. On the way, decorate each + node in the syntax tree with inferred types. The result consists + of a pair: the result type tupled with the type-decorated + expression. An exception is raised immediately on the first type mismatch + by reportError. (We could instead collect each error as part of the + result of checkExp and report all errors at the end.) *) + +and checkExp (ftab : FunTable) + (vtab : VarTable) + (exp : UntypedExp) + : (Type * TypedExp) = + match exp with + | Constant (v, pos) -> (valueType v, Constant (v, pos)) + | StringLit (s, pos) -> (Array Char, StringLit (s, pos)) + | ArrayLit ([], _, pos) -> reportOther "Impossible empty array" pos + | ArrayLit (exp::exps, _, pos) -> + let (type_exp, exp_dec) = checkExp ftab vtab exp + let exps_dec = + List.map (fun ei -> let (ti, ei') = checkExp ftab vtab ei + if ti <> type_exp then + reportTypesDifferent "components of array literal" + type_exp ti pos + ei') + exps + (Array type_exp, ArrayLit (exp_dec :: exps_dec, type_exp, pos)) + + | Var (s, pos) -> + match SymTab.lookup s vtab with + | None -> reportUnknownId "variable" s pos + | Some t -> (t, Var (s, pos)) + + | Plus (e1, e2, pos) -> + let (e1_dec, e2_dec) = checkBinOp ftab vtab (pos, Int, e1, e2) + (Int, Plus (e1_dec, e2_dec, pos)) + + | Minus (e1, e2, pos) -> + let (e1_dec, e2_dec) = checkBinOp ftab vtab (pos, Int, e1, e2) + (Int, Minus (e1_dec, e2_dec, pos)) + + (* TODO project task 1: + Implement by pattern matching Plus/Minus above. + See `AbSyn.fs` for the expression constructors of `Times`, ... + *) + | Times (e1, e2, pos) -> + failwith "Unimplemented type check of multiplication" + + | Divide (_, _, _) -> + failwith "Unimplemented type check of division" + + | And (_, _, _) -> + failwith "Unimplemented type check of &&" + + | Or (_, _, _) -> + failwith "Unimplemented type check of ||" + + | Not (_, _) -> + failwith "Unimplemented type check of not" + + | Negate (_, _) -> + failwith "Unimplemented type check of negate" + + (* The types for e1, e2 must be the same. The result is always a Bool. *) + | Equal (e1, e2, pos) -> + let (t1, e1') = checkExp ftab vtab e1 + let (t2, e2') = checkExp ftab vtab e2 + match (t1 = t2, t1) with + | (false, _) -> reportTypesDifferent "arguments of == " t1 t2 pos + | (true, Array _) -> reportTypeWrongKind "arguments of == " "base" t1 pos + | _ -> (Bool, Equal (e1', e2', pos)) + + | Less (e1, e2, pos) -> + let (t1, e1') = checkExp ftab vtab e1 + let (t2, e2') = checkExp ftab vtab e2 + match (t1 = t2, t1) with + | (false, _) -> reportTypesDifferent "arguments of < " t1 t2 pos + | (true, Array _) -> reportTypeWrongKind "arguments of < " "base" t1 pos + | _ -> (Bool, Less (e1', e2', pos)) + + | If (pred, e1, e2, pos) -> + let (pred_t, pred') = checkExp ftab vtab pred + let (t1, e1') = checkExp ftab vtab e1 + let (t2, e2') = checkExp ftab vtab e2 + let target_type = if t1 = t2 then t1 + else reportTypesDifferent "branches of conditional" + t1 t2 pos + match pred_t with + | Bool -> (target_type, If (pred', e1', e2', pos)) + | _ -> reportTypeWrong "predicate in conditional" Bool pred_t pos + + (* special case for length *) + | Apply ("length", [arg], pos) -> + let (targ, arg') = checkExp ftab vtab arg + match targ with + | Array _ -> (Int, Apply("length", [arg'], pos)) + | _ -> reportTypeWrongKind "argument of length" "array" targ pos + | Apply ("length", args, pos) -> + reportOther ("Arity mismatch: length expects 1 argument, but got " + + string (List.length args)) pos + + (* Look up f in function table, get a list of expected types for each + function argument and an expected type for the return value. Check + each actual argument. Ensure that each actual argument type has the + expected type. *) + | Apply (f, args, pos) -> + let (result_type, expected_arg_types, _) = + match SymTab.lookup f ftab with + | Some tup -> tup (* 2-tuple *) + | None -> reportUnknownId "function" f pos + let nargs = List.length args + let ntypes = List.length expected_arg_types + if nargs <> ntypes then + reportOther ("Arity mismatch: expected " + string ntypes + + " argument(s), but got " + string nargs) pos + let args_dec = + List.mapi2 (fun i ti ai -> + let (ti', ai') = checkExp ftab vtab ai + if ti' <> ti then + reportTypeWrong ("function argument #"+string (i+1)) + ti ti' pos + ai') + expected_arg_types args + (result_type, Apply (f, args_dec, pos)) + + | Let (Dec (name, exp, pos1), exp_body, pos2) -> + let (t1, exp_dec) = checkExp ftab vtab exp + let new_vtab = SymTab.bind name t1 vtab + let (t2, exp_body_dec) = checkExp ftab new_vtab exp_body + (t2, Let (Dec (name, exp_dec, pos1), exp_body_dec, pos2)) + + | Read (t, pos) -> + match t with + | Array _ -> reportTypeWrongKind "argument of read" "base" t pos + | _ -> (t, Read (t, pos)) + + | Write (e, _, pos) -> + let (t, e') = checkExp ftab vtab e + if printable t + then (t, Write (e', t, pos)) + else reportTypeWrongKind "argument of write" "printable" t pos + + | Index (s, i_exp, t, pos) -> + let (e_type, i_exp_dec) = checkExp ftab vtab i_exp + let arr_type = + match SymTab.lookup s vtab with + | Some (Array t) -> t + | None -> reportUnknownId "indexed-variable" s pos + | Some other -> reportTypeWrongKind ("indexed variable " + s) "array" other pos + (arr_type, Index (s, i_exp_dec, arr_type, pos)) + + | Iota (n_exp, pos) -> + let (e_type, n_exp_dec) = checkExp ftab vtab n_exp + if e_type <> Int then + reportTypeWrong "argument of iota" Int e_type pos + (Array Int, Iota (n_exp_dec, pos)) + + | Map (f, arr_exp, _, _, pos) -> + let (arr_type, arr_exp_dec) = checkExp ftab vtab arr_exp + let elem_type = + match arr_type with + | Array t -> t + | _ -> reportTypeWrongKind "second argument of map" "array" arr_type pos + let (f', f_res_type, f_arg_type) = + match checkFunArg ftab vtab pos f with + | (f', res, [a1]) -> (f', res, a1) + | (_, res, args) -> + reportArityWrong "first argument of map" 1 (args,res) pos + if elem_type <> f_arg_type then + reportTypesDifferent "function-argument and array-element types in map" + f_arg_type elem_type pos + (Array f_res_type, Map (f', arr_exp_dec, elem_type, f_res_type, pos)) + + | Reduce (f, e_exp, arr_exp, _, pos) -> + let (e_type , e_dec ) = checkExp ftab vtab e_exp + let (arr_type, arr_dec) = checkExp ftab vtab arr_exp + let elem_type = + match arr_type with + | Array t -> t + | _ -> reportTypeWrongKind "third argument of reduce" "array" arr_type pos + let (f', f_argres_type) = + match checkFunArg ftab vtab pos f with + | (f', res, [a1; a2]) -> + if a1 <> a2 then + reportTypesDifferent "argument types of operation in reduce" + a1 a2 pos + if res <> a1 then + reportTypesDifferent "argument and return type of operation in reduce" + a1 res pos + (f', res) + | (_, res, args) -> + reportArityWrong "operation in reduce" 2 (args,res) pos + if elem_type <> f_argres_type then + reportTypesDifferent "operation and array-element types in reduce" + f_argres_type elem_type pos + if e_type <> f_argres_type then + reportTypesDifferent "operation and start-element types in scan" + f_argres_type e_type pos + (f_argres_type, Reduce (f', e_dec, arr_dec, elem_type, pos)) + + (* TODO project task 2: + See `AbSyn.fs` for the expression constructors of + `Replicate`, `Filter`, `Scan`. + + Hints for `replicate(n, a)`: + - recursively type check `n` and `a` + - check that `n` has integer type + - assuming `a` is of type `t` the result type + of replicate is `[t]` + *) + | Replicate (_, _, _, _) -> + failwith "Unimplemented type check of replicate" + + (* TODO project task 2: Hint for `filter(f, arr)` + Look into the type-checking lecture slides for the type rule of `map` + and think of what needs to be changed for filter (?) + Use `checkFunArg` to get the signature of the function argument `f`. + Check that: + - `f` has type `ta -> Bool` + - `arr` should be of type `[ta]` + - the result of filter should have type `[tb]` + *) + | Filter (_, _, _, _) -> + failwith "Unimplemented type check of filter" + + (* TODO project task 2: `scan(f, ne, arr)` + Hint: Implementation is very similar to `reduce(f, ne, arr)`. + (The difference between `scan` and `reduce` is that + scan's return type is the same as the type of `arr`, + while reduce's return type is that of an element of `arr`). + *) + | Scan (_, _, _, _, _) -> + failwith "Unimplemented type check of scan" + +and checkFunArg (ftab : FunTable) + (vtab : VarTable) + (pos : Position) + (ff : UntypedFunArg) + : (TypedFunArg * Type * Type list) = + match ff with + | FunName fname -> + match SymTab.lookup fname ftab with + | None -> reportUnknownId "parameter function" fname pos + | Some (ret_type, arg_types, _) -> (FunName fname, ret_type, arg_types) + | Lambda (rettype, parms, body, funpos) -> + let lambda = FunDec ("", rettype, parms, body, funpos) + let (FunDec (_, _, _, body', _)) = + checkFunWithVtable ftab vtab pos lambda + ( Lambda (rettype, parms, body', pos) + , rettype + , List.map (fun (Param (_, ty)) -> ty) parms) + + +(* Check a function declaration, but using a given vtable rather +than an empty one. *) +and checkFunWithVtable (ftab : FunTable) + (vtab : VarTable) + (pos : Position) + (fdec : UntypedFunDec) + : TypedFunDec = + let (FunDec (fname, rettype, parms, body, funpos)) = fdec + (* Expand vtable by adding the parameters to vtab. *) + let addParam ptable (Param (pname, ty)) = + match SymTab.lookup pname ptable with + | Some _ -> reportOther ("Multiple parameters named " + pname) + funpos + | None -> SymTab.bind pname ty ptable + let paramtable = List.fold addParam (SymTab.empty()) parms + let vtab' = SymTab.combine paramtable vtab + let (body_type, body') = checkExp ftab vtab' body + if body_type = rettype + then (FunDec (fname, rettype, parms, body', pos)) + else reportTypeWrong "function body" rettype body_type funpos + + +(* Convert a funDec into the (fname, ([arg types], result type), + pos) entries that the function table, ftab, consists of, and + update the function table with that entry. *) +let updateFunctionTable (ftab : FunTable) + (fundec : UntypedFunDec) + : FunTable = + let (FunDec (fname, ret_type, args, _, pos)) = fundec + let arg_types = List.map (fun (Param (_, ty)) -> ty) args + match SymTab.lookup fname ftab with + | Some (_, _, old_pos) -> reportOther ("Duplicate function " + fname) pos + | None -> SymTab.bind fname (ret_type, arg_types, pos) ftab + +(* Functions are guaranteed by syntax to have a known declared type. This + type is checked against the type of the function body, taking into + account declared argument types and types of other functions called. + *) +let checkFun (ftab : FunTable) + (fundec : UntypedFunDec) + : TypedFunDec = + let (FunDec (_, _, _, _, pos)) = fundec + checkFunWithVtable ftab (SymTab.empty()) pos fundec + +let checkProg (funDecs : UntypedFunDec list) : TypedFunDec list = + let ftab = List.fold updateFunctionTable initFunctionTable funDecs + let decorated_funDecs = List.map (checkFun ftab) funDecs + match SymTab.lookup "main" ftab with + | None -> reportOther "No main function defined" (0,0) + | Some (_, [], _) -> decorated_funDecs (* all fine! *) + | Some (ret_type, args, mainpos) -> + reportArityWrong "declaration of main" 0 (args,ret_type) mainpos diff --git a/fasto/Makefile b/fasto/Makefile new file mode 100644 index 0000000..7029438 --- /dev/null +++ b/fasto/Makefile @@ -0,0 +1,6 @@ +all: + dotnet build Fasto + +clean: + rm -rf Fasto/bin Fasto/obj + rm -f Fasto/Parser.fs Fasto/Parser.fsi Fasto/Parser.fsyacc.output Fasto/Lexer.fs diff --git a/fasto/README.txt b/fasto/README.txt new file mode 100644 index 0000000..96f3187 --- /dev/null +++ b/fasto/README.txt @@ -0,0 +1,22 @@ +# The Fasto Compiler (v1.0, 2022-04-27) + +This is the compiler for the Fasto programming language. The source +code resides in the `Fasto` directory. + +Note that you need the .NET 6.0 SDK (*not* a Mono-based F#) installed +on your machine, with the `dotnet` executable in your search path. +Additionally, you should have `bash` to execute the various test +scripts, and the Java Runtime Environment (full SDK not needed) to run +the MARS simulator. + +To build the compiler, run `make` (or just `dotnet build Fasto`). + +To interpret, compile, or optimize a Fasto program, run `bin/fasto.sh`. + +To execute a compiled program (in MIPS assembly), run `bin/mars.sh`. + +To compile and immediately execute a Fasto program, run `bin/compilerun.sh`. + +To run all tests from the `tests` directory (or some other), run +`bin/runtests.sh`. Use `-i` to run in interpreted mode, and `-o` to +turn on the optimizations in the compiler. diff --git a/fasto/bin/Mars4_5.jar b/fasto/bin/Mars4_5.jar new file mode 100644 index 0000000..0021281 Binary files /dev/null and b/fasto/bin/Mars4_5.jar differ diff --git a/fasto/bin/compilerun.sh b/fasto/bin/compilerun.sh new file mode 100755 index 0000000..a4fbbec --- /dev/null +++ b/fasto/bin/compilerun.sh @@ -0,0 +1,35 @@ +#!/usr/bin/env sh +# +# Compile and run a FASTO program. This script should work on Linux, Mac, and +# Microsoft Windows with Cygwin . +# +# The Mars4_5.jar simulator must be in your Fasto "bin" directory, or you must +# export its location into the environment variable named MARS. +# +# If '-o' is given as the first argument, the program will be optimised. +# +# Usage: bin/compilerun.sh [-o] PROGRAM.fo + +set -e # Exit on first error. + +base_dir="$(dirname "$0")" + +if [ $# -eq 0 ]; then + echo "Usage: $0 [-o] PROGRAM.fo" + exit 1 +fi + +if [ "$1" = -o ]; then + flags=-o + shift +else + flags=-c +fi + +prog_input="$1" + +# Compile. +"$base_dir/../bin/fasto.sh" $flags "$1" + +# Run +$base_dir/../bin/mars.sh "$(dirname "$prog_input")/$(basename "$prog_input" .fo).asm" 2> /dev/null diff --git a/fasto/bin/fasto.sh b/fasto/bin/fasto.sh new file mode 100755 index 0000000..3958e52 --- /dev/null +++ b/fasto/bin/fasto.sh @@ -0,0 +1,20 @@ +#!/usr/bin/env bash + +set -e # Die on first error. + +base_dir="$(dirname "$0")" + +# Determine location of executable. Does this work on all platforms? +if ! [ "$FASTO" ]; then + FASTO="$base_dir/../Fasto/bin/Debug/net6.0/Fasto.dll" + if [[ $(uname -o 2> /dev/null) = "Cygwin" ]]; then + FASTO="$(cygpath -w "FASTO")" + fi +fi + +# Verify that .NET is installed. +dotnet --version &> /dev/null || (echo "Could not find dotnet" && exit 1) + +dotnet $FASTO "$@" + + diff --git a/fasto/bin/mars.sh b/fasto/bin/mars.sh new file mode 100755 index 0000000..dc362ce --- /dev/null +++ b/fasto/bin/mars.sh @@ -0,0 +1,20 @@ +#!/usr/bin/env bash + +set -e # Die on first error. + +base_dir="$(dirname "$0")" + +# Determine location of MARS. +if ! [ "$MARS" ]; then + MARS="$base_dir/../bin/Mars4_5.jar" + if [[ $(uname -o 2> /dev/null) = "Cygwin" ]]; then + MARS="$(cygpath -w "$MARS")" + fi +fi + +# Verify that Java is installed. +java -version &> /dev/null || (echo "Could not find java" && exit 1) + +java -jar "$MARS" nc "$@" + + diff --git a/fasto/bin/runtests.sh b/fasto/bin/runtests.sh new file mode 100755 index 0000000..07f4706 --- /dev/null +++ b/fasto/bin/runtests.sh @@ -0,0 +1,152 @@ +#!/usr/bin/env bash +# +# Run all tests. +# +# Use -o to optimise the test programs before compiling them. +# Use -i to interpret the test programs instead of compiling them. +# +# You can just run this script with no arguments. If you want to run +# tests from a certain directory, specify that as the last argument. +# For example, if you are in the root directory, and want to run the +# tests in 'my_tests_dir` with optimisations enabled, you can run: +# +# $ ./bin/runtests.sh -o my_tests_dir +# +# Test programs (those ending with '.fo') are given their corresponding +# '.in' files as standard in when running, and are expected to produce +# the contents of the corresponding '.out' files, or the error of the +# corresponding '.err' files. If no corresponding '.in' file exists, +# the program is expected to fail at compile time. +# +# The Mars4_5.jar simulator must be in your Fasto "bin" directory, or +# you must export its location into the environment variable named MARS, +# unless you're using the '-i' option, in which case MARS is not used. +# +# If no argument is given, the script will run the tests in the current +# directory; otherwise it will use the first argument as a directory, +# and run the tests in that directory. +# +# Authors through the ages: +# Troels Henriksen . +# Rasmus Wriedt Larsen +# Mathias Grymer +# Niels G. W. Serup + +set -e # Die on first error. + +base_dir="$(dirname "$0")" +fasto="$base_dir/../bin/fasto.sh" +mars="$base_dir/../bin/mars.sh" + +# Determine fasto command-line flags. +if [ "$1" = -o ]; then + flags=-o + shift +elif [ "$1" = -i ]; then + flags='' + shift +else + flags=-c +fi + +# Find the directory containing the test programs. +tests_dir="$1" +if ! [ "$tests_dir" ]; then + tests_dir="$base_dir/../tests" +fi +tests_dir="$(echo "$tests_dir" | sed 's/\/*$//')" + +# Remove all whitespace and NUL bytes when comparing results, because +# Mars and the interpreter puts different amounts -- and to handle +# Windows/OSX/Unix line ending differences. +fix_whitespace() { + cat "$1" | tr -d '\000' | tr -d ' \t\n\r\f' 1>&1 +} + +check_equal() { + if [ -f $tests_dir/$OUTPUT ]; then + + EXPECTED=$(fix_whitespace "$tests_dir/$OUTPUT") + ACTUAL=$(fix_whitespace "$TESTOUT") + if [ "$EXPECTED" = "$ACTUAL" ]; then + rm -f $TESTOUT + else + echo "Output for $PROG does not match expected output." + echo "Compare $TESTOUT and $tests_dir/$OUTPUT." + return 1 + fi + fi +} + +# make -C "$base_dir/.." + +file_len=0 +for FO in $tests_dir/*fo; do + L=$(basename "$FO") + if ((${#L} > $file_len)); then + file_len=${#L} + fi +done +file_len=$(($file_len+4)) + +echo +if [ "$flags" = "" ]; then + echo "=== Running Fasto test programs (interpreted) ===" +elif [ "$flags" = "-c" ]; then + echo "=== Running Fasto test programs (compiled) ===" +elif [ "$flags" = "-o" ]; then + echo "=== Running Fasto test programs (compiled, with optimizations) ===" +fi +echo +for FO in $tests_dir/*fo; do + FO=$(basename "$FO") + PROG=$(echo $FO|sed 's/.fo$//') + INPUT=$(echo $FO|sed 's/fo$/in/') + OUTPUT=$(echo $FO|sed 's/fo$/out/') + ERROUT=$(echo $FO|sed 's/fo$/err/') + ASM=$(echo $FO|sed 's/fo$/asm/') + TESTOUT=$tests_dir/$OUTPUT-testresult + + if [ -f $tests_dir/$INPUT ]; then + # Is positive test. + echo -n "Testing" + printf "%*s" $file_len " $FO: " + if [ "$flags" ]; then + # Compile. + if $fasto $flags $tests_dir/$PROG; then + $mars $tests_dir/$ASM < $tests_dir/$INPUT > $TESTOUT 2>/dev/null + if check_equal; then + echo -e "\033[92mSuccess.\033[0m" + else + echo -e "\033[91mExecution error.\033[0m" + fi + else + echo -e "\033[91mCompilation error.\033[0m" + fi + else + # Interpret. + cat $tests_dir/$INPUT | $fasto -r $tests_dir/$PROG | grep -v "Result of 'main'" > $TESTOUT 2>&1 + if check_equal; then + echo -e "\033[92mSuccess.\033[0m" + else + echo -e "\033[91mInterpretation error.\033[0m" + fi + fi + else + # Is negative test. + echo -n "Testing" + printf "%*s" $file_len "$FO: " + if $fasto -c $tests_dir/$PROG > $TESTOUT 2>&1; then + echo -e "\033[91mCompiled but should result in compile error.\033[0m" + elif [ -f $tests_dir/$ERROUT ]; then + EXPECTED=$(fix_whitespace $tests_dir/$ERROUT) + ACTUAL=$(fix_whitespace $TESTOUT) + if [ "$EXPECTED" = "$ACTUAL" ]; then + rm -f $TESTOUT + echo -e "\033[92mSuccess.\033[0m" + else + echo -e "\033[91mThe error for $PROG does not match the expected error. Compare $TESTOUT and $tests_dir/$ERROUT.\033[0m" + fi + fi + fi +done diff --git a/fasto/doc/GroupProj-2022.pdf b/fasto/doc/GroupProj-2022.pdf new file mode 100644 index 0000000..4352d06 Binary files /dev/null and b/fasto/doc/GroupProj-2022.pdf differ diff --git a/fasto/tests/comprehension.asm b/fasto/tests/comprehension.asm new file mode 100644 index 0000000..7210858 --- /dev/null +++ b/fasto/tests/comprehension.asm @@ -0,0 +1,605 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $21, -28($29) + sw $20, -24($29) + sw $19, -20($29) + sw $18, -16($29) + sw $17, -12($29) + sw $16, -8($29) + addi $29, $29, -32 + jal getint +# was: jal getint, $2 + ori $5, $2, 0 +# was: ori _letBind_2_, $2, 0 +# ori _size_reg_4_,_letBind_2_,0 + bgez $5, _safe_lab_5_ +# was: bgez _size_reg_4_, _safe_lab_5_ + ori $5, $0, 6 +# was: ori $5, $0, 6 + la $6, _Msg_IllegalArraySize_ +# was: la $6, _Msg_IllegalArraySize_ + j _RuntimeError_ +_safe_lab_5_: + ori $9, $28, 0 +# was: ori _letBind_3_, $28, 0 + sll $2, $5, 2 +# was: sll _tmp_11_, _size_reg_4_, 2 + addi $2, $2, 4 +# was: addi _tmp_11_, _tmp_11_, 4 + add $28, $28, $2 +# was: add $28, $28, _tmp_11_ + sw $5, 0($9) +# was: sw _size_reg_4_, 0(_letBind_3_) + addi $4, $9, 4 +# was: addi _addr_reg_6_, _letBind_3_, 4 + ori $2, $0, 0 +# was: ori _i_reg_7_, $0, 0 +_loop_beg_8_: + sub $3, $2, $5 +# was: sub _tmp_reg_10_, _i_reg_7_, _size_reg_4_ + bgez $3, _loop_end_9_ +# was: bgez _tmp_reg_10_, _loop_end_9_ + sw $2, 0($4) +# was: sw _i_reg_7_, 0(_addr_reg_6_) + addi $4, $4, 4 +# was: addi _addr_reg_6_, _addr_reg_6_, 4 + addi $2, $2, 1 +# was: addi _i_reg_7_, _i_reg_7_, 1 + j _loop_beg_8_ +_loop_end_9_: + ori $2, $5, 0 +# was: ori _size_reg_13_, _letBind_2_, 0 + bgez $2, _safe_lab_14_ +# was: bgez _size_reg_13_, _safe_lab_14_ + ori $5, $0, 7 +# was: ori $5, $0, 7 + la $6, _Msg_IllegalArraySize_ +# was: la $6, _Msg_IllegalArraySize_ + j _RuntimeError_ +_safe_lab_14_: + ori $8, $28, 0 +# was: ori _letBind_12_, $28, 0 + sll $3, $2, 2 +# was: sll _tmp_20_, _size_reg_13_, 2 + addi $3, $3, 4 +# was: addi _tmp_20_, _tmp_20_, 4 + add $28, $28, $3 +# was: add $28, $28, _tmp_20_ + sw $2, 0($8) +# was: sw _size_reg_13_, 0(_letBind_12_) + addi $5, $8, 4 +# was: addi _addr_reg_15_, _letBind_12_, 4 + ori $4, $0, 0 +# was: ori _i_reg_16_, $0, 0 +_loop_beg_17_: + sub $3, $4, $2 +# was: sub _tmp_reg_19_, _i_reg_16_, _size_reg_13_ + bgez $3, _loop_end_18_ +# was: bgez _tmp_reg_19_, _loop_end_18_ + sw $4, 0($5) +# was: sw _i_reg_16_, 0(_addr_reg_15_) + addi $5, $5, 4 +# was: addi _addr_reg_15_, _addr_reg_15_, 4 + addi $4, $4, 1 +# was: addi _i_reg_16_, _i_reg_16_, 1 + j _loop_beg_17_ +_loop_end_18_: +# ori _len_arr_24_,_letBind_3_,0 + lw $2, 0($9) +# was: lw _mult1_L_22_, 0(_len_arr_24_) +# ori _len_arr_25_,_letBind_12_,0 + lw $3, 0($8) +# was: lw _mult2_R_23_, 0(_len_arr_25_) + mul $2, $2, $3 +# was: mul _letBind_21_, _mult1_L_22_, _mult2_R_23_ +# ori _size_reg_31_,_letBind_21_,0 + bgez $2, _safe_lab_32_ +# was: bgez _size_reg_31_, _safe_lab_32_ + ori $5, $0, 8 +# was: ori $5, $0, 8 + la $6, _Msg_IllegalArraySize_ +# was: la $6, _Msg_IllegalArraySize_ + j _RuntimeError_ +_safe_lab_32_: + ori $7, $28, 0 +# was: ori _arr_reg_28_, $28, 0 + sll $3, $2, 2 +# was: sll _tmp_38_, _size_reg_31_, 2 + addi $3, $3, 4 +# was: addi _tmp_38_, _tmp_38_, 4 + add $28, $28, $3 +# was: add $28, $28, _tmp_38_ + sw $2, 0($7) +# was: sw _size_reg_31_, 0(_arr_reg_28_) + addi $5, $7, 4 +# was: addi _addr_reg_33_, _arr_reg_28_, 4 + ori $4, $0, 0 +# was: ori _i_reg_34_, $0, 0 +_loop_beg_35_: + sub $3, $4, $2 +# was: sub _tmp_reg_37_, _i_reg_34_, _size_reg_31_ + bgez $3, _loop_end_36_ +# was: bgez _tmp_reg_37_, _loop_end_36_ + sw $4, 0($5) +# was: sw _i_reg_34_, 0(_addr_reg_33_) + addi $5, $5, 4 +# was: addi _addr_reg_33_, _addr_reg_33_, 4 + addi $4, $4, 1 +# was: addi _i_reg_34_, _i_reg_34_, 1 + j _loop_beg_35_ +_loop_end_36_: + lw $3, 0($7) +# was: lw _size_reg_27_, 0(_arr_reg_28_) + ori $4, $28, 0 +# was: ori _letBind_26_, $28, 0 + sll $5, $3, 2 +# was: sll _tmp_88_, _size_reg_27_, 2 + addi $5, $5, 4 +# was: addi _tmp_88_, _tmp_88_, 4 + add $28, $28, $5 +# was: add $28, $28, _tmp_88_ + sw $3, 0($4) +# was: sw _size_reg_27_, 0(_letBind_26_) + addi $6, $4, 4 +# was: addi _addr_reg_39_, _letBind_26_, 4 + ori $5, $0, 0 +# was: ori _i_reg_40_, $0, 0 + addi $7, $7, 4 +# was: addi _elem_reg_29_, _arr_reg_28_, 4 +_loop_beg_41_: + sub $10, $5, $3 +# was: sub _tmp_reg_43_, _i_reg_40_, _size_reg_27_ + bgez $10, _loop_end_42_ +# was: bgez _tmp_reg_43_, _loop_end_42_ + lw $11, 0($7) +# was: lw _res_reg_30_, 0(_elem_reg_29_) + addi $7, $7, 4 +# was: addi _elem_reg_29_, _elem_reg_29_, 4 +# ori _div1_L_46_,_letBind_21_,0 +# ori _len_arr_49_,_letBind_12_,0 + lw $10, 0($8) +# was: lw _div2_R_47_, 0(_len_arr_49_) + bne $10, $0, _safe_div_48_ +# was: bne _div2_R_47_, $0, _safe_div_48_ + ori $5, $0, 8 +# was: ori $5, $0, 8 + la $6, _Msg_DivZero_ +# was: la $6, _Msg_DivZero_ + j _RuntimeError_ +_safe_div_48_: + div $10, $2, $10 +# was: div _letBind_45_, _div1_L_46_, _div2_R_47_ +# ori _div1_L_51_,_res_reg_30_,0 +# ori _div2_R_52_,_letBind_45_,0 + bne $10, $0, _safe_div_53_ +# was: bne _div2_R_52_, $0, _safe_div_53_ + ori $5, $0, 8 +# was: ori $5, $0, 8 + la $6, _Msg_DivZero_ +# was: la $6, _Msg_DivZero_ + j _RuntimeError_ +_safe_div_53_: + div $13, $11, $10 +# was: div _letBind_50_, _div1_L_51_, _div2_R_52_ +# ori _minus_L_55_,_res_reg_30_,0 +# ori _mult1_L_57_,_letBind_50_,0 +# ori _mult2_R_58_,_letBind_45_,0 + mul $12, $13, $10 +# was: mul _minus_R_56_, _mult1_L_57_, _mult2_R_58_ + sub $11, $11, $12 +# was: sub _letBind_54_, _minus_L_55_, _minus_R_56_ +# ori _arr_ind_60_,_letBind_50_,0 + addi $12, $8, 4 +# was: addi _arr_reg_61_, _letBind_12_, 4 + lw $14, 0($8) +# was: lw _size_reg_62_, 0(_letBind_12_) + bgez $13, _safe_lab_65_ +# was: bgez _arr_ind_60_, _safe_lab_65_ +_error_lab_64_: + ori $5, $0, 8 +# was: ori $5, $0, 8 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_65_: + sub $14, $13, $14 +# was: sub _tmp_reg_63_, _arr_ind_60_, _size_reg_62_ + bgez $14, _error_lab_64_ +# was: bgez _tmp_reg_63_, _error_lab_64_ + sll $13, $13, 2 +# was: sll _arr_ind_60_, _arr_ind_60_, 2 + add $12, $12, $13 +# was: add _arr_reg_61_, _arr_reg_61_, _arr_ind_60_ + lw $12, 0($12) +# was: lw _letBind_59_, 0(_arr_reg_61_) +# ori _div1_L_67_,_letBind_45_,0 +# ori _len_arr_70_,_letBind_3_,0 + lw $13, 0($9) +# was: lw _div2_R_68_, 0(_len_arr_70_) + bne $13, $0, _safe_div_69_ +# was: bne _div2_R_68_, $0, _safe_div_69_ + ori $5, $0, 8 +# was: ori $5, $0, 8 + la $6, _Msg_DivZero_ +# was: la $6, _Msg_DivZero_ + j _RuntimeError_ +_safe_div_69_: + div $10, $10, $13 +# was: div _letBind_66_, _div1_L_67_, _div2_R_68_ +# ori _div1_L_72_,_letBind_54_,0 +# ori _div2_R_73_,_letBind_66_,0 + bne $10, $0, _safe_div_74_ +# was: bne _div2_R_73_, $0, _safe_div_74_ + ori $5, $0, 8 +# was: ori $5, $0, 8 + la $6, _Msg_DivZero_ +# was: la $6, _Msg_DivZero_ + j _RuntimeError_ +_safe_div_74_: + div $11, $11, $10 +# was: div _letBind_71_, _div1_L_72_, _div2_R_73_ +# ori _arr_ind_76_,_letBind_71_,0 + addi $10, $9, 4 +# was: addi _arr_reg_77_, _letBind_3_, 4 + lw $13, 0($9) +# was: lw _size_reg_78_, 0(_letBind_3_) + bgez $11, _safe_lab_81_ +# was: bgez _arr_ind_76_, _safe_lab_81_ +_error_lab_80_: + ori $5, $0, 8 +# was: ori $5, $0, 8 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_81_: + sub $13, $11, $13 +# was: sub _tmp_reg_79_, _arr_ind_76_, _size_reg_78_ + bgez $13, _error_lab_80_ +# was: bgez _tmp_reg_79_, _error_lab_80_ + sll $11, $11, 2 +# was: sll _arr_ind_76_, _arr_ind_76_, 2 + add $10, $10, $11 +# was: add _arr_reg_77_, _arr_reg_77_, _arr_ind_76_ + lw $10, 0($10) +# was: lw _letBind_75_, 0(_arr_reg_77_) +# ori _plus_L_86_,_letBind_75_,0 +# ori _plus_R_87_,_letBind_59_,0 + add $11, $10, $12 +# was: add _div1_L_83_, _plus_L_86_, _plus_R_87_ + ori $10, $0, 2 +# was: ori _div2_R_84_, $0, 2 + bne $10, $0, _safe_div_85_ +# was: bne _div2_R_84_, $0, _safe_div_85_ + ori $5, $0, 8 +# was: ori $5, $0, 8 + la $6, _Msg_DivZero_ +# was: la $6, _Msg_DivZero_ + j _RuntimeError_ +_safe_div_85_: + div $10, $11, $10 +# was: div _letBind_82_, _div1_L_83_, _div2_R_84_ +# ori _fun_arg_res_44_,_letBind_82_,0 + ori $11, $10, 0 +# was: ori _res_reg_30_, _fun_arg_res_44_, 0 + sw $11, 0($6) +# was: sw _res_reg_30_, 0(_addr_reg_39_) + addi $6, $6, 4 +# was: addi _addr_reg_39_, _addr_reg_39_, 4 + addi $5, $5, 1 +# was: addi _i_reg_40_, _i_reg_40_, 1 + j _loop_beg_41_ +_loop_end_42_: +# ori _arr_reg_91_,_letBind_26_,0 + lw $3, 0($4) +# was: lw _size_reg_90_, 0(_arr_reg_91_) + ori $2, $28, 0 +# was: ori _letBind_89_, $28, 0 + sll $5, $3, 2 +# was: sll _tmp_112_, _size_reg_90_, 2 + addi $5, $5, 4 +# was: addi _tmp_112_, _tmp_112_, 4 + add $28, $28, $5 +# was: add $28, $28, _tmp_112_ + sw $3, 0($2) +# was: sw _size_reg_90_, 0(_letBind_89_) + addi $5, $2, 4 +# was: addi _addr_reg_95_, _letBind_89_, 4 + addi $4, $4, 4 +# was: addi _arr_reg_91_, _arr_reg_91_, 4 + ori $6, $0, 0 +# was: ori _i_reg_96_, $0, 0 + ori $7, $0, 0 +# was: ori _count_reg_94_, $0, 0 +_loop_beg_97_: + sub $8, $6, $3 +# was: sub _tmp_reg_100_, _i_reg_96_, _size_reg_90_ + bgez $8, _loop_end_98_ +# was: bgez _tmp_reg_100_, _loop_end_98_ + lw $10, 0($4) +# was: lw _elem_reg_92_, 0(_arr_reg_91_) + addi $4, $4, 4 +# was: addi _arr_reg_91_, _arr_reg_91_, 4 +# ori _minus_L_104_,_elem_reg_92_,0 + ori $9, $10, 0 +# was: ori _div1_L_108_, _elem_reg_92_, 0 + ori $8, $0, 5 +# was: ori _div2_R_109_, $0, 5 + bne $8, $0, _safe_div_110_ +# was: bne _div2_R_109_, $0, _safe_div_110_ + ori $5, $0, 8 +# was: ori $5, $0, 8 + la $6, _Msg_DivZero_ +# was: la $6, _Msg_DivZero_ + j _RuntimeError_ +_safe_div_110_: + div $8, $9, $8 +# was: div _mult1_L_106_, _div1_L_108_, _div2_R_109_ + ori $9, $0, 5 +# was: ori _mult2_R_107_, $0, 5 + mul $8, $8, $9 +# was: mul _minus_R_105_, _mult1_L_106_, _mult2_R_107_ + sub $9, $10, $8 +# was: sub _eq_L_102_, _minus_L_104_, _minus_R_105_ + ori $11, $0, 0 +# was: ori _eq_R_103_, $0, 0 + ori $8, $0, 0 +# was: ori _fun_arg_res_101_, $0, 0 + bne $9, $11, _false_111_ +# was: bne _eq_L_102_, _eq_R_103_, _false_111_ + ori $8, $0, 1 +# was: ori _fun_arg_res_101_, $0, 1 +_false_111_: +# ori _bool_reg_93_,_fun_arg_res_101_,0 + beq $8, $0, _if_end_99_ +# was: beq _bool_reg_93_, $0, _if_end_99_ + sw $10, 0($5) +# was: sw _elem_reg_92_, 0(_addr_reg_95_) + addi $5, $5, 4 +# was: addi _addr_reg_95_, _addr_reg_95_, 4 + addi $7, $7, 1 +# was: addi _count_reg_94_, _count_reg_94_, 1 +_if_end_99_: + addi $6, $6, 1 +# was: addi _i_reg_96_, _i_reg_96_, 1 + j _loop_beg_97_ +_loop_end_98_: + sw $7, 0($2) +# was: sw _count_reg_94_, 0(_letBind_89_) +# ori _arr_reg_115_,_letBind_89_,0 + lw $4, 0($2) +# was: lw _size_reg_114_, 0(_arr_reg_115_) + ori $6, $28, 0 +# was: ori _letBind_113_, $28, 0 + sll $3, $4, 2 +# was: sll _tmp_126_, _size_reg_114_, 2 + addi $3, $3, 4 +# was: addi _tmp_126_, _tmp_126_, 4 + add $28, $28, $3 +# was: add $28, $28, _tmp_126_ + sw $4, 0($6) +# was: sw _size_reg_114_, 0(_letBind_113_) + addi $3, $6, 4 +# was: addi _addr_reg_118_, _letBind_113_, 4 + ori $5, $0, 0 +# was: ori _i_reg_119_, $0, 0 + addi $2, $2, 4 +# was: addi _elem_reg_116_, _arr_reg_115_, 4 +_loop_beg_120_: + sub $7, $5, $4 +# was: sub _tmp_reg_122_, _i_reg_119_, _size_reg_114_ + bgez $7, _loop_end_121_ +# was: bgez _tmp_reg_122_, _loop_end_121_ + lw $7, 0($2) +# was: lw _res_reg_117_, 0(_elem_reg_116_) + addi $2, $2, 4 +# was: addi _elem_reg_116_, _elem_reg_116_, 4 +# ori _mult1_L_124_,_res_reg_117_,0 + ori $8, $7, 0 +# was: ori _mult2_R_125_, _res_reg_117_, 0 + mul $7, $7, $8 +# was: mul _fun_arg_res_123_, _mult1_L_124_, _mult2_R_125_ +# ori _res_reg_117_,_fun_arg_res_123_,0 + sw $7, 0($3) +# was: sw _res_reg_117_, 0(_addr_reg_118_) + addi $3, $3, 4 +# was: addi _addr_reg_118_, _addr_reg_118_, 4 + addi $5, $5, 1 +# was: addi _i_reg_119_, _i_reg_119_, 1 + j _loop_beg_120_ +_loop_end_121_: +# ori _arr_reg_128_,_letBind_113_,0 + lw $17, 0($6) +# was: lw _size_reg_127_, 0(_arr_reg_128_) + ori $16, $28, 0 +# was: ori _mainres_1_, $28, 0 + sll $2, $17, 2 +# was: sll _tmp_138_, _size_reg_127_, 2 + addi $2, $2, 4 +# was: addi _tmp_138_, _tmp_138_, 4 + add $28, $28, $2 +# was: add $28, $28, _tmp_138_ + sw $17, 0($16) +# was: sw _size_reg_127_, 0(_mainres_1_) + addi $18, $16, 4 +# was: addi _addr_reg_131_, _mainres_1_, 4 + ori $19, $0, 0 +# was: ori _i_reg_132_, $0, 0 + addi $20, $6, 4 +# was: addi _elem_reg_129_, _arr_reg_128_, 4 +_loop_beg_133_: + sub $2, $19, $17 +# was: sub _tmp_reg_135_, _i_reg_132_, _size_reg_127_ + bgez $2, _loop_end_134_ +# was: bgez _tmp_reg_135_, _loop_end_134_ + lw $21, 0($20) +# was: lw _res_reg_130_, 0(_elem_reg_129_) + addi $20, $20, 4 +# was: addi _elem_reg_129_, _elem_reg_129_, 4 +# ori _tmp_137_,_res_reg_130_,0 +# ori _fun_arg_res_136_,_tmp_137_,0 + ori $2, $21, 0 +# was: ori $2, _fun_arg_res_136_, 0 + jal putint +# was: jal putint, $2 +# ori _res_reg_130_,_fun_arg_res_136_,0 + sw $21, 0($18) +# was: sw _res_reg_130_, 0(_addr_reg_131_) + addi $18, $18, 4 +# was: addi _addr_reg_131_, _addr_reg_131_, 4 + addi $19, $19, 1 +# was: addi _i_reg_132_, _i_reg_132_, 1 + j _loop_beg_133_ +_loop_end_134_: + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + addi $29, $29, 32 + lw $21, -28($29) + lw $20, -24($29) + lw $19, -20($29) + lw $18, -16($29) + lw $17, -12($29) + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/comprehension.fo b/fasto/tests/comprehension.fo new file mode 100644 index 0000000..b9f25e8 --- /dev/null +++ b/fasto/tests/comprehension.fo @@ -0,0 +1,8 @@ +fun int write_int(int x) = write(x) +fun [int] write_int_arr([int] x) = map(write_int, x) + +fun [int] main() = + let n = read (int) in + let x = iota (n) in + let y = iota (n) in + write_int_arr ([int r*r | i <- x, j <-y; int r = (i+j) / 2; r - (r/5)*5 == 0 ]) diff --git a/fasto/tests/comprehension.in b/fasto/tests/comprehension.in new file mode 100644 index 0000000..60d3b2f --- /dev/null +++ b/fasto/tests/comprehension.in @@ -0,0 +1 @@ +15 diff --git a/fasto/tests/comprehension.out b/fasto/tests/comprehension.out new file mode 100644 index 0000000..34a083f --- /dev/null +++ b/fasto/tests/comprehension.out @@ -0,0 +1 @@ +0 0 25 25 0 25 25 25 25 25 25 25 25 25 25 25 25 100 25 25 100 100 25 25 100 100 25 25 100 100 25 25 100 100 25 100 100 100 100 100 100 100 100 diff --git a/fasto/tests/copyConstPropFold0.asm b/fasto/tests/copyConstPropFold0.asm new file mode 100644 index 0000000..95f4b11 --- /dev/null +++ b/fasto/tests/copyConstPropFold0.asm @@ -0,0 +1,171 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $16, -8($29) + addi $29, $29, -12 + jal getint +# was: jal getint, $2 +# ori _letBind_2_,$2,0 + ori $3, $2, 0 +# was: ori _plus_L_6_, _letBind_2_, 0 + ori $2, $0, 2 +# was: ori _plus_R_7_, $0, 2 + add $2, $3, $2 +# was: add _mult1_L_4_, _plus_L_6_, _plus_R_7_ + ori $3, $0, 0 +# was: ori _mult2_R_5_, $0, 0 + mul $16, $2, $3 +# was: mul _letBind_3_, _mult1_L_4_, _mult2_R_5_ +# ori _tmp_8_,_letBind_3_,0 +# ori _mainres_1_,_tmp_8_,0 + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + jal putint +# was: jal putint, $2 + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + addi $29, $29, 12 + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/copyConstPropFold0.fo b/fasto/tests/copyConstPropFold0.fo new file mode 100644 index 0000000..541e83d --- /dev/null +++ b/fasto/tests/copyConstPropFold0.fo @@ -0,0 +1,9 @@ +fun int f(int x, int y) = + (x + 2) * (y - 2) + +fun int main() = + let a = read(int) in + let b = let x = a in + let y = 2 in + (x + 2) * (y - 2) + in write(b) diff --git a/fasto/tests/copyConstPropFold0.in b/fasto/tests/copyConstPropFold0.in new file mode 100644 index 0000000..b8626c4 --- /dev/null +++ b/fasto/tests/copyConstPropFold0.in @@ -0,0 +1 @@ +4 diff --git a/fasto/tests/copyConstPropFold0.out b/fasto/tests/copyConstPropFold0.out new file mode 100644 index 0000000..573541a --- /dev/null +++ b/fasto/tests/copyConstPropFold0.out @@ -0,0 +1 @@ +0 diff --git a/fasto/tests/copyConstPropFold1.asm b/fasto/tests/copyConstPropFold1.asm new file mode 100644 index 0000000..ba901c5 --- /dev/null +++ b/fasto/tests/copyConstPropFold1.asm @@ -0,0 +1,220 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $16, -8($29) + addi $29, $29, -12 + ori $3, $0, 40 +# was: ori _size_reg_3_, $0, 40 + bgez $3, _safe_lab_4_ +# was: bgez _size_reg_3_, _safe_lab_4_ + ori $5, $0, 3 +# was: ori $5, $0, 3 + la $6, _Msg_IllegalArraySize_ +# was: la $6, _Msg_IllegalArraySize_ + j _RuntimeError_ +_safe_lab_4_: + ori $2, $28, 0 +# was: ori _letBind_2_, $28, 0 + sll $4, $3, 2 +# was: sll _tmp_10_, _size_reg_3_, 2 + addi $4, $4, 4 +# was: addi _tmp_10_, _tmp_10_, 4 + add $28, $28, $4 +# was: add $28, $28, _tmp_10_ + sw $3, 0($2) +# was: sw _size_reg_3_, 0(_letBind_2_) + addi $6, $2, 4 +# was: addi _addr_reg_5_, _letBind_2_, 4 + ori $5, $0, 0 +# was: ori _i_reg_6_, $0, 0 +_loop_beg_7_: + sub $4, $5, $3 +# was: sub _tmp_reg_9_, _i_reg_6_, _size_reg_3_ + bgez $4, _loop_end_8_ +# was: bgez _tmp_reg_9_, _loop_end_8_ + sw $5, 0($6) +# was: sw _i_reg_6_, 0(_addr_reg_5_) + addi $6, $6, 4 +# was: addi _addr_reg_5_, _addr_reg_5_, 4 + addi $5, $5, 1 +# was: addi _i_reg_6_, _i_reg_6_, 1 + j _loop_beg_7_ +_loop_end_8_: + ori $4, $0, 4 +# was: ori _arr_ind_12_, $0, 4 + addi $3, $2, 4 +# was: addi _arr_reg_13_, _letBind_2_, 4 + lw $2, 0($2) +# was: lw _size_reg_14_, 0(_letBind_2_) + bgez $4, _safe_lab_17_ +# was: bgez _arr_ind_12_, _safe_lab_17_ +_error_lab_16_: + ori $5, $0, 5 +# was: ori $5, $0, 5 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_17_: + sub $2, $4, $2 +# was: sub _tmp_reg_15_, _arr_ind_12_, _size_reg_14_ + bgez $2, _error_lab_16_ +# was: bgez _tmp_reg_15_, _error_lab_16_ + sll $4, $4, 2 +# was: sll _arr_ind_12_, _arr_ind_12_, 2 + add $3, $3, $4 +# was: add _arr_reg_13_, _arr_reg_13_, _arr_ind_12_ + lw $16, 0($3) +# was: lw _letBind_11_, 0(_arr_reg_13_) +# ori _tmp_18_,_letBind_11_,0 +# ori _mainres_1_,_tmp_18_,0 + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + jal putint +# was: jal putint, $2 + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + addi $29, $29, 12 + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/copyConstPropFold1.fo b/fasto/tests/copyConstPropFold1.fo new file mode 100644 index 0000000..eb70057 --- /dev/null +++ b/fasto/tests/copyConstPropFold1.fo @@ -0,0 +1,6 @@ +fun int main() = + let length = 40 in + let array = iota(length) in + let index = length / 10 in + let x = array[index] in + write(x * 1 + 0) diff --git a/fasto/tests/copyConstPropFold1.in b/fasto/tests/copyConstPropFold1.in new file mode 100644 index 0000000..e69de29 diff --git a/fasto/tests/copyConstPropFold1.out b/fasto/tests/copyConstPropFold1.out new file mode 100644 index 0000000..b8626c4 --- /dev/null +++ b/fasto/tests/copyConstPropFold1.out @@ -0,0 +1 @@ +4 diff --git a/fasto/tests/dead_bnd_rem.asm b/fasto/tests/dead_bnd_rem.asm new file mode 100644 index 0000000..c90ad82 --- /dev/null +++ b/fasto/tests/dead_bnd_rem.asm @@ -0,0 +1,175 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $16, -8($29) + addi $29, $29, -12 + jal getint +# was: jal getint, $2 +# ori _letBind_2_,$2,0 +# ori _plus_L_4_,_letBind_2_,0 + ori $3, $0, 2 +# was: ori _plus_R_5_, $0, 2 + add $3, $2, $3 +# was: add _letBind_3_, _plus_L_4_, _plus_R_5_ +# ori _plus_L_7_,_letBind_2_,0 + ori $4, $0, 3 +# was: ori _plus_R_8_, $0, 3 + add $2, $2, $4 +# was: add _letBind_6_, _plus_L_7_, _plus_R_8_ +# ori _mult1_L_10_,_letBind_3_,0 +# ori _mult2_R_11_,_letBind_6_,0 + mul $16, $3, $2 +# was: mul _letBind_9_, _mult1_L_10_, _mult2_R_11_ +# ori _tmp_12_,_letBind_9_,0 +# ori _mainres_1_,_tmp_12_,0 + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + jal putint +# was: jal putint, $2 + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + addi $29, $29, 12 + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/dead_bnd_rem.fo b/fasto/tests/dead_bnd_rem.fo new file mode 100644 index 0000000..0c9889b --- /dev/null +++ b/fasto/tests/dead_bnd_rem.fo @@ -0,0 +1,16 @@ +fun int main() = + let y = read(int) in + let x = y * y in + let z = + let x = + let x = x + 3 in + let x = x + y + in x + 8 + in y + in + let x = y + 2 in + let w = x + 2 + z in + let v = + let y = y + 3 + in x * y + in write(v) diff --git a/fasto/tests/dead_bnd_rem.in b/fasto/tests/dead_bnd_rem.in new file mode 100644 index 0000000..f599e28 --- /dev/null +++ b/fasto/tests/dead_bnd_rem.in @@ -0,0 +1 @@ +10 diff --git a/fasto/tests/dead_bnd_rem.out b/fasto/tests/dead_bnd_rem.out new file mode 100644 index 0000000..91b629b --- /dev/null +++ b/fasto/tests/dead_bnd_rem.out @@ -0,0 +1 @@ +156 diff --git a/fasto/tests/fail_parse.err b/fasto/tests/fail_parse.err new file mode 100644 index 0000000..fefd496 --- /dev/null +++ b/fasto/tests/fail_parse.err @@ -0,0 +1 @@ +Parse error: Error at line 2, column 12 diff --git a/fasto/tests/fail_parse.fo b/fasto/tests/fail_parse.fo new file mode 100644 index 0000000..a8c2403 --- /dev/null +++ b/fasto/tests/fail_parse.fo @@ -0,0 +1,3 @@ +fun int main() = + let n = in + write(2) diff --git a/fasto/tests/fib.asm b/fasto/tests/fib.asm new file mode 100644 index 0000000..8d101cf --- /dev/null +++ b/fasto/tests/fib.asm @@ -0,0 +1,239 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function fibo +fibo: + sw $31, -4($29) + sw $17, -12($29) + sw $16, -8($29) + addi $29, $29, -16 + ori $16, $2, 0 +# was: ori _param_n_1_, $2, 0 +# ori _eq_L_7_,_param_n_1_,0 + ori $3, $0, 0 +# was: ori _eq_R_8_, $0, 0 + ori $2, $0, 0 +# was: ori _cond_6_, $0, 0 + bne $16, $3, _false_9_ +# was: bne _eq_L_7_, _eq_R_8_, _false_9_ + ori $2, $0, 1 +# was: ori _cond_6_, $0, 1 +_false_9_: + bne $2, $0, _then_3_ +# was: bne _cond_6_, $0, _then_3_ + j _else_4_ +_then_3_: + ori $2, $0, 0 +# was: ori _fibores_2_, $0, 0 + j _endif_5_ +_else_4_: +# ori _eq_L_14_,_param_n_1_,0 + ori $3, $0, 1 +# was: ori _eq_R_15_, $0, 1 + ori $2, $0, 0 +# was: ori _cond_13_, $0, 0 + bne $16, $3, _false_16_ +# was: bne _eq_L_14_, _eq_R_15_, _false_16_ + ori $2, $0, 1 +# was: ori _cond_13_, $0, 1 +_false_16_: + bne $2, $0, _then_10_ +# was: bne _cond_13_, $0, _then_10_ + j _else_11_ +_then_10_: + ori $2, $0, 1 +# was: ori _fibores_2_, $0, 1 + j _endif_12_ +_else_11_: +# ori _minus_L_20_,_param_n_1_,0 + ori $2, $0, 1 +# was: ori _minus_R_21_, $0, 1 + sub $2, $16, $2 +# was: sub _arg_19_, _minus_L_20_, _minus_R_21_ +# ori $2,_arg_19_,0 + jal fibo +# was: jal fibo, $2 + ori $17, $2, 0 +# was: ori _plus_L_17_, $2, 0 +# ori _minus_L_23_,_param_n_1_,0 + ori $2, $0, 2 +# was: ori _minus_R_24_, $0, 2 + sub $2, $16, $2 +# was: sub _arg_22_, _minus_L_23_, _minus_R_24_ +# ori $2,_arg_22_,0 + jal fibo +# was: jal fibo, $2 +# ori _plus_R_18_,$2,0 + add $2, $17, $2 +# was: add _fibores_2_, _plus_L_17_, _plus_R_18_ +_endif_12_: +_endif_5_: +# ori $2,_fibores_2_,0 + addi $29, $29, 16 + lw $17, -12($29) + lw $16, -8($29) + lw $31, -4($29) + jr $31 +# Function main +main: + sw $31, -4($29) + sw $16, -8($29) + addi $29, $29, -12 + jal getint +# was: jal getint, $2 +# ori _letBind_26_,$2,0 +# ori _arg_28_,_letBind_26_,0 +# ori $2,_arg_28_,0 + jal fibo +# was: jal fibo, $2 +# ori _tmp_27_,$2,0 + ori $16, $2, 0 +# was: ori _mainres_25_, _tmp_27_, 0 + ori $2, $16, 0 +# was: ori $2, _mainres_25_, 0 + jal putint +# was: jal putint, $2 + ori $2, $16, 0 +# was: ori $2, _mainres_25_, 0 + addi $29, $29, 12 + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/fib.fo b/fasto/tests/fib.fo new file mode 100644 index 0000000..a84afb3 --- /dev/null +++ b/fasto/tests/fib.fo @@ -0,0 +1,8 @@ +fun int fibo(int n) = + if n == 0 then 0 + else if n == 1 then 1 + else fibo(n - 1) + fibo(n - 2) + +fun int main() = + let n = read(int) in + write(fibo(n)) diff --git a/fasto/tests/fib.in b/fasto/tests/fib.in new file mode 100644 index 0000000..f599e28 --- /dev/null +++ b/fasto/tests/fib.in @@ -0,0 +1 @@ +10 diff --git a/fasto/tests/fib.out b/fasto/tests/fib.out new file mode 100644 index 0000000..f1daf02 --- /dev/null +++ b/fasto/tests/fib.out @@ -0,0 +1 @@ +55 diff --git a/fasto/tests/filter-on-2darr.asm b/fasto/tests/filter-on-2darr.asm new file mode 100644 index 0000000..a19d18c --- /dev/null +++ b/fasto/tests/filter-on-2darr.asm @@ -0,0 +1,474 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $25, -48($29) + sw $24, -44($29) + sw $23, -40($29) + sw $22, -36($29) + sw $21, -32($29) + sw $20, -28($29) + sw $19, -24($29) + sw $18, -20($29) + sw $17, -16($29) + sw $16, -12($29) + addi $29, $29, -52 + sw $2, 0($29) +# was: sw _fun_arg_res_84_, 0($29) + jal getint +# was: jal getint, $2 +# ori _letBind_2_,$2,0 + ori $3, $2, 0 +# was: ori _size_reg_8_, _letBind_2_, 0 + bgez $3, _safe_lab_9_ +# was: bgez _size_reg_8_, _safe_lab_9_ + ori $5, $0, 11 +# was: ori $5, $0, 11 + la $6, _Msg_IllegalArraySize_ +# was: la $6, _Msg_IllegalArraySize_ + j _RuntimeError_ +_safe_lab_9_: + ori $2, $28, 0 +# was: ori _arr_reg_5_, $28, 0 + sll $4, $3, 2 +# was: sll _tmp_15_, _size_reg_8_, 2 + addi $4, $4, 4 +# was: addi _tmp_15_, _tmp_15_, 4 + add $28, $28, $4 +# was: add $28, $28, _tmp_15_ + sw $3, 0($2) +# was: sw _size_reg_8_, 0(_arr_reg_5_) + addi $4, $2, 4 +# was: addi _addr_reg_10_, _arr_reg_5_, 4 + ori $5, $0, 0 +# was: ori _i_reg_11_, $0, 0 +_loop_beg_12_: + sub $6, $5, $3 +# was: sub _tmp_reg_14_, _i_reg_11_, _size_reg_8_ + bgez $6, _loop_end_13_ +# was: bgez _tmp_reg_14_, _loop_end_13_ + sw $5, 0($4) +# was: sw _i_reg_11_, 0(_addr_reg_10_) + addi $4, $4, 4 +# was: addi _addr_reg_10_, _addr_reg_10_, 4 + addi $5, $5, 1 +# was: addi _i_reg_11_, _i_reg_11_, 1 + j _loop_beg_12_ +_loop_end_13_: + lw $5, 0($2) +# was: lw _size_reg_4_, 0(_arr_reg_5_) + ori $4, $28, 0 +# was: ori _letBind_3_, $28, 0 + sll $3, $5, 2 +# was: sll _tmp_32_, _size_reg_4_, 2 + addi $3, $3, 4 +# was: addi _tmp_32_, _tmp_32_, 4 + add $28, $28, $3 +# was: add $28, $28, _tmp_32_ + sw $5, 0($4) +# was: sw _size_reg_4_, 0(_letBind_3_) + addi $6, $4, 4 +# was: addi _addr_reg_16_, _letBind_3_, 4 + ori $7, $0, 0 +# was: ori _i_reg_17_, $0, 0 + addi $3, $2, 4 +# was: addi _elem_reg_6_, _arr_reg_5_, 4 +_loop_beg_18_: + sub $2, $7, $5 +# was: sub _tmp_reg_20_, _i_reg_17_, _size_reg_4_ + bgez $2, _loop_end_19_ +# was: bgez _tmp_reg_20_, _loop_end_19_ + lw $8, 0($3) +# was: lw _res_reg_7_, 0(_elem_reg_6_) + addi $3, $3, 4 +# was: addi _elem_reg_6_, _elem_reg_6_, 4 +# ori _plus_L_23_,_res_reg_7_,0 + ori $2, $0, 2 +# was: ori _plus_R_24_, $0, 2 + add $2, $8, $2 +# was: add _size_reg_22_, _plus_L_23_, _plus_R_24_ + bgez $2, _safe_lab_25_ +# was: bgez _size_reg_22_, _safe_lab_25_ + ori $5, $0, 10 +# was: ori $5, $0, 10 + la $6, _Msg_IllegalArraySize_ +# was: la $6, _Msg_IllegalArraySize_ + j _RuntimeError_ +_safe_lab_25_: + ori $8, $28, 0 +# was: ori _fun_arg_res_21_, $28, 0 + sll $9, $2, 2 +# was: sll _tmp_31_, _size_reg_22_, 2 + addi $9, $9, 4 +# was: addi _tmp_31_, _tmp_31_, 4 + add $28, $28, $9 +# was: add $28, $28, _tmp_31_ + sw $2, 0($8) +# was: sw _size_reg_22_, 0(_fun_arg_res_21_) + addi $10, $8, 4 +# was: addi _addr_reg_26_, _fun_arg_res_21_, 4 + ori $9, $0, 0 +# was: ori _i_reg_27_, $0, 0 +_loop_beg_28_: + sub $11, $9, $2 +# was: sub _tmp_reg_30_, _i_reg_27_, _size_reg_22_ + bgez $11, _loop_end_29_ +# was: bgez _tmp_reg_30_, _loop_end_29_ + sw $9, 0($10) +# was: sw _i_reg_27_, 0(_addr_reg_26_) + addi $10, $10, 4 +# was: addi _addr_reg_26_, _addr_reg_26_, 4 + addi $9, $9, 1 +# was: addi _i_reg_27_, _i_reg_27_, 1 + j _loop_beg_28_ +_loop_end_29_: +# ori _res_reg_7_,_fun_arg_res_21_,0 + sw $8, 0($6) +# was: sw _res_reg_7_, 0(_addr_reg_16_) + addi $6, $6, 4 +# was: addi _addr_reg_16_, _addr_reg_16_, 4 + addi $7, $7, 1 +# was: addi _i_reg_17_, _i_reg_17_, 1 + j _loop_beg_18_ +_loop_end_19_: + ori $3, $4, 0 +# was: ori _arr_reg_35_, _letBind_3_, 0 + lw $2, 0($3) +# was: lw _size_reg_34_, 0(_arr_reg_35_) + ori $4, $28, 0 +# was: ori _letBind_33_, $28, 0 + sll $5, $2, 2 +# was: sll _tmp_64_, _size_reg_34_, 2 + addi $5, $5, 4 +# was: addi _tmp_64_, _tmp_64_, 4 + add $28, $28, $5 +# was: add $28, $28, _tmp_64_ + sw $2, 0($4) +# was: sw _size_reg_34_, 0(_letBind_33_) + addi $6, $4, 4 +# was: addi _addr_reg_39_, _letBind_33_, 4 + addi $3, $3, 4 +# was: addi _arr_reg_35_, _arr_reg_35_, 4 + ori $5, $0, 0 +# was: ori _i_reg_40_, $0, 0 + ori $7, $0, 0 +# was: ori _count_reg_38_, $0, 0 +_loop_beg_41_: + sub $8, $5, $2 +# was: sub _tmp_reg_44_, _i_reg_40_, _size_reg_34_ + bgez $8, _loop_end_42_ +# was: bgez _tmp_reg_44_, _loop_end_42_ + lw $8, 0($3) +# was: lw _elem_reg_36_, 0(_arr_reg_35_) + addi $3, $3, 4 +# was: addi _arr_reg_35_, _arr_reg_35_, 4 + ori $10, $8, 0 +# was: ori _arr_reg_47_, _elem_reg_36_, 0 + lw $11, 0($10) +# was: lw _size_reg_48_, 0(_arr_reg_47_) + ori $13, $0, 0 +# was: ori _letBind_46_, $0, 0 + addi $10, $10, 4 +# was: addi _arr_reg_47_, _arr_reg_47_, 4 + ori $9, $0, 0 +# was: ori _ind_var_49_, $0, 0 +_loop_beg_51_: + sub $12, $9, $11 +# was: sub _tmp_reg_50_, _ind_var_49_, _size_reg_48_ + bgez $12, _loop_end_52_ +# was: bgez _tmp_reg_50_, _loop_end_52_ + lw $12, 0($10) +# was: lw _tmp_reg_50_, 0(_arr_reg_47_) + addi $10, $10, 4 +# was: addi _arr_reg_47_, _arr_reg_47_, 4 +# ori _plus_L_54_,_letBind_46_,0 +# ori _plus_R_55_,_tmp_reg_50_,0 + add $13, $13, $12 +# was: add _fun_arg_res_53_, _plus_L_54_, _plus_R_55_ +# ori _letBind_46_,_fun_arg_res_53_,0 + addi $9, $9, 1 +# was: addi _ind_var_49_, _ind_var_49_, 1 + j _loop_beg_51_ +_loop_end_52_: +# ori _div1_L_60_,_letBind_46_,0 + ori $9, $0, 2 +# was: ori _div2_R_61_, $0, 2 + bne $9, $0, _safe_div_62_ +# was: bne _div2_R_61_, $0, _safe_div_62_ + ori $5, $0, 6 +# was: ori $5, $0, 6 + la $6, _Msg_DivZero_ +# was: la $6, _Msg_DivZero_ + j _RuntimeError_ +_safe_div_62_: + div $10, $13, $9 +# was: div _mult1_L_58_, _div1_L_60_, _div2_R_61_ + ori $9, $0, 2 +# was: ori _mult2_R_59_, $0, 2 + mul $9, $10, $9 +# was: mul _eq_L_56_, _mult1_L_58_, _mult2_R_59_ +# ori _eq_R_57_,_letBind_46_,0 + ori $10, $0, 0 +# was: ori _fun_arg_res_45_, $0, 0 + bne $9, $13, _false_63_ +# was: bne _eq_L_56_, _eq_R_57_, _false_63_ + ori $10, $0, 1 +# was: ori _fun_arg_res_45_, $0, 1 +_false_63_: +# ori _bool_reg_37_,_fun_arg_res_45_,0 + beq $10, $0, _if_end_43_ +# was: beq _bool_reg_37_, $0, _if_end_43_ + sw $8, 0($6) +# was: sw _elem_reg_36_, 0(_addr_reg_39_) + addi $6, $6, 4 +# was: addi _addr_reg_39_, _addr_reg_39_, 4 + addi $7, $7, 1 +# was: addi _count_reg_38_, _count_reg_38_, 1 +_if_end_43_: + addi $5, $5, 1 +# was: addi _i_reg_40_, _i_reg_40_, 1 + j _loop_beg_41_ +_loop_end_42_: + sw $7, 0($4) +# was: sw _count_reg_38_, 0(_letBind_33_) +# ori _arr_reg_66_,_letBind_33_,0 + lw $17, 0($4) +# was: lw _size_reg_65_, 0(_arr_reg_66_) + ori $16, $28, 0 +# was: ori _mainres_1_, $28, 0 + sll $2, $17, 2 +# was: sll _tmp_87_, _size_reg_65_, 2 + addi $2, $2, 4 +# was: addi _tmp_87_, _tmp_87_, 4 + add $28, $28, $2 +# was: add $28, $28, _tmp_87_ + sw $17, 0($16) +# was: sw _size_reg_65_, 0(_mainres_1_) + addi $19, $16, 4 +# was: addi _addr_reg_69_, _mainres_1_, 4 + ori $18, $0, 0 +# was: ori _i_reg_70_, $0, 0 + addi $20, $4, 4 +# was: addi _elem_reg_67_, _arr_reg_66_, 4 +_loop_beg_71_: + sub $2, $18, $17 +# was: sub _tmp_reg_73_, _i_reg_70_, _size_reg_65_ + bgez $2, _loop_end_72_ +# was: bgez _tmp_reg_73_, _loop_end_72_ + lw $2, 0($20) +# was: lw _res_reg_68_, 0(_elem_reg_67_) + addi $20, $20, 4 +# was: addi _elem_reg_67_, _elem_reg_67_, 4 +# ori _arr_reg_76_,_res_reg_68_,0 + lw $22, 0($2) +# was: lw _size_reg_75_, 0(_arr_reg_76_) + ori $21, $28, 0 +# was: ori _fun_arg_res_74_, $28, 0 + sll $3, $22, 2 +# was: sll _tmp_86_, _size_reg_75_, 2 + addi $3, $3, 4 +# was: addi _tmp_86_, _tmp_86_, 4 + add $28, $28, $3 +# was: add $28, $28, _tmp_86_ + sw $22, 0($21) +# was: sw _size_reg_75_, 0(_fun_arg_res_74_) + addi $23, $21, 4 +# was: addi _addr_reg_79_, _fun_arg_res_74_, 4 + ori $24, $0, 0 +# was: ori _i_reg_80_, $0, 0 + addi $25, $2, 4 +# was: addi _elem_reg_77_, _arr_reg_76_, 4 +_loop_beg_81_: + sub $2, $24, $22 +# was: sub _tmp_reg_83_, _i_reg_80_, _size_reg_75_ + bgez $2, _loop_end_82_ +# was: bgez _tmp_reg_83_, _loop_end_82_ + lw $2, 0($25) +# was: lw _res_reg_78_, 0(_elem_reg_77_) + addi $25, $25, 4 +# was: addi _elem_reg_77_, _elem_reg_77_, 4 +# ori _tmp_85_,_res_reg_78_,0 +# ori _fun_arg_res_84_,_tmp_85_,0 + sw $2, 0($29) +# was: sw _fun_arg_res_84_, 0($29) + lw $2, 0($29) +# was: lw _fun_arg_res_84_, 0($29) +# ori $2,_fun_arg_res_84_,0 + jal putint +# was: jal putint, $2 + lw $2, 0($29) +# was: lw _fun_arg_res_84_, 0($29) +# ori _res_reg_78_,_fun_arg_res_84_,0 + sw $2, 0($23) +# was: sw _res_reg_78_, 0(_addr_reg_79_) + addi $23, $23, 4 +# was: addi _addr_reg_79_, _addr_reg_79_, 4 + addi $24, $24, 1 +# was: addi _i_reg_80_, _i_reg_80_, 1 + j _loop_beg_81_ +_loop_end_82_: + ori $2, $21, 0 +# was: ori _res_reg_68_, _fun_arg_res_74_, 0 + sw $2, 0($19) +# was: sw _res_reg_68_, 0(_addr_reg_69_) + addi $19, $19, 4 +# was: addi _addr_reg_69_, _addr_reg_69_, 4 + addi $18, $18, 1 +# was: addi _i_reg_70_, _i_reg_70_, 1 + j _loop_beg_71_ +_loop_end_72_: + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + addi $29, $29, 52 + lw $25, -48($29) + lw $24, -44($29) + lw $23, -40($29) + lw $22, -36($29) + lw $21, -32($29) + lw $20, -28($29) + lw $19, -24($29) + lw $18, -20($29) + lw $17, -16($29) + lw $16, -12($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/filter-on-2darr.fo b/fasto/tests/filter-on-2darr.fo new file mode 100644 index 0000000..e257ed9 --- /dev/null +++ b/fasto/tests/filter-on-2darr.fo @@ -0,0 +1,17 @@ +fun int write_int(int x) = write(x) +fun [int] write_1darr( [int] x) = map(write_int , x) +fun [[int]] write_2darr([[int]] x) = map(write_1darr, x) + +fun bool even(int a) = + (a / 2) * 2 == a + +fun [[int]] main() = + let n = read(int) in + let a2d = map( fn [int] (int i) => iota(i+2) + , iota(n)) in + let a2df= filter(fn bool ([int] a) => + let r = reduce(op +, 0, a) + in even(r) + , a2d) + in write_2darr(a2df) + diff --git a/fasto/tests/filter-on-2darr.in b/fasto/tests/filter-on-2darr.in new file mode 100644 index 0000000..7ed6ff8 --- /dev/null +++ b/fasto/tests/filter-on-2darr.in @@ -0,0 +1 @@ +5 diff --git a/fasto/tests/filter-on-2darr.out b/fasto/tests/filter-on-2darr.out new file mode 100644 index 0000000..f9a4136 --- /dev/null +++ b/fasto/tests/filter-on-2darr.out @@ -0,0 +1,2 @@ +0 1 2 3 0 1 2 3 4 + diff --git a/fasto/tests/filter.asm b/fasto/tests/filter.asm new file mode 100644 index 0000000..a823eea --- /dev/null +++ b/fasto/tests/filter.asm @@ -0,0 +1,431 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $21, -28($29) + sw $20, -24($29) + sw $19, -20($29) + sw $18, -16($29) + sw $17, -12($29) + sw $16, -8($29) + addi $29, $29, -32 + jal getint +# was: jal getint, $2 +# ori _letBind_2_,$2,0 + ori $3, $2, 0 +# was: ori _size_reg_9_, _letBind_2_, 0 + bgez $3, _safe_lab_10_ +# was: bgez _size_reg_9_, _safe_lab_10_ + ori $5, $0, 10 +# was: ori $5, $0, 10 + la $6, _Msg_IllegalArraySize_ +# was: la $6, _Msg_IllegalArraySize_ + j _RuntimeError_ +_safe_lab_10_: + ori $2, $28, 0 +# was: ori _arr_reg_5_, $28, 0 + sll $4, $3, 2 +# was: sll _tmp_16_, _size_reg_9_, 2 + addi $4, $4, 4 +# was: addi _tmp_16_, _tmp_16_, 4 + add $28, $28, $4 +# was: add $28, $28, _tmp_16_ + sw $3, 0($2) +# was: sw _size_reg_9_, 0(_arr_reg_5_) + addi $5, $2, 4 +# was: addi _addr_reg_11_, _arr_reg_5_, 4 + ori $6, $0, 0 +# was: ori _i_reg_12_, $0, 0 +_loop_beg_13_: + sub $4, $6, $3 +# was: sub _tmp_reg_15_, _i_reg_12_, _size_reg_9_ + bgez $4, _loop_end_14_ +# was: bgez _tmp_reg_15_, _loop_end_14_ + sw $6, 0($5) +# was: sw _i_reg_12_, 0(_addr_reg_11_) + addi $5, $5, 4 +# was: addi _addr_reg_11_, _addr_reg_11_, 4 + addi $6, $6, 1 +# was: addi _i_reg_12_, _i_reg_12_, 1 + j _loop_beg_13_ +_loop_end_14_: + lw $5, 0($2) +# was: lw _size_reg_4_, 0(_arr_reg_5_) + ori $6, $28, 0 +# was: ori _letBind_3_, $28, 0 + sll $3, $5, 2 +# was: sll _tmp_32_, _size_reg_4_, 2 + addi $3, $3, 4 +# was: addi _tmp_32_, _tmp_32_, 4 + add $28, $28, $3 +# was: add $28, $28, _tmp_32_ + sw $5, 0($6) +# was: sw _size_reg_4_, 0(_letBind_3_) + addi $3, $6, 4 +# was: addi _addr_reg_17_, _letBind_3_, 4 + addi $2, $2, 4 +# was: addi _arr_reg_5_, _arr_reg_5_, 4 + ori $4, $0, 0 +# was: ori _i_reg_18_, $0, 0 + ori $7, $0, 0 +# was: ori _count_reg_8_, $0, 0 +_loop_beg_19_: + sub $8, $4, $5 +# was: sub _tmp_reg_22_, _i_reg_18_, _size_reg_4_ + bgez $8, _loop_end_20_ +# was: bgez _tmp_reg_22_, _loop_end_20_ + lw $10, 0($2) +# was: lw _elem_reg_6_, 0(_arr_reg_5_) + addi $2, $2, 4 +# was: addi _arr_reg_5_, _arr_reg_5_, 4 +# ori _eq_L_24_,_elem_reg_6_,0 + ori $9, $10, 0 +# was: ori _div1_L_28_, _elem_reg_6_, 0 + ori $8, $0, 2 +# was: ori _div2_R_29_, $0, 2 + bne $8, $0, _safe_div_30_ +# was: bne _div2_R_29_, $0, _safe_div_30_ + ori $5, $0, 10 +# was: ori $5, $0, 10 + la $6, _Msg_DivZero_ +# was: la $6, _Msg_DivZero_ + j _RuntimeError_ +_safe_div_30_: + div $8, $9, $8 +# was: div _mult1_L_26_, _div1_L_28_, _div2_R_29_ + ori $9, $0, 2 +# was: ori _mult2_R_27_, $0, 2 + mul $8, $8, $9 +# was: mul _eq_R_25_, _mult1_L_26_, _mult2_R_27_ + ori $9, $0, 0 +# was: ori _fun_arg_res_23_, $0, 0 + bne $10, $8, _false_31_ +# was: bne _eq_L_24_, _eq_R_25_, _false_31_ + ori $9, $0, 1 +# was: ori _fun_arg_res_23_, $0, 1 +_false_31_: +# ori _bool_reg_7_,_fun_arg_res_23_,0 + beq $9, $0, _if_end_21_ +# was: beq _bool_reg_7_, $0, _if_end_21_ + sw $10, 0($3) +# was: sw _elem_reg_6_, 0(_addr_reg_17_) + addi $3, $3, 4 +# was: addi _addr_reg_17_, _addr_reg_17_, 4 + addi $7, $7, 1 +# was: addi _count_reg_8_, _count_reg_8_, 1 +_if_end_21_: + addi $4, $4, 1 +# was: addi _i_reg_18_, _i_reg_18_, 1 + j _loop_beg_19_ +_loop_end_20_: + sw $7, 0($6) +# was: sw _count_reg_8_, 0(_letBind_3_) + ori $2, $6, 0 +# was: ori _arr_reg_35_, _letBind_3_, 0 + lw $3, 0($2) +# was: lw _size_reg_34_, 0(_arr_reg_35_) + ori $4, $28, 0 +# was: ori _letBind_33_, $28, 0 + sll $5, $3, 2 +# was: sll _tmp_46_, _size_reg_34_, 2 + addi $5, $5, 4 +# was: addi _tmp_46_, _tmp_46_, 4 + add $28, $28, $5 +# was: add $28, $28, _tmp_46_ + sw $3, 0($4) +# was: sw _size_reg_34_, 0(_letBind_33_) + addi $6, $4, 4 +# was: addi _addr_reg_38_, _letBind_33_, 4 + ori $5, $0, 0 +# was: ori _i_reg_39_, $0, 0 + addi $2, $2, 4 +# was: addi _elem_reg_36_, _arr_reg_35_, 4 +_loop_beg_40_: + sub $7, $5, $3 +# was: sub _tmp_reg_42_, _i_reg_39_, _size_reg_34_ + bgez $7, _loop_end_41_ +# was: bgez _tmp_reg_42_, _loop_end_41_ + lw $7, 0($2) +# was: lw _res_reg_37_, 0(_elem_reg_36_) + addi $2, $2, 4 +# was: addi _elem_reg_36_, _elem_reg_36_, 4 + ori $8, $7, 0 +# was: ori _mult1_L_44_, _res_reg_37_, 0 +# ori _mult2_R_45_,_res_reg_37_,0 + mul $7, $8, $7 +# was: mul _fun_arg_res_43_, _mult1_L_44_, _mult2_R_45_ +# ori _res_reg_37_,_fun_arg_res_43_,0 + sw $7, 0($6) +# was: sw _res_reg_37_, 0(_addr_reg_38_) + addi $6, $6, 4 +# was: addi _addr_reg_38_, _addr_reg_38_, 4 + addi $5, $5, 1 +# was: addi _i_reg_39_, _i_reg_39_, 1 + j _loop_beg_40_ +_loop_end_41_: + ori $2, $4, 0 +# was: ori _arr_reg_49_, _letBind_33_, 0 + lw $3, 0($2) +# was: lw _size_reg_48_, 0(_arr_reg_49_) + ori $4, $28, 0 +# was: ori _letBind_47_, $28, 0 + sll $5, $3, 2 +# was: sll _tmp_68_, _size_reg_48_, 2 + addi $5, $5, 4 +# was: addi _tmp_68_, _tmp_68_, 4 + add $28, $28, $5 +# was: add $28, $28, _tmp_68_ + sw $3, 0($4) +# was: sw _size_reg_48_, 0(_letBind_47_) + addi $5, $4, 4 +# was: addi _addr_reg_53_, _letBind_47_, 4 + addi $2, $2, 4 +# was: addi _arr_reg_49_, _arr_reg_49_, 4 + ori $6, $0, 0 +# was: ori _i_reg_54_, $0, 0 + ori $7, $0, 0 +# was: ori _count_reg_52_, $0, 0 +_loop_beg_55_: + sub $8, $6, $3 +# was: sub _tmp_reg_58_, _i_reg_54_, _size_reg_48_ + bgez $8, _loop_end_56_ +# was: bgez _tmp_reg_58_, _loop_end_56_ + lw $8, 0($2) +# was: lw _elem_reg_50_, 0(_arr_reg_49_) + addi $2, $2, 4 +# was: addi _arr_reg_49_, _arr_reg_49_, 4 +# ori _div1_L_64_,_elem_reg_50_,0 + ori $9, $0, 16 +# was: ori _div2_R_65_, $0, 16 + bne $9, $0, _safe_div_66_ +# was: bne _div2_R_65_, $0, _safe_div_66_ + ori $5, $0, 6 +# was: ori $5, $0, 6 + la $6, _Msg_DivZero_ +# was: la $6, _Msg_DivZero_ + j _RuntimeError_ +_safe_div_66_: + div $10, $8, $9 +# was: div _mult1_L_62_, _div1_L_64_, _div2_R_65_ + ori $9, $0, 16 +# was: ori _mult2_R_63_, $0, 16 + mul $10, $10, $9 +# was: mul _eq_L_60_, _mult1_L_62_, _mult2_R_63_ +# ori _eq_R_61_,_elem_reg_50_,0 + ori $9, $0, 0 +# was: ori _fun_arg_res_59_, $0, 0 + bne $10, $8, _false_67_ +# was: bne _eq_L_60_, _eq_R_61_, _false_67_ + ori $9, $0, 1 +# was: ori _fun_arg_res_59_, $0, 1 +_false_67_: +# ori _bool_reg_51_,_fun_arg_res_59_,0 + beq $9, $0, _if_end_57_ +# was: beq _bool_reg_51_, $0, _if_end_57_ + sw $8, 0($5) +# was: sw _elem_reg_50_, 0(_addr_reg_53_) + addi $5, $5, 4 +# was: addi _addr_reg_53_, _addr_reg_53_, 4 + addi $7, $7, 1 +# was: addi _count_reg_52_, _count_reg_52_, 1 +_if_end_57_: + addi $6, $6, 1 +# was: addi _i_reg_54_, _i_reg_54_, 1 + j _loop_beg_55_ +_loop_end_56_: + sw $7, 0($4) +# was: sw _count_reg_52_, 0(_letBind_47_) +# ori _arr_reg_70_,_letBind_47_,0 + lw $16, 0($4) +# was: lw _size_reg_69_, 0(_arr_reg_70_) + ori $17, $28, 0 +# was: ori _mainres_1_, $28, 0 + sll $2, $16, 2 +# was: sll _tmp_80_, _size_reg_69_, 2 + addi $2, $2, 4 +# was: addi _tmp_80_, _tmp_80_, 4 + add $28, $28, $2 +# was: add $28, $28, _tmp_80_ + sw $16, 0($17) +# was: sw _size_reg_69_, 0(_mainres_1_) + addi $18, $17, 4 +# was: addi _addr_reg_73_, _mainres_1_, 4 + ori $19, $0, 0 +# was: ori _i_reg_74_, $0, 0 + addi $20, $4, 4 +# was: addi _elem_reg_71_, _arr_reg_70_, 4 +_loop_beg_75_: + sub $2, $19, $16 +# was: sub _tmp_reg_77_, _i_reg_74_, _size_reg_69_ + bgez $2, _loop_end_76_ +# was: bgez _tmp_reg_77_, _loop_end_76_ + lw $21, 0($20) +# was: lw _res_reg_72_, 0(_elem_reg_71_) + addi $20, $20, 4 +# was: addi _elem_reg_71_, _elem_reg_71_, 4 +# ori _tmp_79_,_res_reg_72_,0 +# ori _fun_arg_res_78_,_tmp_79_,0 + ori $2, $21, 0 +# was: ori $2, _fun_arg_res_78_, 0 + jal putint +# was: jal putint, $2 +# ori _res_reg_72_,_fun_arg_res_78_,0 + sw $21, 0($18) +# was: sw _res_reg_72_, 0(_addr_reg_73_) + addi $18, $18, 4 +# was: addi _addr_reg_73_, _addr_reg_73_, 4 + addi $19, $19, 1 +# was: addi _i_reg_74_, _i_reg_74_, 1 + j _loop_beg_75_ +_loop_end_76_: + ori $2, $17, 0 +# was: ori $2, _mainres_1_, 0 + addi $29, $29, 32 + lw $21, -28($29) + lw $20, -24($29) + lw $19, -20($29) + lw $18, -16($29) + lw $17, -12($29) + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/filter.fo b/fasto/tests/filter.fo new file mode 100644 index 0000000..6e5f58f --- /dev/null +++ b/fasto/tests/filter.fo @@ -0,0 +1,13 @@ +fun int write_int(int x) = write(x) + +fun [int] write_int_arr([int] x) = map(write_int, x) + +fun bool isMul16(int a) = + (a / 16) * 16 == a + +fun [int] main() = + let n = read(int) in + let x = filter(fn bool (int a) => a == (a/2)*2, iota(n)) in + let y = map (fn int (int a) => a * a, x) in + let z = filter(isMul16, y) + in write_int_arr(z) diff --git a/fasto/tests/filter.in b/fasto/tests/filter.in new file mode 100644 index 0000000..60d3b2f --- /dev/null +++ b/fasto/tests/filter.in @@ -0,0 +1 @@ +15 diff --git a/fasto/tests/filter.out b/fasto/tests/filter.out new file mode 100644 index 0000000..25971fa --- /dev/null +++ b/fasto/tests/filter.out @@ -0,0 +1 @@ +0 16 64 144 diff --git a/fasto/tests/inline_map.asm b/fasto/tests/inline_map.asm new file mode 100644 index 0000000..a9e9741 --- /dev/null +++ b/fasto/tests/inline_map.asm @@ -0,0 +1,331 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $21, -28($29) + sw $20, -24($29) + sw $19, -20($29) + sw $18, -16($29) + sw $17, -12($29) + sw $16, -8($29) + addi $29, $29, -32 + jal getint +# was: jal getint, $2 +# ori _letBind_2_,$2,0 +# ori _size_reg_4_,_letBind_2_,0 + bgez $2, _safe_lab_5_ +# was: bgez _size_reg_4_, _safe_lab_5_ + ori $5, $0, 15 +# was: ori $5, $0, 15 + la $6, _Msg_IllegalArraySize_ +# was: la $6, _Msg_IllegalArraySize_ + j _RuntimeError_ +_safe_lab_5_: + ori $3, $28, 0 +# was: ori _letBind_3_, $28, 0 + sll $4, $2, 2 +# was: sll _tmp_11_, _size_reg_4_, 2 + addi $4, $4, 4 +# was: addi _tmp_11_, _tmp_11_, 4 + add $28, $28, $4 +# was: add $28, $28, _tmp_11_ + sw $2, 0($3) +# was: sw _size_reg_4_, 0(_letBind_3_) + addi $6, $3, 4 +# was: addi _addr_reg_6_, _letBind_3_, 4 + ori $5, $0, 0 +# was: ori _i_reg_7_, $0, 0 +_loop_beg_8_: + sub $4, $5, $2 +# was: sub _tmp_reg_10_, _i_reg_7_, _size_reg_4_ + bgez $4, _loop_end_9_ +# was: bgez _tmp_reg_10_, _loop_end_9_ + sw $5, 0($6) +# was: sw _i_reg_7_, 0(_addr_reg_6_) + addi $6, $6, 4 +# was: addi _addr_reg_6_, _addr_reg_6_, 4 + addi $5, $5, 1 +# was: addi _i_reg_7_, _i_reg_7_, 1 + j _loop_beg_8_ +_loop_end_9_: + ori $2, $3, 0 +# was: ori _arr_reg_14_, _letBind_3_, 0 + lw $4, 0($2) +# was: lw _size_reg_13_, 0(_arr_reg_14_) + ori $6, $28, 0 +# was: ori _letBind_12_, $28, 0 + sll $3, $4, 2 +# was: sll _tmp_25_, _size_reg_13_, 2 + addi $3, $3, 4 +# was: addi _tmp_25_, _tmp_25_, 4 + add $28, $28, $3 +# was: add $28, $28, _tmp_25_ + sw $4, 0($6) +# was: sw _size_reg_13_, 0(_letBind_12_) + addi $3, $6, 4 +# was: addi _addr_reg_17_, _letBind_12_, 4 + ori $5, $0, 0 +# was: ori _i_reg_18_, $0, 0 + addi $7, $2, 4 +# was: addi _elem_reg_15_, _arr_reg_14_, 4 +_loop_beg_19_: + sub $2, $5, $4 +# was: sub _tmp_reg_21_, _i_reg_18_, _size_reg_13_ + bgez $2, _loop_end_20_ +# was: bgez _tmp_reg_21_, _loop_end_20_ + lw $2, 0($7) +# was: lw _res_reg_16_, 0(_elem_reg_15_) + addi $7, $7, 4 +# was: addi _elem_reg_15_, _elem_reg_15_, 4 + ori $8, $2, 0 +# was: ori _plus_L_23_, _res_reg_16_, 0 + ori $2, $0, 5 +# was: ori _plus_R_24_, $0, 5 + add $2, $8, $2 +# was: add _fun_arg_res_22_, _plus_L_23_, _plus_R_24_ +# ori _res_reg_16_,_fun_arg_res_22_,0 + sw $2, 0($3) +# was: sw _res_reg_16_, 0(_addr_reg_17_) + addi $3, $3, 4 +# was: addi _addr_reg_17_, _addr_reg_17_, 4 + addi $5, $5, 1 +# was: addi _i_reg_18_, _i_reg_18_, 1 + j _loop_beg_19_ +_loop_end_20_: + ori $2, $6, 0 +# was: ori _arr_reg_28_, _letBind_12_, 0 + lw $4, 0($2) +# was: lw _size_reg_27_, 0(_arr_reg_28_) + ori $5, $28, 0 +# was: ori _letBind_26_, $28, 0 + sll $3, $4, 2 +# was: sll _tmp_39_, _size_reg_27_, 2 + addi $3, $3, 4 +# was: addi _tmp_39_, _tmp_39_, 4 + add $28, $28, $3 +# was: add $28, $28, _tmp_39_ + sw $4, 0($5) +# was: sw _size_reg_27_, 0(_letBind_26_) + addi $3, $5, 4 +# was: addi _addr_reg_31_, _letBind_26_, 4 + ori $6, $0, 0 +# was: ori _i_reg_32_, $0, 0 + addi $7, $2, 4 +# was: addi _elem_reg_29_, _arr_reg_28_, 4 +_loop_beg_33_: + sub $2, $6, $4 +# was: sub _tmp_reg_35_, _i_reg_32_, _size_reg_27_ + bgez $2, _loop_end_34_ +# was: bgez _tmp_reg_35_, _loop_end_34_ + lw $2, 0($7) +# was: lw _res_reg_30_, 0(_elem_reg_29_) + addi $7, $7, 4 +# was: addi _elem_reg_29_, _elem_reg_29_, 4 + ori $8, $2, 0 +# was: ori _plus_L_37_, _res_reg_30_, 0 +# ori _plus_R_38_,_res_reg_30_,0 + add $2, $8, $2 +# was: add _fun_arg_res_36_, _plus_L_37_, _plus_R_38_ +# ori _res_reg_30_,_fun_arg_res_36_,0 + sw $2, 0($3) +# was: sw _res_reg_30_, 0(_addr_reg_31_) + addi $3, $3, 4 +# was: addi _addr_reg_31_, _addr_reg_31_, 4 + addi $6, $6, 1 +# was: addi _i_reg_32_, _i_reg_32_, 1 + j _loop_beg_33_ +_loop_end_34_: +# ori _arr_reg_41_,_letBind_26_,0 + lw $16, 0($5) +# was: lw _size_reg_40_, 0(_arr_reg_41_) + ori $17, $28, 0 +# was: ori _mainres_1_, $28, 0 + sll $2, $16, 2 +# was: sll _tmp_51_, _size_reg_40_, 2 + addi $2, $2, 4 +# was: addi _tmp_51_, _tmp_51_, 4 + add $28, $28, $2 +# was: add $28, $28, _tmp_51_ + sw $16, 0($17) +# was: sw _size_reg_40_, 0(_mainres_1_) + addi $18, $17, 4 +# was: addi _addr_reg_44_, _mainres_1_, 4 + ori $19, $0, 0 +# was: ori _i_reg_45_, $0, 0 + addi $20, $5, 4 +# was: addi _elem_reg_42_, _arr_reg_41_, 4 +_loop_beg_46_: + sub $2, $19, $16 +# was: sub _tmp_reg_48_, _i_reg_45_, _size_reg_40_ + bgez $2, _loop_end_47_ +# was: bgez _tmp_reg_48_, _loop_end_47_ + lw $21, 0($20) +# was: lw _res_reg_43_, 0(_elem_reg_42_) + addi $20, $20, 4 +# was: addi _elem_reg_42_, _elem_reg_42_, 4 +# ori _tmp_50_,_res_reg_43_,0 +# ori _fun_arg_res_49_,_tmp_50_,0 + ori $2, $21, 0 +# was: ori $2, _fun_arg_res_49_, 0 + jal putint +# was: jal putint, $2 +# ori _res_reg_43_,_fun_arg_res_49_,0 + sw $21, 0($18) +# was: sw _res_reg_43_, 0(_addr_reg_44_) + addi $18, $18, 4 +# was: addi _addr_reg_44_, _addr_reg_44_, 4 + addi $19, $19, 1 +# was: addi _i_reg_45_, _i_reg_45_, 1 + j _loop_beg_46_ +_loop_end_47_: + ori $2, $17, 0 +# was: ori $2, _mainres_1_, 0 + addi $29, $29, 32 + lw $21, -28($29) + lw $20, -24($29) + lw $19, -20($29) + lw $18, -16($29) + lw $17, -12($29) + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/inline_map.fo b/fasto/tests/inline_map.fo new file mode 100644 index 0000000..272eb9a --- /dev/null +++ b/fasto/tests/inline_map.fo @@ -0,0 +1,19 @@ +fun int plus5(int x) = x + 5 + +fun int mul2(int x) = x + x + +fun [int] testcomp([int] x) = write_int_arr(write_int_arr(x)) + +fun int write_int(int x) = write(x) + +fun [int] write_int_arr([int] x) = map(write_int, x) + +fun [int] boo([int] a) = let x = (let y = 5 + 3 in map(plus5, a)) in x + +fun [int] main() = + let N = read(int) in + let z = iota(N) in + let q = (let z = N + N in N + N + N) in + let y = boo(z) in + let w = map(mul2, y) in + write_int_arr(w) diff --git a/fasto/tests/inline_map.in b/fasto/tests/inline_map.in new file mode 100644 index 0000000..e373ee6 --- /dev/null +++ b/fasto/tests/inline_map.in @@ -0,0 +1 @@ +50 diff --git a/fasto/tests/inline_map.out b/fasto/tests/inline_map.out new file mode 100644 index 0000000..b04d56c --- /dev/null +++ b/fasto/tests/inline_map.out @@ -0,0 +1 @@ +10 12 14 16 18 20 22 24 26 28 30 32 34 36 38 40 42 44 46 48 50 52 54 56 58 60 62 64 66 68 70 72 74 76 78 80 82 84 86 88 90 92 94 96 98 100 102 104 106 108 diff --git a/fasto/tests/inline_shadow.asm b/fasto/tests/inline_shadow.asm new file mode 100644 index 0000000..29cb61f --- /dev/null +++ b/fasto/tests/inline_shadow.asm @@ -0,0 +1,246 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function zero +zero: + sw $31, -4($29) + addi $29, $29, -8 +# ori _param_b_1_,$2,0 +# ori _cond_6_,_param_b_1_,0 + bne $2, $0, _then_3_ +# was: bne _cond_6_, $0, _then_3_ + j _else_4_ +_then_3_: + ori $2, $0, 0 +# was: ori _zerores_2_, $0, 0 + j _endif_5_ +_else_4_: +# ori _arg_7_,_param_b_1_,0 +# ori $2,_arg_7_,0 + jal zero +# was: jal zero, $2 +# ori _zerores_2_,$2,0 +_endif_5_: +# ori $2,_zerores_2_,0 + addi $29, $29, 8 + lw $31, -4($29) + jr $31 +# Function main +main: + sw $31, -4($29) + sw $17, -12($29) + sw $16, -8($29) + addi $29, $29, -16 + ori $16, $0, 4132 +# was: ori _tmp_10_, $0, 4132 +# ori _letBind_9_,_tmp_10_,0 + ori $2, $16, 0 +# was: ori $2, _letBind_9_, 0 + jal putint +# was: jal putint, $2 + ori $2, $0, 1 +# was: ori _arg_14_, $0, 1 +# ori $2,_arg_14_,0 + jal zero +# was: jal zero, $2 + ori $6, $2, 0 +# was: ori _letBind_13_, $2, 0 + ori $2, $0, 1 +# was: ori _plus_L_16_, $0, 1 +# ori _plus_R_17_,_letBind_13_,0 + add $4, $2, $6 +# was: add _letBind_15_, _plus_L_16_, _plus_R_17_ + ori $2, $0, 2 +# was: ori _plus_L_19_, $0, 2 +# ori _plus_R_20_,_letBind_13_,0 + add $2, $2, $6 +# was: add _letBind_18_, _plus_L_19_, _plus_R_20_ + ori $3, $0, 3 +# was: ori _plus_L_22_, $0, 3 +# ori _plus_R_23_,_letBind_13_,0 + add $3, $3, $6 +# was: add _letBind_21_, _plus_L_22_, _plus_R_23_ + ori $5, $0, 4 +# was: ori _plus_L_25_, $0, 4 +# ori _plus_R_26_,_letBind_13_,0 + add $6, $5, $6 +# was: add _letBind_24_, _plus_L_25_, _plus_R_26_ + ori $5, $0, 1000 +# was: ori _mult1_L_33_, $0, 1000 +# ori _mult2_R_34_,_letBind_24_,0 + mul $5, $5, $6 +# was: mul _plus_L_31_, _mult1_L_33_, _mult2_R_34_ + ori $6, $0, 100 +# was: ori _mult1_L_35_, $0, 100 +# ori _mult2_R_36_,_letBind_15_,0 + mul $4, $6, $4 +# was: mul _plus_R_32_, _mult1_L_35_, _mult2_R_36_ + add $5, $5, $4 +# was: add _plus_L_29_, _plus_L_31_, _plus_R_32_ + ori $4, $0, 10 +# was: ori _mult1_L_37_, $0, 10 +# ori _mult2_R_38_,_letBind_21_,0 + mul $3, $4, $3 +# was: mul _plus_R_30_, _mult1_L_37_, _mult2_R_38_ + add $3, $5, $3 +# was: add _plus_L_27_, _plus_L_29_, _plus_R_30_ +# ori _plus_R_28_,_letBind_18_,0 + add $17, $3, $2 +# was: add _tmp_12_, _plus_L_27_, _plus_R_28_ +# ori _letBind_11_,_tmp_12_,0 + ori $2, $17, 0 +# was: ori $2, _letBind_11_, 0 + jal putint +# was: jal putint, $2 + ori $2, $0, 10000 +# was: ori _mult1_L_41_, $0, 10000 +# ori _mult2_R_42_,_letBind_9_,0 + mul $2, $2, $16 +# was: mul _plus_L_39_, _mult1_L_41_, _mult2_R_42_ +# ori _plus_R_40_,_letBind_11_,0 + add $2, $2, $17 +# was: add _mainres_8_, _plus_L_39_, _plus_R_40_ +# ori $2,_mainres_8_,0 + addi $29, $29, 16 + lw $17, -12($29) + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/inline_shadow.fo b/fasto/tests/inline_shadow.fo new file mode 100644 index 0000000..af856ae --- /dev/null +++ b/fasto/tests/inline_shadow.fo @@ -0,0 +1,15 @@ +fun int f(int a, int b, int c, int d) = 1000*a + 100*b + 10*c + d + +fun int zero(bool b) = if b then 0 else zero(b) + +fun int test(int z) = + let a = 1+z in + let b = 2+z in + let c = 3+z in + let d = 4+z in + f(d,a,c,b) + +fun int main() = + let r1 = write(test(0)) in + let r2 = write(test(zero(true))) in + 10000*r1+r2 \ No newline at end of file diff --git a/fasto/tests/inline_shadow.in b/fasto/tests/inline_shadow.in new file mode 100644 index 0000000..e69de29 diff --git a/fasto/tests/inline_shadow.out b/fasto/tests/inline_shadow.out new file mode 100644 index 0000000..e8ef558 --- /dev/null +++ b/fasto/tests/inline_shadow.out @@ -0,0 +1,2 @@ +4132 +4132 diff --git a/fasto/tests/io_mssp.asm b/fasto/tests/io_mssp.asm new file mode 100644 index 0000000..c89ed87 --- /dev/null +++ b/fasto/tests/io_mssp.asm @@ -0,0 +1,897 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _aaMSSPa_193_ +# was: la _aaMSSPa_193__addr, _aaMSSPa_193_ + ori $3, $0, 18 +# was: ori _aaMSSPa_193__init, $0, 18 + sw $3, 0($4) +# was: sw _aaMSSPa_193__init, 0(_aaMSSPa_193__addr) + la $4, _a__str__33_ +# was: la _a__str__33__addr, _a__str__33_ + ori $3, $0, 1 +# was: ori _a__str__33__init, $0, 1 + sw $3, 0($4) +# was: sw _a__str__33__init, 0(_a__str__33__addr) + la $4, _aa__str_29_ +# was: la _aa__str_29__addr, _aa__str_29_ + ori $3, $0, 2 +# was: ori _aa__str_29__init, $0, 2 + sw $3, 0($4) +# was: sw _aa__str_29__init, 0(_aa__str_29__addr) + la $4, _Introdu_24_ +# was: la _Introdu_24__addr, _Introdu_24_ + ori $3, $0, 17 +# was: ori _Introdu_24__init, $0, 17 + sw $3, 0($4) +# was: sw _Introdu_24__init, 0(_Introdu_24__addr) + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $21, -28($29) + sw $20, -24($29) + sw $19, -20($29) + sw $18, -16($29) + sw $17, -12($29) + sw $16, -8($29) + addi $29, $29, -32 + ori $2, $0, 8 +# was: ori _size_reg_3_, $0, 8 + bgez $2, _safe_lab_4_ +# was: bgez _size_reg_3_, _safe_lab_4_ + ori $5, $0, 10 +# was: ori $5, $0, 10 + la $6, _Msg_IllegalArraySize_ +# was: la $6, _Msg_IllegalArraySize_ + j _RuntimeError_ +_safe_lab_4_: + ori $3, $28, 0 +# was: ori _letBind_2_, $28, 0 + sll $4, $2, 2 +# was: sll _tmp_10_, _size_reg_3_, 2 + addi $4, $4, 4 +# was: addi _tmp_10_, _tmp_10_, 4 + add $28, $28, $4 +# was: add $28, $28, _tmp_10_ + sw $2, 0($3) +# was: sw _size_reg_3_, 0(_letBind_2_) + addi $5, $3, 4 +# was: addi _addr_reg_5_, _letBind_2_, 4 + ori $6, $0, 0 +# was: ori _i_reg_6_, $0, 0 +_loop_beg_7_: + sub $4, $6, $2 +# was: sub _tmp_reg_9_, _i_reg_6_, _size_reg_3_ + bgez $4, _loop_end_8_ +# was: bgez _tmp_reg_9_, _loop_end_8_ + sw $6, 0($5) +# was: sw _i_reg_6_, 0(_addr_reg_5_) + addi $5, $5, 4 +# was: addi _addr_reg_5_, _addr_reg_5_, 4 + addi $6, $6, 1 +# was: addi _i_reg_6_, _i_reg_6_, 1 + j _loop_beg_7_ +_loop_end_8_: + ori $2, $3, 0 +# was: ori _arr_reg_13_, _letBind_2_, 0 + lw $16, 0($2) +# was: lw _size_reg_12_, 0(_arr_reg_13_) + ori $17, $28, 0 +# was: ori _letBind_11_, $28, 0 + sll $3, $16, 2 +# was: sll _tmp_34_, _size_reg_12_, 2 + addi $3, $3, 4 +# was: addi _tmp_34_, _tmp_34_, 4 + add $28, $28, $3 +# was: add $28, $28, _tmp_34_ + sw $16, 0($17) +# was: sw _size_reg_12_, 0(_letBind_11_) + addi $18, $17, 4 +# was: addi _addr_reg_16_, _letBind_11_, 4 + ori $19, $0, 0 +# was: ori _i_reg_17_, $0, 0 + addi $20, $2, 4 +# was: addi _elem_reg_14_, _arr_reg_13_, 4 +_loop_beg_18_: + sub $2, $19, $16 +# was: sub _tmp_reg_20_, _i_reg_17_, _size_reg_12_ + bgez $2, _loop_end_19_ +# was: bgez _tmp_reg_20_, _loop_end_19_ + lw $21, 0($20) +# was: lw _res_reg_15_, 0(_elem_reg_14_) + addi $20, $20, 4 +# was: addi _elem_reg_14_, _elem_reg_14_, 4 + la $2, _Introdu_24_ +# was: la _tmp_23_, _Introdu_24_ +# _Introdu_24_: string "Introduce number " +# ori _letBind_22_,_tmp_23_,0 +# ori $2,_tmp_23_,0 + jal putstring +# was: jal putstring, $2 + ori $2, $21, 0 +# was: ori _tmp_26_, _res_reg_15_, 0 +# ori _letBind_25_,_tmp_26_,0 +# ori $2,_letBind_25_,0 + jal putint +# was: jal putint, $2 + la $2, _aa__str_29_ +# was: la _tmp_28_, _aa__str_29_ +# _aa__str_29_: string ": " +# ori _letBind_27_,_tmp_28_,0 +# ori $2,_tmp_28_,0 + jal putstring +# was: jal putstring, $2 + jal getint +# was: jal getint, $2 + ori $21, $2, 0 +# was: ori _letBind_30_, $2, 0 + la $2, _a__str__33_ +# was: la _tmp_32_, _a__str__33_ +# _a__str__33_: string "\n" +# ori _letBind_31_,_tmp_32_,0 +# ori $2,_tmp_32_,0 + jal putstring +# was: jal putstring, $2 +# ori _fun_arg_res_21_,_letBind_30_,0 +# ori _res_reg_15_,_fun_arg_res_21_,0 + sw $21, 0($18) +# was: sw _res_reg_15_, 0(_addr_reg_16_) + addi $18, $18, 4 +# was: addi _addr_reg_16_, _addr_reg_16_, 4 + addi $19, $19, 1 +# was: addi _i_reg_17_, _i_reg_17_, 1 + j _loop_beg_18_ +_loop_end_19_: +# ori _arr_reg_37_,_letBind_11_,0 + lw $6, 0($17) +# was: lw _size_reg_36_, 0(_arr_reg_37_) + ori $5, $28, 0 +# was: ori _letBind_35_, $28, 0 + sll $2, $6, 2 +# was: sll _tmp_57_, _size_reg_36_, 2 + addi $2, $2, 4 +# was: addi _tmp_57_, _tmp_57_, 4 + add $28, $28, $2 +# was: add $28, $28, _tmp_57_ + sw $6, 0($5) +# was: sw _size_reg_36_, 0(_letBind_35_) + addi $8, $5, 4 +# was: addi _addr_reg_40_, _letBind_35_, 4 + ori $7, $0, 0 +# was: ori _i_reg_41_, $0, 0 + addi $9, $17, 4 +# was: addi _elem_reg_38_, _arr_reg_37_, 4 +_loop_beg_42_: + sub $2, $7, $6 +# was: sub _tmp_reg_44_, _i_reg_41_, _size_reg_36_ + bgez $2, _loop_end_43_ +# was: bgez _tmp_reg_44_, _loop_end_43_ + lw $10, 0($9) +# was: lw _res_reg_39_, 0(_elem_reg_38_) + addi $9, $9, 4 +# was: addi _elem_reg_38_, _elem_reg_38_, 4 +# ori _lt_L_51_,_res_reg_39_,0 + ori $2, $0, 0 +# was: ori _lt_R_52_, $0, 0 + slt $2, $10, $2 +# was: slt _cond_50_, _lt_L_51_, _lt_R_52_ + bne $2, $0, _then_47_ +# was: bne _cond_50_, $0, _then_47_ + j _else_48_ +_then_47_: + ori $4, $0, 0 +# was: ori _letBind_46_, $0, 0 + j _endif_49_ +_else_48_: + ori $4, $10, 0 +# was: ori _letBind_46_, _res_reg_39_, 0 +_endif_49_: + ori $11, $0, 4 +# was: ori _size_reg_53_, $0, 4 + ori $3, $28, 0 +# was: ori _fun_arg_res_45_, $28, 0 + sll $2, $11, 2 +# was: sll _tmp_56_, _size_reg_53_, 2 + addi $2, $2, 4 +# was: addi _tmp_56_, _tmp_56_, 4 + add $28, $28, $2 +# was: add $28, $28, _tmp_56_ + sw $11, 0($3) +# was: sw _size_reg_53_, 0(_fun_arg_res_45_) + addi $2, $3, 4 +# was: addi _addr_reg_54_, _fun_arg_res_45_, 4 +# ori _tmp_reg_55_,_letBind_46_,0 + sw $4, 0($2) +# was: sw _tmp_reg_55_, 0(_addr_reg_54_) + addi $2, $2, 4 +# was: addi _addr_reg_54_, _addr_reg_54_, 4 +# ori _tmp_reg_55_,_letBind_46_,0 + sw $4, 0($2) +# was: sw _tmp_reg_55_, 0(_addr_reg_54_) + addi $2, $2, 4 +# was: addi _addr_reg_54_, _addr_reg_54_, 4 +# ori _tmp_reg_55_,_letBind_46_,0 + sw $4, 0($2) +# was: sw _tmp_reg_55_, 0(_addr_reg_54_) + addi $2, $2, 4 +# was: addi _addr_reg_54_, _addr_reg_54_, 4 + ori $4, $10, 0 +# was: ori _tmp_reg_55_, _res_reg_39_, 0 + sw $4, 0($2) +# was: sw _tmp_reg_55_, 0(_addr_reg_54_) + addi $2, $2, 4 +# was: addi _addr_reg_54_, _addr_reg_54_, 4 + ori $10, $3, 0 +# was: ori _res_reg_39_, _fun_arg_res_45_, 0 + sw $10, 0($8) +# was: sw _res_reg_39_, 0(_addr_reg_40_) + addi $8, $8, 4 +# was: addi _addr_reg_40_, _addr_reg_40_, 4 + addi $7, $7, 1 +# was: addi _i_reg_41_, _i_reg_41_, 1 + j _loop_beg_42_ +_loop_end_43_: + ori $2, $0, 4 +# was: ori _size_reg_59_, $0, 4 + ori $16, $28, 0 +# was: ori _letBind_58_, $28, 0 + sll $3, $2, 2 +# was: sll _tmp_62_, _size_reg_59_, 2 + addi $3, $3, 4 +# was: addi _tmp_62_, _tmp_62_, 4 + add $28, $28, $3 +# was: add $28, $28, _tmp_62_ + sw $2, 0($16) +# was: sw _size_reg_59_, 0(_letBind_58_) + addi $2, $16, 4 +# was: addi _addr_reg_60_, _letBind_58_, 4 + ori $3, $0, 0 +# was: ori _tmp_reg_61_, $0, 0 + sw $3, 0($2) +# was: sw _tmp_reg_61_, 0(_addr_reg_60_) + addi $2, $2, 4 +# was: addi _addr_reg_60_, _addr_reg_60_, 4 + ori $3, $0, 0 +# was: ori _tmp_reg_61_, $0, 0 + sw $3, 0($2) +# was: sw _tmp_reg_61_, 0(_addr_reg_60_) + addi $2, $2, 4 +# was: addi _addr_reg_60_, _addr_reg_60_, 4 + ori $3, $0, 0 +# was: ori _tmp_reg_61_, $0, 0 + sw $3, 0($2) +# was: sw _tmp_reg_61_, 0(_addr_reg_60_) + addi $2, $2, 4 +# was: addi _addr_reg_60_, _addr_reg_60_, 4 + ori $3, $0, 0 +# was: ori _tmp_reg_61_, $0, 0 + sw $3, 0($2) +# was: sw _tmp_reg_61_, 0(_addr_reg_60_) + addi $2, $2, 4 +# was: addi _addr_reg_60_, _addr_reg_60_, 4 + ori $3, $5, 0 +# was: ori _arr_reg_64_, _letBind_35_, 0 + lw $2, 0($3) +# was: lw _size_reg_65_, 0(_arr_reg_64_) +# ori _letBind_63_,_letBind_58_,0 + addi $3, $3, 4 +# was: addi _arr_reg_64_, _arr_reg_64_, 4 + ori $4, $0, 0 +# was: ori _ind_var_66_, $0, 0 +_loop_beg_68_: + sub $6, $4, $2 +# was: sub _tmp_reg_67_, _ind_var_66_, _size_reg_65_ + bgez $6, _loop_end_69_ +# was: bgez _tmp_reg_67_, _loop_end_69_ + lw $6, 0($3) +# was: lw _tmp_reg_67_, 0(_arr_reg_64_) + addi $3, $3, 4 +# was: addi _arr_reg_64_, _arr_reg_64_, 4 + ori $5, $0, 0 +# was: ori _arr_ind_72_, $0, 0 + addi $7, $16, 4 +# was: addi _arr_reg_73_, _letBind_63_, 4 + lw $8, 0($16) +# was: lw _size_reg_74_, 0(_letBind_63_) + bgez $5, _safe_lab_77_ +# was: bgez _arr_ind_72_, _safe_lab_77_ +_error_lab_76_: + ori $5, $0, 28 +# was: ori $5, $0, 28 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_77_: + sub $8, $5, $8 +# was: sub _tmp_reg_75_, _arr_ind_72_, _size_reg_74_ + bgez $8, _error_lab_76_ +# was: bgez _tmp_reg_75_, _error_lab_76_ + sll $5, $5, 2 +# was: sll _arr_ind_72_, _arr_ind_72_, 2 + add $7, $7, $5 +# was: add _arr_reg_73_, _arr_reg_73_, _arr_ind_72_ + lw $9, 0($7) +# was: lw _letBind_71_, 0(_arr_reg_73_) + ori $7, $0, 0 +# was: ori _arr_ind_79_, $0, 0 + addi $5, $6, 4 +# was: addi _arr_reg_80_, _tmp_reg_67_, 4 + lw $8, 0($6) +# was: lw _size_reg_81_, 0(_tmp_reg_67_) + bgez $7, _safe_lab_84_ +# was: bgez _arr_ind_79_, _safe_lab_84_ +_error_lab_83_: + ori $5, $0, 28 +# was: ori $5, $0, 28 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_84_: + sub $8, $7, $8 +# was: sub _tmp_reg_82_, _arr_ind_79_, _size_reg_81_ + bgez $8, _error_lab_83_ +# was: bgez _tmp_reg_82_, _error_lab_83_ + sll $7, $7, 2 +# was: sll _arr_ind_79_, _arr_ind_79_, 2 + add $5, $5, $7 +# was: add _arr_reg_80_, _arr_reg_80_, _arr_ind_79_ + lw $5, 0($5) +# was: lw _letBind_78_, 0(_arr_reg_80_) +# ori _lt_L_90_,_letBind_71_,0 +# ori _lt_R_91_,_letBind_78_,0 + slt $7, $9, $5 +# was: slt _cond_89_, _lt_L_90_, _lt_R_91_ + bne $7, $0, _then_86_ +# was: bne _cond_89_, $0, _then_86_ + j _else_87_ +_then_86_: + ori $9, $5, 0 +# was: ori _letBind_85_, _letBind_78_, 0 + j _endif_88_ +_else_87_: +# ori _letBind_85_,_letBind_71_,0 +_endif_88_: + ori $5, $0, 2 +# was: ori _arr_ind_95_, $0, 2 + addi $7, $16, 4 +# was: addi _arr_reg_96_, _letBind_63_, 4 + lw $8, 0($16) +# was: lw _size_reg_97_, 0(_letBind_63_) + bgez $5, _safe_lab_100_ +# was: bgez _arr_ind_95_, _safe_lab_100_ +_error_lab_99_: + ori $5, $0, 28 +# was: ori $5, $0, 28 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_100_: + sub $8, $5, $8 +# was: sub _tmp_reg_98_, _arr_ind_95_, _size_reg_97_ + bgez $8, _error_lab_99_ +# was: bgez _tmp_reg_98_, _error_lab_99_ + sll $5, $5, 2 +# was: sll _arr_ind_95_, _arr_ind_95_, 2 + add $7, $7, $5 +# was: add _arr_reg_96_, _arr_reg_96_, _arr_ind_95_ + lw $8, 0($7) +# was: lw _plus_L_93_, 0(_arr_reg_96_) + ori $5, $0, 1 +# was: ori _arr_ind_101_, $0, 1 + addi $7, $6, 4 +# was: addi _arr_reg_102_, _tmp_reg_67_, 4 + lw $10, 0($6) +# was: lw _size_reg_103_, 0(_tmp_reg_67_) + bgez $5, _safe_lab_106_ +# was: bgez _arr_ind_101_, _safe_lab_106_ +_error_lab_105_: + ori $5, $0, 28 +# was: ori $5, $0, 28 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_106_: + sub $10, $5, $10 +# was: sub _tmp_reg_104_, _arr_ind_101_, _size_reg_103_ + bgez $10, _error_lab_105_ +# was: bgez _tmp_reg_104_, _error_lab_105_ + sll $5, $5, 2 +# was: sll _arr_ind_101_, _arr_ind_101_, 2 + add $7, $7, $5 +# was: add _arr_reg_102_, _arr_reg_102_, _arr_ind_101_ + lw $5, 0($7) +# was: lw _plus_R_94_, 0(_arr_reg_102_) + add $5, $8, $5 +# was: add _letBind_92_, _plus_L_93_, _plus_R_94_ +# ori _lt_L_112_,_letBind_85_,0 +# ori _lt_R_113_,_letBind_92_,0 + slt $7, $9, $5 +# was: slt _cond_111_, _lt_L_112_, _lt_R_113_ + bne $7, $0, _then_108_ +# was: bne _cond_111_, $0, _then_108_ + j _else_109_ +_then_108_: +# ori _letBind_107_,_letBind_92_,0 + j _endif_110_ +_else_109_: + ori $5, $9, 0 +# was: ori _letBind_107_, _letBind_85_, 0 +_endif_110_: + ori $7, $0, 1 +# was: ori _arr_ind_115_, $0, 1 + addi $8, $16, 4 +# was: addi _arr_reg_116_, _letBind_63_, 4 + lw $9, 0($16) +# was: lw _size_reg_117_, 0(_letBind_63_) + bgez $7, _safe_lab_120_ +# was: bgez _arr_ind_115_, _safe_lab_120_ +_error_lab_119_: + ori $5, $0, 29 +# was: ori $5, $0, 29 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_120_: + sub $9, $7, $9 +# was: sub _tmp_reg_118_, _arr_ind_115_, _size_reg_117_ + bgez $9, _error_lab_119_ +# was: bgez _tmp_reg_118_, _error_lab_119_ + sll $7, $7, 2 +# was: sll _arr_ind_115_, _arr_ind_115_, 2 + add $8, $8, $7 +# was: add _arr_reg_116_, _arr_reg_116_, _arr_ind_115_ + lw $7, 0($8) +# was: lw _letBind_114_, 0(_arr_reg_116_) + ori $9, $0, 3 +# was: ori _arr_ind_124_, $0, 3 + addi $10, $16, 4 +# was: addi _arr_reg_125_, _letBind_63_, 4 + lw $8, 0($16) +# was: lw _size_reg_126_, 0(_letBind_63_) + bgez $9, _safe_lab_129_ +# was: bgez _arr_ind_124_, _safe_lab_129_ +_error_lab_128_: + ori $5, $0, 29 +# was: ori $5, $0, 29 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_129_: + sub $8, $9, $8 +# was: sub _tmp_reg_127_, _arr_ind_124_, _size_reg_126_ + bgez $8, _error_lab_128_ +# was: bgez _tmp_reg_127_, _error_lab_128_ + sll $9, $9, 2 +# was: sll _arr_ind_124_, _arr_ind_124_, 2 + add $10, $10, $9 +# was: add _arr_reg_125_, _arr_reg_125_, _arr_ind_124_ + lw $9, 0($10) +# was: lw _plus_L_122_, 0(_arr_reg_125_) + ori $8, $0, 1 +# was: ori _arr_ind_130_, $0, 1 + addi $10, $6, 4 +# was: addi _arr_reg_131_, _tmp_reg_67_, 4 + lw $11, 0($6) +# was: lw _size_reg_132_, 0(_tmp_reg_67_) + bgez $8, _safe_lab_135_ +# was: bgez _arr_ind_130_, _safe_lab_135_ +_error_lab_134_: + ori $5, $0, 29 +# was: ori $5, $0, 29 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_135_: + sub $11, $8, $11 +# was: sub _tmp_reg_133_, _arr_ind_130_, _size_reg_132_ + bgez $11, _error_lab_134_ +# was: bgez _tmp_reg_133_, _error_lab_134_ + sll $8, $8, 2 +# was: sll _arr_ind_130_, _arr_ind_130_, 2 + add $10, $10, $8 +# was: add _arr_reg_131_, _arr_reg_131_, _arr_ind_130_ + lw $8, 0($10) +# was: lw _plus_R_123_, 0(_arr_reg_131_) + add $8, $9, $8 +# was: add _letBind_121_, _plus_L_122_, _plus_R_123_ +# ori _lt_L_141_,_letBind_114_,0 +# ori _lt_R_142_,_letBind_121_,0 + slt $9, $7, $8 +# was: slt _cond_140_, _lt_L_141_, _lt_R_142_ + bne $9, $0, _then_137_ +# was: bne _cond_140_, $0, _then_137_ + j _else_138_ +_then_137_: + ori $7, $8, 0 +# was: ori _letBind_136_, _letBind_121_, 0 + j _endif_139_ +_else_138_: +# ori _letBind_136_,_letBind_114_,0 +_endif_139_: + ori $8, $0, 2 +# was: ori _arr_ind_146_, $0, 2 + addi $9, $16, 4 +# was: addi _arr_reg_147_, _letBind_63_, 4 + lw $10, 0($16) +# was: lw _size_reg_148_, 0(_letBind_63_) + bgez $8, _safe_lab_151_ +# was: bgez _arr_ind_146_, _safe_lab_151_ +_error_lab_150_: + ori $5, $0, 30 +# was: ori $5, $0, 30 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_151_: + sub $10, $8, $10 +# was: sub _tmp_reg_149_, _arr_ind_146_, _size_reg_148_ + bgez $10, _error_lab_150_ +# was: bgez _tmp_reg_149_, _error_lab_150_ + sll $8, $8, 2 +# was: sll _arr_ind_146_, _arr_ind_146_, 2 + add $9, $9, $8 +# was: add _arr_reg_147_, _arr_reg_147_, _arr_ind_146_ + lw $8, 0($9) +# was: lw _plus_L_144_, 0(_arr_reg_147_) + ori $9, $0, 3 +# was: ori _arr_ind_152_, $0, 3 + addi $10, $6, 4 +# was: addi _arr_reg_153_, _tmp_reg_67_, 4 + lw $11, 0($6) +# was: lw _size_reg_154_, 0(_tmp_reg_67_) + bgez $9, _safe_lab_157_ +# was: bgez _arr_ind_152_, _safe_lab_157_ +_error_lab_156_: + ori $5, $0, 30 +# was: ori $5, $0, 30 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_157_: + sub $11, $9, $11 +# was: sub _tmp_reg_155_, _arr_ind_152_, _size_reg_154_ + bgez $11, _error_lab_156_ +# was: bgez _tmp_reg_155_, _error_lab_156_ + sll $9, $9, 2 +# was: sll _arr_ind_152_, _arr_ind_152_, 2 + add $10, $10, $9 +# was: add _arr_reg_153_, _arr_reg_153_, _arr_ind_152_ + lw $9, 0($10) +# was: lw _plus_R_145_, 0(_arr_reg_153_) + add $8, $8, $9 +# was: add _letBind_143_, _plus_L_144_, _plus_R_145_ + ori $9, $0, 2 +# was: ori _arr_ind_159_, $0, 2 + addi $10, $6, 4 +# was: addi _arr_reg_160_, _tmp_reg_67_, 4 + lw $11, 0($6) +# was: lw _size_reg_161_, 0(_tmp_reg_67_) + bgez $9, _safe_lab_164_ +# was: bgez _arr_ind_159_, _safe_lab_164_ +_error_lab_163_: + ori $5, $0, 30 +# was: ori $5, $0, 30 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_164_: + sub $11, $9, $11 +# was: sub _tmp_reg_162_, _arr_ind_159_, _size_reg_161_ + bgez $11, _error_lab_163_ +# was: bgez _tmp_reg_162_, _error_lab_163_ + sll $9, $9, 2 +# was: sll _arr_ind_159_, _arr_ind_159_, 2 + add $10, $10, $9 +# was: add _arr_reg_160_, _arr_reg_160_, _arr_ind_159_ + lw $9, 0($10) +# was: lw _letBind_158_, 0(_arr_reg_160_) +# ori _lt_L_170_,_letBind_143_,0 +# ori _lt_R_171_,_letBind_158_,0 + slt $10, $8, $9 +# was: slt _cond_169_, _lt_L_170_, _lt_R_171_ + bne $10, $0, _then_166_ +# was: bne _cond_169_, $0, _then_166_ + j _else_167_ +_then_166_: + ori $8, $9, 0 +# was: ori _letBind_165_, _letBind_158_, 0 + j _endif_168_ +_else_167_: +# ori _letBind_165_,_letBind_143_,0 +_endif_168_: + ori $10, $0, 3 +# was: ori _arr_ind_175_, $0, 3 + addi $9, $16, 4 +# was: addi _arr_reg_176_, _letBind_63_, 4 + lw $11, 0($16) +# was: lw _size_reg_177_, 0(_letBind_63_) + bgez $10, _safe_lab_180_ +# was: bgez _arr_ind_175_, _safe_lab_180_ +_error_lab_179_: + ori $5, $0, 31 +# was: ori $5, $0, 31 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_180_: + sub $11, $10, $11 +# was: sub _tmp_reg_178_, _arr_ind_175_, _size_reg_177_ + bgez $11, _error_lab_179_ +# was: bgez _tmp_reg_178_, _error_lab_179_ + sll $10, $10, 2 +# was: sll _arr_ind_175_, _arr_ind_175_, 2 + add $9, $9, $10 +# was: add _arr_reg_176_, _arr_reg_176_, _arr_ind_175_ + lw $11, 0($9) +# was: lw _plus_L_173_, 0(_arr_reg_176_) + ori $9, $0, 3 +# was: ori _arr_ind_181_, $0, 3 + addi $10, $6, 4 +# was: addi _arr_reg_182_, _tmp_reg_67_, 4 + lw $6, 0($6) +# was: lw _size_reg_183_, 0(_tmp_reg_67_) + bgez $9, _safe_lab_186_ +# was: bgez _arr_ind_181_, _safe_lab_186_ +_error_lab_185_: + ori $5, $0, 31 +# was: ori $5, $0, 31 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_186_: + sub $6, $9, $6 +# was: sub _tmp_reg_184_, _arr_ind_181_, _size_reg_183_ + bgez $6, _error_lab_185_ +# was: bgez _tmp_reg_184_, _error_lab_185_ + sll $9, $9, 2 +# was: sll _arr_ind_181_, _arr_ind_181_, 2 + add $10, $10, $9 +# was: add _arr_reg_182_, _arr_reg_182_, _arr_ind_181_ + lw $6, 0($10) +# was: lw _plus_R_174_, 0(_arr_reg_182_) + add $9, $11, $6 +# was: add _letBind_172_, _plus_L_173_, _plus_R_174_ + ori $10, $0, 4 +# was: ori _size_reg_187_, $0, 4 + ori $16, $28, 0 +# was: ori _fun_arg_res_70_, $28, 0 + sll $6, $10, 2 +# was: sll _tmp_190_, _size_reg_187_, 2 + addi $6, $6, 4 +# was: addi _tmp_190_, _tmp_190_, 4 + add $28, $28, $6 +# was: add $28, $28, _tmp_190_ + sw $10, 0($16) +# was: sw _size_reg_187_, 0(_fun_arg_res_70_) + addi $6, $16, 4 +# was: addi _addr_reg_188_, _fun_arg_res_70_, 4 +# ori _tmp_reg_189_,_letBind_107_,0 + sw $5, 0($6) +# was: sw _tmp_reg_189_, 0(_addr_reg_188_) + addi $6, $6, 4 +# was: addi _addr_reg_188_, _addr_reg_188_, 4 + ori $5, $7, 0 +# was: ori _tmp_reg_189_, _letBind_136_, 0 + sw $5, 0($6) +# was: sw _tmp_reg_189_, 0(_addr_reg_188_) + addi $6, $6, 4 +# was: addi _addr_reg_188_, _addr_reg_188_, 4 + ori $5, $8, 0 +# was: ori _tmp_reg_189_, _letBind_165_, 0 + sw $5, 0($6) +# was: sw _tmp_reg_189_, 0(_addr_reg_188_) + addi $6, $6, 4 +# was: addi _addr_reg_188_, _addr_reg_188_, 4 + ori $5, $9, 0 +# was: ori _tmp_reg_189_, _letBind_172_, 0 + sw $5, 0($6) +# was: sw _tmp_reg_189_, 0(_addr_reg_188_) + addi $6, $6, 4 +# was: addi _addr_reg_188_, _addr_reg_188_, 4 +# ori _letBind_63_,_fun_arg_res_70_,0 + addi $4, $4, 1 +# was: addi _ind_var_66_, _ind_var_66_, 1 + j _loop_beg_68_ +_loop_end_69_: + la $2, _aaMSSPa_193_ +# was: la _tmp_192_, _aaMSSPa_193_ +# _aaMSSPa_193_: string "\n\nMSSP result is: " +# ori _letBind_191_,_tmp_192_,0 +# ori $2,_tmp_192_,0 + jal putstring +# was: jal putstring, $2 + ori $3, $0, 0 +# was: ori _arr_ind_195_, $0, 0 + addi $2, $16, 4 +# was: addi _arr_reg_196_, _letBind_63_, 4 + lw $4, 0($16) +# was: lw _size_reg_197_, 0(_letBind_63_) + bgez $3, _safe_lab_200_ +# was: bgez _arr_ind_195_, _safe_lab_200_ +_error_lab_199_: + ori $5, $0, 44 +# was: ori $5, $0, 44 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_200_: + sub $4, $3, $4 +# was: sub _tmp_reg_198_, _arr_ind_195_, _size_reg_197_ + bgez $4, _error_lab_199_ +# was: bgez _tmp_reg_198_, _error_lab_199_ + sll $3, $3, 2 +# was: sll _arr_ind_195_, _arr_ind_195_, 2 + add $2, $2, $3 +# was: add _arr_reg_196_, _arr_reg_196_, _arr_ind_195_ + lw $16, 0($2) +# was: lw _tmp_194_, 0(_arr_reg_196_) +# ori _mainres_1_,_tmp_194_,0 + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + jal putint +# was: jal putint, $2 + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + addi $29, $29, 32 + lw $21, -28($29) + lw $20, -24($29) + lw $19, -20($29) + lw $18, -16($29) + lw $17, -12($29) + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_aaMSSPa_193_: + .space 4 + .asciiz "\n\nMSSP result is: " + .align 2 +_a__str__33_: + .space 4 + .asciiz "\n" + .align 2 +_aa__str_29_: + .space 4 + .asciiz ": " + .align 2 +_Introdu_24_: + .space 4 + .asciiz "Introduce number " + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/io_mssp.fo b/fasto/tests/io_mssp.fo new file mode 100644 index 0000000..24d7a5b --- /dev/null +++ b/fasto/tests/io_mssp.fo @@ -0,0 +1,44 @@ +fun int read_int(int i) = + let t = write("Introduce number ") in + let t = write(i) in + let t = write(": ") in + let m = read(int) in + let t = write("\n") in + m + +fun [int] read_int_arr(int n) = + let itsp = iota(n) in + map(read_int, itsp) + +fun int write_int(int i) = write(i) + +fun bool write_int_arr([int] arr) = + let a = write(" { ") in + let v = map(write_int, arr) in + let a = write(" }\n") in + true + +fun int max(int x, int y) = if (x < y) then y else x + +fun [int] mapper(int x) = + let xm = max(x, 0) in + {xm, xm, xm, x} + +fun [int] reducer([int] a, [int] b) = + let mss = max(max(a[0], b[0]), a[2] + b[1]) in + let mis = max(a[1], a[3] + b[1]) in + let mcs = max(a[2] + b[3], b[2]) in + let ts = a[3] + b[3] + in {mss, mis, mcs, ts} + +fun [int] mssp(int n) = + let in_arr = read_int_arr(n) in + // let inarr = {1, 0 - 2, 3, 4, 0 - 1, 5, 0 - 6, 1} in + let map_arr = map(mapper, in_arr) in + let ne = {0, 0, 0, 0} + in reduce(reducer, ne, map_arr) + +fun int main() = + let arr = mssp(8) in + let t = write("\n\nMSSP result is: ") in + write(arr[0]) diff --git a/fasto/tests/io_mssp.in b/fasto/tests/io_mssp.in new file mode 100644 index 0000000..8619a34 --- /dev/null +++ b/fasto/tests/io_mssp.in @@ -0,0 +1,8 @@ +1 +-2 +3 +4 +-1 +5 +-6 +1 diff --git a/fasto/tests/io_mssp.out b/fasto/tests/io_mssp.out new file mode 100644 index 0000000..271e28a --- /dev/null +++ b/fasto/tests/io_mssp.out @@ -0,0 +1,11 @@ +Introduce number 0 : +Introduce number 1 : +Introduce number 2 : +Introduce number 3 : +Introduce number 4 : +Introduce number 5 : +Introduce number 6 : +Introduce number 7 : + + +MSSP result is: 11 diff --git a/fasto/tests/iota.asm b/fasto/tests/iota.asm new file mode 100644 index 0000000..dd71444 --- /dev/null +++ b/fasto/tests/iota.asm @@ -0,0 +1,393 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $16, -8($29) + addi $29, $29, -12 + ori $2, $0, 7 +# was: ori _size_reg_3_, $0, 7 + bgez $2, _safe_lab_4_ +# was: bgez _size_reg_3_, _safe_lab_4_ + ori $5, $0, 2 +# was: ori $5, $0, 2 + la $6, _Msg_IllegalArraySize_ +# was: la $6, _Msg_IllegalArraySize_ + j _RuntimeError_ +_safe_lab_4_: + ori $16, $28, 0 +# was: ori _letBind_2_, $28, 0 + sll $3, $2, 2 +# was: sll _tmp_10_, _size_reg_3_, 2 + addi $3, $3, 4 +# was: addi _tmp_10_, _tmp_10_, 4 + add $28, $28, $3 +# was: add $28, $28, _tmp_10_ + sw $2, 0($16) +# was: sw _size_reg_3_, 0(_letBind_2_) + addi $4, $16, 4 +# was: addi _addr_reg_5_, _letBind_2_, 4 + ori $3, $0, 0 +# was: ori _i_reg_6_, $0, 0 +_loop_beg_7_: + sub $5, $3, $2 +# was: sub _tmp_reg_9_, _i_reg_6_, _size_reg_3_ + bgez $5, _loop_end_8_ +# was: bgez _tmp_reg_9_, _loop_end_8_ + sw $3, 0($4) +# was: sw _i_reg_6_, 0(_addr_reg_5_) + addi $4, $4, 4 +# was: addi _addr_reg_5_, _addr_reg_5_, 4 + addi $3, $3, 1 +# was: addi _i_reg_6_, _i_reg_6_, 1 + j _loop_beg_7_ +_loop_end_8_: + ori $2, $0, 0 +# was: ori _arr_ind_13_, $0, 0 + addi $3, $16, 4 +# was: addi _arr_reg_14_, _letBind_2_, 4 + lw $4, 0($16) +# was: lw _size_reg_15_, 0(_letBind_2_) + bgez $2, _safe_lab_18_ +# was: bgez _arr_ind_13_, _safe_lab_18_ +_error_lab_17_: + ori $5, $0, 3 +# was: ori $5, $0, 3 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_18_: + sub $4, $2, $4 +# was: sub _tmp_reg_16_, _arr_ind_13_, _size_reg_15_ + bgez $4, _error_lab_17_ +# was: bgez _tmp_reg_16_, _error_lab_17_ + sll $2, $2, 2 +# was: sll _arr_ind_13_, _arr_ind_13_, 2 + add $3, $3, $2 +# was: add _arr_reg_14_, _arr_reg_14_, _arr_ind_13_ + lw $2, 0($3) +# was: lw _tmp_12_, 0(_arr_reg_14_) +# ori _letBind_11_,_tmp_12_,0 +# ori $2,_letBind_11_,0 + jal putint +# was: jal putint, $2 + ori $3, $0, 1 +# was: ori _arr_ind_21_, $0, 1 + addi $2, $16, 4 +# was: addi _arr_reg_22_, _letBind_2_, 4 + lw $4, 0($16) +# was: lw _size_reg_23_, 0(_letBind_2_) + bgez $3, _safe_lab_26_ +# was: bgez _arr_ind_21_, _safe_lab_26_ +_error_lab_25_: + ori $5, $0, 4 +# was: ori $5, $0, 4 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_26_: + sub $4, $3, $4 +# was: sub _tmp_reg_24_, _arr_ind_21_, _size_reg_23_ + bgez $4, _error_lab_25_ +# was: bgez _tmp_reg_24_, _error_lab_25_ + sll $3, $3, 2 +# was: sll _arr_ind_21_, _arr_ind_21_, 2 + add $2, $2, $3 +# was: add _arr_reg_22_, _arr_reg_22_, _arr_ind_21_ + lw $2, 0($2) +# was: lw _tmp_20_, 0(_arr_reg_22_) +# ori _letBind_19_,_tmp_20_,0 +# ori $2,_letBind_19_,0 + jal putint +# was: jal putint, $2 + ori $2, $0, 2 +# was: ori _arr_ind_29_, $0, 2 + addi $3, $16, 4 +# was: addi _arr_reg_30_, _letBind_2_, 4 + lw $4, 0($16) +# was: lw _size_reg_31_, 0(_letBind_2_) + bgez $2, _safe_lab_34_ +# was: bgez _arr_ind_29_, _safe_lab_34_ +_error_lab_33_: + ori $5, $0, 5 +# was: ori $5, $0, 5 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_34_: + sub $4, $2, $4 +# was: sub _tmp_reg_32_, _arr_ind_29_, _size_reg_31_ + bgez $4, _error_lab_33_ +# was: bgez _tmp_reg_32_, _error_lab_33_ + sll $2, $2, 2 +# was: sll _arr_ind_29_, _arr_ind_29_, 2 + add $3, $3, $2 +# was: add _arr_reg_30_, _arr_reg_30_, _arr_ind_29_ + lw $2, 0($3) +# was: lw _tmp_28_, 0(_arr_reg_30_) +# ori _letBind_27_,_tmp_28_,0 +# ori $2,_letBind_27_,0 + jal putint +# was: jal putint, $2 + ori $2, $0, 3 +# was: ori _arr_ind_37_, $0, 3 + addi $3, $16, 4 +# was: addi _arr_reg_38_, _letBind_2_, 4 + lw $4, 0($16) +# was: lw _size_reg_39_, 0(_letBind_2_) + bgez $2, _safe_lab_42_ +# was: bgez _arr_ind_37_, _safe_lab_42_ +_error_lab_41_: + ori $5, $0, 6 +# was: ori $5, $0, 6 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_42_: + sub $4, $2, $4 +# was: sub _tmp_reg_40_, _arr_ind_37_, _size_reg_39_ + bgez $4, _error_lab_41_ +# was: bgez _tmp_reg_40_, _error_lab_41_ + sll $2, $2, 2 +# was: sll _arr_ind_37_, _arr_ind_37_, 2 + add $3, $3, $2 +# was: add _arr_reg_38_, _arr_reg_38_, _arr_ind_37_ + lw $2, 0($3) +# was: lw _tmp_36_, 0(_arr_reg_38_) +# ori _letBind_35_,_tmp_36_,0 +# ori $2,_letBind_35_,0 + jal putint +# was: jal putint, $2 + ori $2, $0, 4 +# was: ori _arr_ind_45_, $0, 4 + addi $3, $16, 4 +# was: addi _arr_reg_46_, _letBind_2_, 4 + lw $4, 0($16) +# was: lw _size_reg_47_, 0(_letBind_2_) + bgez $2, _safe_lab_50_ +# was: bgez _arr_ind_45_, _safe_lab_50_ +_error_lab_49_: + ori $5, $0, 7 +# was: ori $5, $0, 7 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_50_: + sub $4, $2, $4 +# was: sub _tmp_reg_48_, _arr_ind_45_, _size_reg_47_ + bgez $4, _error_lab_49_ +# was: bgez _tmp_reg_48_, _error_lab_49_ + sll $2, $2, 2 +# was: sll _arr_ind_45_, _arr_ind_45_, 2 + add $3, $3, $2 +# was: add _arr_reg_46_, _arr_reg_46_, _arr_ind_45_ + lw $2, 0($3) +# was: lw _tmp_44_, 0(_arr_reg_46_) +# ori _letBind_43_,_tmp_44_,0 +# ori $2,_letBind_43_,0 + jal putint +# was: jal putint, $2 + ori $2, $0, 5 +# was: ori _arr_ind_53_, $0, 5 + addi $3, $16, 4 +# was: addi _arr_reg_54_, _letBind_2_, 4 + lw $4, 0($16) +# was: lw _size_reg_55_, 0(_letBind_2_) + bgez $2, _safe_lab_58_ +# was: bgez _arr_ind_53_, _safe_lab_58_ +_error_lab_57_: + ori $5, $0, 8 +# was: ori $5, $0, 8 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_58_: + sub $4, $2, $4 +# was: sub _tmp_reg_56_, _arr_ind_53_, _size_reg_55_ + bgez $4, _error_lab_57_ +# was: bgez _tmp_reg_56_, _error_lab_57_ + sll $2, $2, 2 +# was: sll _arr_ind_53_, _arr_ind_53_, 2 + add $3, $3, $2 +# was: add _arr_reg_54_, _arr_reg_54_, _arr_ind_53_ + lw $2, 0($3) +# was: lw _tmp_52_, 0(_arr_reg_54_) +# ori _letBind_51_,_tmp_52_,0 +# ori $2,_letBind_51_,0 + jal putint +# was: jal putint, $2 + ori $2, $0, 6 +# was: ori _arr_ind_61_, $0, 6 + addi $3, $16, 4 +# was: addi _arr_reg_62_, _letBind_2_, 4 + lw $4, 0($16) +# was: lw _size_reg_63_, 0(_letBind_2_) + bgez $2, _safe_lab_66_ +# was: bgez _arr_ind_61_, _safe_lab_66_ +_error_lab_65_: + ori $5, $0, 9 +# was: ori $5, $0, 9 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_66_: + sub $4, $2, $4 +# was: sub _tmp_reg_64_, _arr_ind_61_, _size_reg_63_ + bgez $4, _error_lab_65_ +# was: bgez _tmp_reg_64_, _error_lab_65_ + sll $2, $2, 2 +# was: sll _arr_ind_61_, _arr_ind_61_, 2 + add $3, $3, $2 +# was: add _arr_reg_62_, _arr_reg_62_, _arr_ind_61_ + lw $2, 0($3) +# was: lw _tmp_60_, 0(_arr_reg_62_) +# ori _letBind_59_,_tmp_60_,0 +# ori $2,_letBind_59_,0 + jal putint +# was: jal putint, $2 + ori $2, $0, 0 +# was: ori _mainres_1_, $0, 0 +# ori $2,_mainres_1_,0 + addi $29, $29, 12 + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/iota.fo b/fasto/tests/iota.fo new file mode 100644 index 0000000..04f1c63 --- /dev/null +++ b/fasto/tests/iota.fo @@ -0,0 +1,10 @@ +fun int main() = + let a = iota(7) in + let tmp = write(a[0]) in + let tmp = write(a[1]) in + let tmp = write(a[2]) in + let tmp = write(a[3]) in + let tmp = write(a[4]) in + let tmp = write(a[5]) in + let tmp = write(a[6]) in + 0 diff --git a/fasto/tests/iota.in b/fasto/tests/iota.in new file mode 100644 index 0000000..e69de29 diff --git a/fasto/tests/iota.out b/fasto/tests/iota.out new file mode 100644 index 0000000..7be611d --- /dev/null +++ b/fasto/tests/iota.out @@ -0,0 +1 @@ +0 1 2 3 4 5 6 diff --git a/fasto/tests/lambda.asm b/fasto/tests/lambda.asm new file mode 100644 index 0000000..d51f4f6 --- /dev/null +++ b/fasto/tests/lambda.asm @@ -0,0 +1,339 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _a__str__41_ +# was: la _a__str__41__addr, _a__str__41_ + ori $3, $0, 1 +# was: ori _a__str__41__init, $0, 1 + sw $3, 0($4) +# was: sw _a__str__41__init, 0(_a__str__41__addr) + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $21, -28($29) + sw $20, -24($29) + sw $19, -20($29) + sw $18, -16($29) + sw $17, -12($29) + sw $16, -8($29) + addi $29, $29, -32 + jal getint +# was: jal getint, $2 +# ori _letBind_2_,$2,0 + ori $4, $2, 0 +# was: ori _size_reg_4_, _letBind_2_, 0 + bgez $4, _safe_lab_5_ +# was: bgez _size_reg_4_, _safe_lab_5_ + ori $5, $0, 7 +# was: ori $5, $0, 7 + la $6, _Msg_IllegalArraySize_ +# was: la $6, _Msg_IllegalArraySize_ + j _RuntimeError_ +_safe_lab_5_: + ori $6, $28, 0 +# was: ori _letBind_3_, $28, 0 + sll $2, $4, 2 +# was: sll _tmp_11_, _size_reg_4_, 2 + addi $2, $2, 4 +# was: addi _tmp_11_, _tmp_11_, 4 + add $28, $28, $2 +# was: add $28, $28, _tmp_11_ + sw $4, 0($6) +# was: sw _size_reg_4_, 0(_letBind_3_) + addi $5, $6, 4 +# was: addi _addr_reg_6_, _letBind_3_, 4 + ori $2, $0, 0 +# was: ori _i_reg_7_, $0, 0 +_loop_beg_8_: + sub $3, $2, $4 +# was: sub _tmp_reg_10_, _i_reg_7_, _size_reg_4_ + bgez $3, _loop_end_9_ +# was: bgez _tmp_reg_10_, _loop_end_9_ + sw $2, 0($5) +# was: sw _i_reg_7_, 0(_addr_reg_6_) + addi $5, $5, 4 +# was: addi _addr_reg_6_, _addr_reg_6_, 4 + addi $2, $2, 1 +# was: addi _i_reg_7_, _i_reg_7_, 1 + j _loop_beg_8_ +_loop_end_9_: +# ori _arr_reg_14_,_letBind_3_,0 + lw $2, 0($6) +# was: lw _size_reg_13_, 0(_arr_reg_14_) + ori $3, $28, 0 +# was: ori _letBind_12_, $28, 0 + sll $4, $2, 2 +# was: sll _tmp_25_, _size_reg_13_, 2 + addi $4, $4, 4 +# was: addi _tmp_25_, _tmp_25_, 4 + add $28, $28, $4 +# was: add $28, $28, _tmp_25_ + sw $2, 0($3) +# was: sw _size_reg_13_, 0(_letBind_12_) + addi $4, $3, 4 +# was: addi _addr_reg_17_, _letBind_12_, 4 + ori $5, $0, 0 +# was: ori _i_reg_18_, $0, 0 + addi $6, $6, 4 +# was: addi _elem_reg_15_, _arr_reg_14_, 4 +_loop_beg_19_: + sub $7, $5, $2 +# was: sub _tmp_reg_21_, _i_reg_18_, _size_reg_13_ + bgez $7, _loop_end_20_ +# was: bgez _tmp_reg_21_, _loop_end_20_ + lw $7, 0($6) +# was: lw _res_reg_16_, 0(_elem_reg_15_) + addi $6, $6, 4 +# was: addi _elem_reg_15_, _elem_reg_15_, 4 + ori $8, $7, 0 +# was: ori _plus_L_23_, _res_reg_16_, 0 + ori $7, $0, 2 +# was: ori _plus_R_24_, $0, 2 + add $7, $8, $7 +# was: add _fun_arg_res_22_, _plus_L_23_, _plus_R_24_ +# ori _res_reg_16_,_fun_arg_res_22_,0 + sw $7, 0($4) +# was: sw _res_reg_16_, 0(_addr_reg_17_) + addi $4, $4, 4 +# was: addi _addr_reg_17_, _addr_reg_17_, 4 + addi $5, $5, 1 +# was: addi _i_reg_18_, _i_reg_18_, 1 + j _loop_beg_19_ +_loop_end_20_: +# ori _arr_reg_28_,_letBind_12_,0 + lw $17, 0($3) +# was: lw _size_reg_27_, 0(_arr_reg_28_) + ori $16, $28, 0 +# was: ori _letBind_26_, $28, 0 + sll $2, $17, 2 +# was: sll _tmp_38_, _size_reg_27_, 2 + addi $2, $2, 4 +# was: addi _tmp_38_, _tmp_38_, 4 + add $28, $28, $2 +# was: add $28, $28, _tmp_38_ + sw $17, 0($16) +# was: sw _size_reg_27_, 0(_letBind_26_) + addi $18, $16, 4 +# was: addi _addr_reg_31_, _letBind_26_, 4 + ori $19, $0, 0 +# was: ori _i_reg_32_, $0, 0 + addi $20, $3, 4 +# was: addi _elem_reg_29_, _arr_reg_28_, 4 +_loop_beg_33_: + sub $2, $19, $17 +# was: sub _tmp_reg_35_, _i_reg_32_, _size_reg_27_ + bgez $2, _loop_end_34_ +# was: bgez _tmp_reg_35_, _loop_end_34_ + lw $21, 0($20) +# was: lw _res_reg_30_, 0(_elem_reg_29_) + addi $20, $20, 4 +# was: addi _elem_reg_29_, _elem_reg_29_, 4 +# ori _tmp_37_,_res_reg_30_,0 +# ori _fun_arg_res_36_,_tmp_37_,0 + ori $2, $21, 0 +# was: ori $2, _fun_arg_res_36_, 0 + jal putint +# was: jal putint, $2 +# ori _res_reg_30_,_fun_arg_res_36_,0 + sw $21, 0($18) +# was: sw _res_reg_30_, 0(_addr_reg_31_) + addi $18, $18, 4 +# was: addi _addr_reg_31_, _addr_reg_31_, 4 + addi $19, $19, 1 +# was: addi _i_reg_32_, _i_reg_32_, 1 + j _loop_beg_33_ +_loop_end_34_: + la $2, _a__str__41_ +# was: la _tmp_40_, _a__str__41_ +# _a__str__41_: string "\n" +# ori _letBind_39_,_tmp_40_,0 +# ori $2,_tmp_40_,0 + jal putstring +# was: jal putstring, $2 +# ori _arr_reg_43_,_letBind_26_,0 + lw $2, 0($16) +# was: lw _size_reg_44_, 0(_arr_reg_43_) + ori $5, $0, 0 +# was: ori _letBind_42_, $0, 0 + addi $16, $16, 4 +# was: addi _arr_reg_43_, _arr_reg_43_, 4 + ori $3, $0, 0 +# was: ori _ind_var_45_, $0, 0 +_loop_beg_47_: + sub $4, $3, $2 +# was: sub _tmp_reg_46_, _ind_var_45_, _size_reg_44_ + bgez $4, _loop_end_48_ +# was: bgez _tmp_reg_46_, _loop_end_48_ + lw $4, 0($16) +# was: lw _tmp_reg_46_, 0(_arr_reg_43_) + addi $16, $16, 4 +# was: addi _arr_reg_43_, _arr_reg_43_, 4 +# ori _plus_L_50_,_letBind_42_,0 +# ori _plus_R_51_,_tmp_reg_46_,0 + add $5, $5, $4 +# was: add _fun_arg_res_49_, _plus_L_50_, _plus_R_51_ +# ori _letBind_42_,_fun_arg_res_49_,0 + addi $3, $3, 1 +# was: addi _ind_var_45_, _ind_var_45_, 1 + j _loop_beg_47_ +_loop_end_48_: +# ori _tmp_52_,_letBind_42_,0 + ori $16, $5, 0 +# was: ori _mainres_1_, _tmp_52_, 0 + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + jal putint +# was: jal putint, $2 + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + addi $29, $29, 32 + lw $21, -28($29) + lw $20, -24($29) + lw $19, -20($29) + lw $18, -16($29) + lw $17, -12($29) + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_a__str__41_: + .space 4 + .asciiz "\n" + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/lambda.fo b/fasto/tests/lambda.fo new file mode 100644 index 0000000..f052e36 --- /dev/null +++ b/fasto/tests/lambda.fo @@ -0,0 +1,10 @@ +fun int write_int(int x) = write(x) + +fun [int] write_int_arr([int] x) = map(write_int, x) + +fun int main() = + let N = read(int) in + let z = iota(N) in + let w = write_int_arr(map(fn int (int x) => x + 2, z)) in + let nl = write("\n") in + write_int(reduce(op+, 0, w)) diff --git a/fasto/tests/lambda.in b/fasto/tests/lambda.in new file mode 100644 index 0000000..f599e28 --- /dev/null +++ b/fasto/tests/lambda.in @@ -0,0 +1 @@ +10 diff --git a/fasto/tests/lambda.out b/fasto/tests/lambda.out new file mode 100644 index 0000000..531e7a6 --- /dev/null +++ b/fasto/tests/lambda.out @@ -0,0 +1,2 @@ +2 3 4 5 6 7 8 9 10 11 +65 diff --git a/fasto/tests/map_red_io.asm b/fasto/tests/map_red_io.asm new file mode 100644 index 0000000..57331e0 --- /dev/null +++ b/fasto/tests/map_red_io.asm @@ -0,0 +1,420 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _Maxacha_72_ +# was: la _Maxacha_72__addr, _Maxacha_72_ + ori $3, $0, 10 +# was: ori _Maxacha_72__init, $0, 10 + sw $3, 0($4) +# was: sw _Maxacha_72__init, 0(_Maxacha_72__addr) + la $4, _a__str__69_ +# was: la _a__str__69__addr, _a__str__69_ + ori $3, $0, 1 +# was: ori _a__str__69__init, $0, 1 + sw $3, 0($4) +# was: sw _a__str__69__init, 0(_a__str__69__addr) + la $4, _Sumaa___64_ +# was: la _Sumaa___64__addr, _Sumaa___64_ + ori $3, $0, 5 +# was: ori _Sumaa___64__init, $0, 5 + sw $3, 0($4) +# was: sw _Sumaa___64__init, 0(_Sumaa___64__addr) + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $21, -28($29) + sw $20, -24($29) + sw $19, -20($29) + sw $18, -16($29) + sw $17, -12($29) + sw $16, -8($29) + addi $29, $29, -32 + jal getint +# was: jal getint, $2 +# ori _letBind_2_,$2,0 + ori $5, $2, 0 +# was: ori _size_reg_4_, _letBind_2_, 0 + bgez $5, _safe_lab_5_ +# was: bgez _size_reg_4_, _safe_lab_5_ + ori $5, $0, 10 +# was: ori $5, $0, 10 + la $6, _Msg_IllegalArraySize_ +# was: la $6, _Msg_IllegalArraySize_ + j _RuntimeError_ +_safe_lab_5_: + ori $3, $28, 0 +# was: ori _letBind_3_, $28, 0 + sll $4, $5, 2 +# was: sll _tmp_11_, _size_reg_4_, 2 + addi $4, $4, 4 +# was: addi _tmp_11_, _tmp_11_, 4 + add $28, $28, $4 +# was: add $28, $28, _tmp_11_ + sw $5, 0($3) +# was: sw _size_reg_4_, 0(_letBind_3_) + addi $7, $3, 4 +# was: addi _addr_reg_6_, _letBind_3_, 4 + ori $4, $0, 0 +# was: ori _i_reg_7_, $0, 0 +_loop_beg_8_: + sub $6, $4, $5 +# was: sub _tmp_reg_10_, _i_reg_7_, _size_reg_4_ + bgez $6, _loop_end_9_ +# was: bgez _tmp_reg_10_, _loop_end_9_ + sw $4, 0($7) +# was: sw _i_reg_7_, 0(_addr_reg_6_) + addi $7, $7, 4 +# was: addi _addr_reg_6_, _addr_reg_6_, 4 + addi $4, $4, 1 +# was: addi _i_reg_7_, _i_reg_7_, 1 + j _loop_beg_8_ +_loop_end_9_: +# ori _arr_reg_14_,_letBind_3_,0 + lw $5, 0($3) +# was: lw _size_reg_13_, 0(_arr_reg_14_) + ori $4, $28, 0 +# was: ori _letBind_12_, $28, 0 + sll $6, $5, 2 +# was: sll _tmp_25_, _size_reg_13_, 2 + addi $6, $6, 4 +# was: addi _tmp_25_, _tmp_25_, 4 + add $28, $28, $6 +# was: add $28, $28, _tmp_25_ + sw $5, 0($4) +# was: sw _size_reg_13_, 0(_letBind_12_) + addi $7, $4, 4 +# was: addi _addr_reg_17_, _letBind_12_, 4 + ori $6, $0, 0 +# was: ori _i_reg_18_, $0, 0 + addi $8, $3, 4 +# was: addi _elem_reg_15_, _arr_reg_14_, 4 +_loop_beg_19_: + sub $9, $6, $5 +# was: sub _tmp_reg_21_, _i_reg_18_, _size_reg_13_ + bgez $9, _loop_end_20_ +# was: bgez _tmp_reg_21_, _loop_end_20_ + lw $9, 0($8) +# was: lw _res_reg_16_, 0(_elem_reg_15_) + addi $8, $8, 4 +# was: addi _elem_reg_15_, _elem_reg_15_, 4 +# ori _plus_L_23_,_res_reg_16_,0 + ori $10, $0, 100 +# was: ori _plus_R_24_, $0, 100 + add $9, $9, $10 +# was: add _fun_arg_res_22_, _plus_L_23_, _plus_R_24_ +# ori _res_reg_16_,_fun_arg_res_22_,0 + sw $9, 0($7) +# was: sw _res_reg_16_, 0(_addr_reg_17_) + addi $7, $7, 4 +# was: addi _addr_reg_17_, _addr_reg_17_, 4 + addi $6, $6, 1 +# was: addi _i_reg_18_, _i_reg_18_, 1 + j _loop_beg_19_ +_loop_end_20_: + ori $7, $4, 0 +# was: ori _arr_reg_27_, _letBind_12_, 0 + lw $5, 0($7) +# was: lw _size_reg_28_, 0(_arr_reg_27_) + ori $17, $0, 0 +# was: ori _letBind_26_, $0, 0 + addi $7, $7, 4 +# was: addi _arr_reg_27_, _arr_reg_27_, 4 + ori $6, $0, 0 +# was: ori _ind_var_29_, $0, 0 +_loop_beg_31_: + sub $4, $6, $5 +# was: sub _tmp_reg_30_, _ind_var_29_, _size_reg_28_ + bgez $4, _loop_end_32_ +# was: bgez _tmp_reg_30_, _loop_end_32_ + lw $4, 0($7) +# was: lw _tmp_reg_30_, 0(_arr_reg_27_) + addi $7, $7, 4 +# was: addi _arr_reg_27_, _arr_reg_27_, 4 +# ori _plus_L_34_,_letBind_26_,0 +# ori _plus_R_35_,_tmp_reg_30_,0 + add $17, $17, $4 +# was: add _fun_arg_res_33_, _plus_L_34_, _plus_R_35_ +# ori _letBind_26_,_fun_arg_res_33_,0 + addi $6, $6, 1 +# was: addi _ind_var_29_, _ind_var_29_, 1 + j _loop_beg_31_ +_loop_end_32_: +# ori _arr_reg_38_,_letBind_3_,0 + lw $18, 0($3) +# was: lw _size_reg_37_, 0(_arr_reg_38_) + ori $16, $28, 0 +# was: ori _letBind_36_, $28, 0 + addi $4, $18, 3 +# was: addi _tmp_47_, _size_reg_37_, 3 + sra $4, $4, 2 +# was: sra _tmp_47_, _tmp_47_, 2 + sll $4, $4, 2 +# was: sll _tmp_47_, _tmp_47_, 2 + addi $4, $4, 4 +# was: addi _tmp_47_, _tmp_47_, 4 + add $28, $28, $4 +# was: add $28, $28, _tmp_47_ + sw $18, 0($16) +# was: sw _size_reg_37_, 0(_letBind_36_) + addi $20, $16, 4 +# was: addi _addr_reg_41_, _letBind_36_, 4 + ori $19, $0, 0 +# was: ori _i_reg_42_, $0, 0 + addi $21, $3, 4 +# was: addi _elem_reg_39_, _arr_reg_38_, 4 +_loop_beg_43_: + sub $3, $19, $18 +# was: sub _tmp_reg_45_, _i_reg_42_, _size_reg_37_ + bgez $3, _loop_end_44_ +# was: bgez _tmp_reg_45_, _loop_end_44_ + lw $3, 0($21) +# was: lw _res_reg_40_, 0(_elem_reg_39_) + addi $21, $21, 4 +# was: addi _elem_reg_39_, _elem_reg_39_, 4 + jal getchar +# was: jal getchar, $2 +# ori _fun_arg_res_46_,$2,0 + ori $3, $2, 0 +# was: ori _res_reg_40_, _fun_arg_res_46_, 0 + sb $3, 0($20) +# was: sb _res_reg_40_, 0(_addr_reg_41_) + addi $20, $20, 1 +# was: addi _addr_reg_41_, _addr_reg_41_, 1 + addi $19, $19, 1 +# was: addi _i_reg_42_, _i_reg_42_, 1 + j _loop_beg_43_ +_loop_end_44_: + ori $2, $16, 0 +# was: ori _arr_reg_49_, _letBind_36_, 0 + lw $3, 0($2) +# was: lw _size_reg_50_, 0(_arr_reg_49_) + ori $18, $0, 97 +# was: ori _letBind_48_, $0, 97 + addi $2, $2, 4 +# was: addi _arr_reg_49_, _arr_reg_49_, 4 + ori $4, $0, 0 +# was: ori _ind_var_51_, $0, 0 +_loop_beg_53_: + sub $5, $4, $3 +# was: sub _tmp_reg_52_, _ind_var_51_, _size_reg_50_ + bgez $5, _loop_end_54_ +# was: bgez _tmp_reg_52_, _loop_end_54_ + lb $5, 0($2) +# was: lb _tmp_reg_52_, 0(_arr_reg_49_) + addi $2, $2, 1 +# was: addi _arr_reg_49_, _arr_reg_49_, 1 +# ori _lt_L_60_,_letBind_48_,0 +# ori _lt_R_61_,_tmp_reg_52_,0 + slt $6, $18, $5 +# was: slt _cond_59_, _lt_L_60_, _lt_R_61_ + bne $6, $0, _then_56_ +# was: bne _cond_59_, $0, _then_56_ + j _else_57_ +_then_56_: +# ori _fun_arg_res_55_,_tmp_reg_52_,0 + j _endif_58_ +_else_57_: + ori $5, $18, 0 +# was: ori _fun_arg_res_55_, _letBind_48_, 0 +_endif_58_: + ori $18, $5, 0 +# was: ori _letBind_48_, _fun_arg_res_55_, 0 + addi $4, $4, 1 +# was: addi _ind_var_51_, _ind_var_51_, 1 + j _loop_beg_53_ +_loop_end_54_: + la $2, _Sumaa___64_ +# was: la _tmp_63_, _Sumaa___64_ +# _Sumaa___64_: string "Sum: " +# ori _letBind_62_,_tmp_63_,0 +# ori $2,_tmp_63_,0 + jal putstring +# was: jal putstring, $2 +# ori _tmp_66_,_letBind_26_,0 + ori $2, $17, 0 +# was: ori _letBind_65_, _tmp_66_, 0 +# ori $2,_letBind_65_,0 + jal putint +# was: jal putint, $2 + la $2, _a__str__69_ +# was: la _tmp_68_, _a__str__69_ +# _a__str__69_: string "\n" +# ori _letBind_67_,_tmp_68_,0 +# ori $2,_tmp_68_,0 + jal putstring +# was: jal putstring, $2 + la $2, _Maxacha_72_ +# was: la _tmp_71_, _Maxacha_72_ +# _Maxacha_72_: string "Max char: " +# ori _letBind_70_,_tmp_71_,0 +# ori $2,_tmp_71_,0 + jal putstring +# was: jal putstring, $2 + ori $2, $18, 0 +# was: ori _tmp_74_, _letBind_48_, 0 +# ori _letBind_73_,_tmp_74_,0 +# ori $2,_letBind_73_,0 + jal putchar +# was: jal putchar, $2 + ori $2, $16, 0 +# was: ori _mainres_1_, _letBind_36_, 0 +# ori $2,_mainres_1_,0 + addi $29, $29, 32 + lw $21, -28($29) + lw $20, -24($29) + lw $19, -20($29) + lw $18, -16($29) + lw $17, -12($29) + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_Maxacha_72_: + .space 4 + .asciiz "Max char: " + .align 2 +_a__str__69_: + .space 4 + .asciiz "\n" + .align 2 +_Sumaa___64_: + .space 4 + .asciiz "Sum: " + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/map_red_io.fo b/fasto/tests/map_red_io.fo new file mode 100644 index 0000000..5fbb312 --- /dev/null +++ b/fasto/tests/map_red_io.fo @@ -0,0 +1,20 @@ +fun int plus100 (int x) = x + 100 +fun char read_chr(int i) = read(char) + +fun int plus (int x, int y) = x + y +fun char max_chr(char a, char b) = + if a < b then b else a + +fun [char] main() = + let n = read(int) in // read n ints from the keyboard + let a = iota(n) in // produce a = {0, 1, ... n − 1} + let b = map(plus100, a) in // b = {100, 101, ... , n + 99} + let d = reduce(plus, 0, b) in // d = 100 + 101 + ... + (n + 99) + let c = map(read_chr, a) in // reads N chars from keyboard + let m = reduce(max_chr, 'a', c) in // get the max element of c + let tmp = write("Sum: ") in // print string "Sum: " + let tmp = write(d) in // print d (the sum of b) + let tmp = write("\n") in // print newline + let tmp = write("Max char: ") in // print " Max char: " + let tmp = write(m) in // print max elem of char array + c // result is input char array diff --git a/fasto/tests/map_red_io.in b/fasto/tests/map_red_io.in new file mode 100644 index 0000000..b6619ff --- /dev/null +++ b/fasto/tests/map_red_io.in @@ -0,0 +1,5 @@ +4 +c +a +b +d diff --git a/fasto/tests/map_red_io.out b/fasto/tests/map_red_io.out new file mode 100644 index 0000000..6511326 --- /dev/null +++ b/fasto/tests/map_red_io.out @@ -0,0 +1,2 @@ +Sum: 406 +Max char: d diff --git a/fasto/tests/multilet.asm b/fasto/tests/multilet.asm new file mode 100644 index 0000000..6c2a305 --- /dev/null +++ b/fasto/tests/multilet.asm @@ -0,0 +1,174 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $16, -8($29) + addi $29, $29, -12 + jal getint +# was: jal getint, $2 +# ori _letBind_2_,$2,0 + ori $3, $2, 0 +# was: ori _plus_L_4_, _letBind_2_, 0 +# ori _plus_R_5_,_letBind_2_,0 + add $3, $3, $2 +# was: add _letBind_3_, _plus_L_4_, _plus_R_5_ +# ori _minus_L_7_,_letBind_3_,0 + ori $4, $0, 1 +# was: ori _minus_R_8_, $0, 1 + sub $3, $3, $4 +# was: sub _letBind_6_, _minus_L_7_, _minus_R_8_ +# ori _mult1_L_10_,_letBind_2_,0 +# ori _mult2_R_11_,_letBind_6_,0 + mul $16, $2, $3 +# was: mul _tmp_9_, _mult1_L_10_, _mult2_R_11_ +# ori _mainres_1_,_tmp_9_,0 + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + jal putint +# was: jal putint, $2 + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + addi $29, $29, 12 + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/multilet.fo b/fasto/tests/multilet.fo new file mode 100644 index 0000000..9d720bb --- /dev/null +++ b/fasto/tests/multilet.fo @@ -0,0 +1,3 @@ +fun int main () = + let n = read(int); x = n+n; y = x-1 + in write(n*y) diff --git a/fasto/tests/multilet.in b/fasto/tests/multilet.in new file mode 100644 index 0000000..1e8b314 --- /dev/null +++ b/fasto/tests/multilet.in @@ -0,0 +1 @@ +6 diff --git a/fasto/tests/multilet.out b/fasto/tests/multilet.out new file mode 100644 index 0000000..d1cbcfa --- /dev/null +++ b/fasto/tests/multilet.out @@ -0,0 +1 @@ +66 \ No newline at end of file diff --git a/fasto/tests/neg_simple.err b/fasto/tests/neg_simple.err new file mode 100644 index 0000000..63d56da --- /dev/null +++ b/fasto/tests/neg_simple.err @@ -0,0 +1 @@ +Type error: Arity mismatch in declaration of main: expected a function of arity 0, but got int -> int at line 2, column 9 diff --git a/fasto/tests/neg_simple.fo b/fasto/tests/neg_simple.fo new file mode 100644 index 0000000..b9e47c8 --- /dev/null +++ b/fasto/tests/neg_simple.fo @@ -0,0 +1,2 @@ +// A simple negative test, as 'main' cannot take any arguments. +fun int main(int t) = t diff --git a/fasto/tests/negate.asm b/fasto/tests/negate.asm new file mode 100644 index 0000000..0cbe2d6 --- /dev/null +++ b/fasto/tests/negate.asm @@ -0,0 +1,319 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _a__str__35_ +# was: la _a__str__35__addr, _a__str__35_ + ori $3, $0, 1 +# was: ori _a__str__35__init, $0, 1 + sw $3, 0($4) +# was: sw _a__str__35__init, 0(_a__str__35__addr) + la $4, _a__str__25_ +# was: la _a__str__25__addr, _a__str__25_ + ori $3, $0, 1 +# was: ori _a__str__25__init, $0, 1 + sw $3, 0($4) +# was: sw _a__str__25__init, 0(_a__str__25__addr) + la $4, _a__str__19_ +# was: la _a__str__19__addr, _a__str__19_ + ori $3, $0, 1 +# was: ori _a__str__19__init, $0, 1 + sw $3, 0($4) +# was: sw _a__str__19__init, 0(_a__str__19__addr) + la $4, _a__str__13_ +# was: la _a__str__13__addr, _a__str__13_ + ori $3, $0, 1 +# was: ori _a__str__13__init, $0, 1 + sw $3, 0($4) +# was: sw _a__str__13__init, 0(_a__str__13__addr) + la $4, _a__str__7_ +# was: la _a__str__7__addr, _a__str__7_ + ori $3, $0, 1 +# was: ori _a__str__7__init, $0, 1 + sw $3, 0($4) +# was: sw _a__str__7__init, 0(_a__str__7__addr) + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $19, -20($29) + sw $18, -16($29) + sw $17, -12($29) + sw $16, -8($29) + addi $29, $29, -24 + ori $16, $0, 1 +# was: ori _tmp_3_, $0, 1 +# ori _letBind_2_,_tmp_3_,0 + la $2, _true +# was: la $2, _true + bne $16, $0, _wBoolF_4_ +# was: bne _letBind_2_, $0, _wBoolF_4_ + la $2, _false +# was: la $2, _false +_wBoolF_4_: + jal putstring +# was: jal putstring, $2 + la $2, _a__str__7_ +# was: la _tmp_6_, _a__str__7_ +# _a__str__7_: string "\n" +# ori _letBind_5_,_tmp_6_,0 +# ori $2,_tmp_6_,0 + jal putstring +# was: jal putstring, $2 + ori $17, $0, 0 +# was: ori _tmp_9_, $0, 0 +# ori _letBind_8_,_tmp_9_,0 + la $2, _true +# was: la $2, _true + bne $17, $0, _wBoolF_10_ +# was: bne _letBind_8_, $0, _wBoolF_10_ + la $2, _false +# was: la $2, _false +_wBoolF_10_: + jal putstring +# was: jal putstring, $2 + la $2, _a__str__13_ +# was: la _tmp_12_, _a__str__13_ +# _a__str__13_: string "\n" +# ori _letBind_11_,_tmp_12_,0 +# ori $2,_tmp_12_,0 + jal putstring +# was: jal putstring, $2 + ori $18, $0, 0 +# was: ori _tmp_15_, $0, 0 +# ori _letBind_14_,_tmp_15_,0 + la $2, _true +# was: la $2, _true + bne $18, $0, _wBoolF_16_ +# was: bne _letBind_14_, $0, _wBoolF_16_ + la $2, _false +# was: la $2, _false +_wBoolF_16_: + jal putstring +# was: jal putstring, $2 + la $2, _a__str__19_ +# was: la _tmp_18_, _a__str__19_ +# _a__str__19_: string "\n" +# ori _letBind_17_,_tmp_18_,0 +# ori $2,_tmp_18_,0 + jal putstring +# was: jal putstring, $2 + ori $19, $0, 1 +# was: ori _tmp_21_, $0, 1 +# ori _letBind_20_,_tmp_21_,0 + la $2, _true +# was: la $2, _true + bne $19, $0, _wBoolF_22_ +# was: bne _letBind_20_, $0, _wBoolF_22_ + la $2, _false +# was: la $2, _false +_wBoolF_22_: + jal putstring +# was: jal putstring, $2 + la $2, _a__str__25_ +# was: la _tmp_24_, _a__str__25_ +# _a__str__25_: string "\n" +# ori _letBind_23_,_tmp_24_,0 +# ori $2,_tmp_24_,0 + jal putstring +# was: jal putstring, $2 +# ori _letBind_26_,_letBind_2_,0 + beq $16, $0, _endLabel_29_ +# was: beq _letBind_26_, $0, _endLabel_29_ + ori $16, $17, 0 +# was: ori _letBind_26_, _letBind_8_, 0 +_endLabel_29_: + beq $16, $0, _endLabel_28_ +# was: beq _letBind_26_, $0, _endLabel_28_ + ori $16, $18, 0 +# was: ori _letBind_26_, _letBind_14_, 0 +_endLabel_28_: + beq $16, $0, _endLabel_27_ +# was: beq _letBind_26_, $0, _endLabel_27_ + ori $16, $19, 0 +# was: ori _letBind_26_, _letBind_20_, 0 +_endLabel_27_: +# ori _tmp_31_,_letBind_26_,0 +# ori _letBind_30_,_tmp_31_,0 + la $2, _true +# was: la $2, _true + bne $16, $0, _wBoolF_32_ +# was: bne _letBind_30_, $0, _wBoolF_32_ + la $2, _false +# was: la $2, _false +_wBoolF_32_: + jal putstring +# was: jal putstring, $2 + la $2, _a__str__35_ +# was: la _tmp_34_, _a__str__35_ +# _a__str__35_: string "\n" +# ori _letBind_33_,_tmp_34_,0 +# ori $2,_tmp_34_,0 + jal putstring +# was: jal putstring, $2 + ori $2, $16, 0 +# was: ori _mainres_1_, _letBind_30_, 0 +# ori $2,_mainres_1_,0 + addi $29, $29, 24 + lw $19, -20($29) + lw $18, -16($29) + lw $17, -12($29) + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_a__str__35_: + .space 4 + .asciiz "\n" + .align 2 +_a__str__25_: + .space 4 + .asciiz "\n" + .align 2 +_a__str__19_: + .space 4 + .asciiz "\n" + .align 2 +_a__str__13_: + .space 4 + .asciiz "\n" + .align 2 +_a__str__7_: + .space 4 + .asciiz "\n" + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/negate.fo b/fasto/tests/negate.fo new file mode 100644 index 0000000..1cc019c --- /dev/null +++ b/fasto/tests/negate.fo @@ -0,0 +1,11 @@ +fun bool write_nl(bool b) = + let res = write(b) in + let tmp = write("\n") in + res + +fun bool main() = + let x0 = write_nl(3 / 2 == 1) in + let x1 = write_nl(~3 / 2 == ~2) in + let x2 = write_nl(3 /~2 == ~2) in + let x3 = write_nl(~3 /~2 == 1) in + write_nl(x0 && x1 && x2 && x3) diff --git a/fasto/tests/negate.in b/fasto/tests/negate.in new file mode 100644 index 0000000..e69de29 diff --git a/fasto/tests/negate.out b/fasto/tests/negate.out new file mode 100644 index 0000000..363db97 --- /dev/null +++ b/fasto/tests/negate.out @@ -0,0 +1,5 @@ +true +false +false +true +false diff --git a/fasto/tests/ordchr.asm b/fasto/tests/ordchr.asm new file mode 100644 index 0000000..0a081b7 --- /dev/null +++ b/fasto/tests/ordchr.asm @@ -0,0 +1,378 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $20, -24($29) + sw $19, -20($29) + sw $18, -16($29) + sw $17, -12($29) + sw $16, -8($29) + addi $29, $29, -28 + jal getint +# was: jal getint, $2 +# ori _letBind_2_,$2,0 + ori $4, $2, 0 +# was: ori _size_reg_8_, _letBind_2_, 0 + bgez $4, _safe_lab_9_ +# was: bgez _size_reg_8_, _safe_lab_9_ + ori $5, $0, 3 +# was: ori $5, $0, 3 + la $6, _Msg_IllegalArraySize_ +# was: la $6, _Msg_IllegalArraySize_ + j _RuntimeError_ +_safe_lab_9_: + ori $3, $28, 0 +# was: ori _arr_reg_5_, $28, 0 + sll $5, $4, 2 +# was: sll _tmp_15_, _size_reg_8_, 2 + addi $5, $5, 4 +# was: addi _tmp_15_, _tmp_15_, 4 + add $28, $28, $5 +# was: add $28, $28, _tmp_15_ + sw $4, 0($3) +# was: sw _size_reg_8_, 0(_arr_reg_5_) + addi $5, $3, 4 +# was: addi _addr_reg_10_, _arr_reg_5_, 4 + ori $7, $0, 0 +# was: ori _i_reg_11_, $0, 0 +_loop_beg_12_: + sub $6, $7, $4 +# was: sub _tmp_reg_14_, _i_reg_11_, _size_reg_8_ + bgez $6, _loop_end_13_ +# was: bgez _tmp_reg_14_, _loop_end_13_ + sw $7, 0($5) +# was: sw _i_reg_11_, 0(_addr_reg_10_) + addi $5, $5, 4 +# was: addi _addr_reg_10_, _addr_reg_10_, 4 + addi $7, $7, 1 +# was: addi _i_reg_11_, _i_reg_11_, 1 + j _loop_beg_12_ +_loop_end_13_: + lw $17, 0($3) +# was: lw _size_reg_4_, 0(_arr_reg_5_) + ori $18, $28, 0 +# was: ori _letBind_3_, $28, 0 + addi $4, $17, 3 +# was: addi _tmp_22_, _size_reg_4_, 3 + sra $4, $4, 2 +# was: sra _tmp_22_, _tmp_22_, 2 + sll $4, $4, 2 +# was: sll _tmp_22_, _tmp_22_, 2 + addi $4, $4, 4 +# was: addi _tmp_22_, _tmp_22_, 4 + add $28, $28, $4 +# was: add $28, $28, _tmp_22_ + sw $17, 0($18) +# was: sw _size_reg_4_, 0(_letBind_3_) + addi $16, $18, 4 +# was: addi _addr_reg_16_, _letBind_3_, 4 + ori $19, $0, 0 +# was: ori _i_reg_17_, $0, 0 + addi $20, $3, 4 +# was: addi _elem_reg_6_, _arr_reg_5_, 4 +_loop_beg_18_: + sub $3, $19, $17 +# was: sub _tmp_reg_20_, _i_reg_17_, _size_reg_4_ + bgez $3, _loop_end_19_ +# was: bgez _tmp_reg_20_, _loop_end_19_ + lw $3, 0($20) +# was: lw _res_reg_7_, 0(_elem_reg_6_) + addi $20, $20, 4 +# was: addi _elem_reg_6_, _elem_reg_6_, 4 + jal getchar +# was: jal getchar, $2 +# ori _fun_arg_res_21_,$2,0 + ori $3, $2, 0 +# was: ori _res_reg_7_, _fun_arg_res_21_, 0 + sb $3, 0($16) +# was: sb _res_reg_7_, 0(_addr_reg_16_) + addi $16, $16, 1 +# was: addi _addr_reg_16_, _addr_reg_16_, 1 + addi $19, $19, 1 +# was: addi _i_reg_17_, _i_reg_17_, 1 + j _loop_beg_18_ +_loop_end_19_: + ori $2, $18, 0 +# was: ori _arr_reg_33_, _letBind_3_, 0 + lw $18, 0($2) +# was: lw _size_reg_32_, 0(_arr_reg_33_) + ori $16, $28, 0 +# was: ori _arr_reg_29_, $28, 0 + sll $3, $18, 2 +# was: sll _tmp_42_, _size_reg_32_, 2 + addi $3, $3, 4 +# was: addi _tmp_42_, _tmp_42_, 4 + add $28, $28, $3 +# was: add $28, $28, _tmp_42_ + sw $18, 0($16) +# was: sw _size_reg_32_, 0(_arr_reg_29_) + addi $19, $16, 4 +# was: addi _addr_reg_36_, _arr_reg_29_, 4 + ori $17, $0, 0 +# was: ori _i_reg_37_, $0, 0 + addi $20, $2, 4 +# was: addi _elem_reg_34_, _arr_reg_33_, 4 +_loop_beg_38_: + sub $2, $17, $18 +# was: sub _tmp_reg_40_, _i_reg_37_, _size_reg_32_ + bgez $2, _loop_end_39_ +# was: bgez _tmp_reg_40_, _loop_end_39_ + lb $2, 0($20) +# was: lb _res_reg_35_, 0(_elem_reg_34_) + addi $20, $20, 1 +# was: addi _elem_reg_34_, _elem_reg_34_, 1 +# ori $2,_res_reg_35_,0 + jal ord +# was: jal ord, $2 +# ori _tmp_reg_41_,$2,0 +# ori _res_reg_35_,_tmp_reg_41_,0 + sw $2, 0($19) +# was: sw _res_reg_35_, 0(_addr_reg_36_) + addi $19, $19, 4 +# was: addi _addr_reg_36_, _addr_reg_36_, 4 + addi $17, $17, 1 +# was: addi _i_reg_37_, _i_reg_37_, 1 + j _loop_beg_38_ +_loop_end_39_: + lw $3, 0($16) +# was: lw _size_reg_28_, 0(_arr_reg_29_) + ori $2, $28, 0 +# was: ori _arr_reg_25_, $28, 0 + sll $4, $3, 2 +# was: sll _tmp_51_, _size_reg_28_, 2 + addi $4, $4, 4 +# was: addi _tmp_51_, _tmp_51_, 4 + add $28, $28, $4 +# was: add $28, $28, _tmp_51_ + sw $3, 0($2) +# was: sw _size_reg_28_, 0(_arr_reg_25_) + addi $5, $2, 4 +# was: addi _addr_reg_43_, _arr_reg_25_, 4 + ori $4, $0, 0 +# was: ori _i_reg_44_, $0, 0 + addi $6, $16, 4 +# was: addi _elem_reg_30_, _arr_reg_29_, 4 +_loop_beg_45_: + sub $7, $4, $3 +# was: sub _tmp_reg_47_, _i_reg_44_, _size_reg_28_ + bgez $7, _loop_end_46_ +# was: bgez _tmp_reg_47_, _loop_end_46_ + lw $8, 0($6) +# was: lw _res_reg_31_, 0(_elem_reg_30_) + addi $6, $6, 4 +# was: addi _elem_reg_30_, _elem_reg_30_, 4 +# ori _plus_L_49_,_res_reg_31_,0 + ori $7, $0, 1 +# was: ori _plus_R_50_, $0, 1 + add $8, $8, $7 +# was: add _fun_arg_res_48_, _plus_L_49_, _plus_R_50_ +# ori _res_reg_31_,_fun_arg_res_48_,0 + sw $8, 0($5) +# was: sw _res_reg_31_, 0(_addr_reg_43_) + addi $5, $5, 4 +# was: addi _addr_reg_43_, _addr_reg_43_, 4 + addi $4, $4, 1 +# was: addi _i_reg_44_, _i_reg_44_, 1 + j _loop_beg_45_ +_loop_end_46_: + lw $17, 0($2) +# was: lw _size_reg_24_, 0(_arr_reg_25_) + ori $16, $28, 0 +# was: ori _letBind_23_, $28, 0 + addi $3, $17, 3 +# was: addi _tmp_58_, _size_reg_24_, 3 + sra $3, $3, 2 +# was: sra _tmp_58_, _tmp_58_, 2 + sll $3, $3, 2 +# was: sll _tmp_58_, _tmp_58_, 2 + addi $3, $3, 4 +# was: addi _tmp_58_, _tmp_58_, 4 + add $28, $28, $3 +# was: add $28, $28, _tmp_58_ + sw $17, 0($16) +# was: sw _size_reg_24_, 0(_letBind_23_) + addi $18, $16, 4 +# was: addi _addr_reg_52_, _letBind_23_, 4 + ori $19, $0, 0 +# was: ori _i_reg_53_, $0, 0 + addi $20, $2, 4 +# was: addi _elem_reg_26_, _arr_reg_25_, 4 +_loop_beg_54_: + sub $2, $19, $17 +# was: sub _tmp_reg_56_, _i_reg_53_, _size_reg_24_ + bgez $2, _loop_end_55_ +# was: bgez _tmp_reg_56_, _loop_end_55_ + lw $2, 0($20) +# was: lw _res_reg_27_, 0(_elem_reg_26_) + addi $20, $20, 4 +# was: addi _elem_reg_26_, _elem_reg_26_, 4 +# ori $2,_res_reg_27_,0 + jal chr +# was: jal chr, $2 +# ori _tmp_reg_57_,$2,0 +# ori _res_reg_27_,_tmp_reg_57_,0 + sb $2, 0($18) +# was: sb _res_reg_27_, 0(_addr_reg_52_) + addi $18, $18, 1 +# was: addi _addr_reg_52_, _addr_reg_52_, 1 + addi $19, $19, 1 +# was: addi _i_reg_53_, _i_reg_53_, 1 + j _loop_beg_54_ +_loop_end_55_: + ori $2, $16, 0 +# was: ori _tmp_59_, _letBind_23_, 0 + ori $16, $2, 0 +# was: ori _mainres_1_, _tmp_59_, 0 +# ori $2,_tmp_59_,0 + jal putstring +# was: jal putstring, $2 + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + addi $29, $29, 28 + lw $20, -24($29) + lw $19, -20($29) + lw $18, -16($29) + lw $17, -12($29) + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/ordchr.fo b/fasto/tests/ordchr.fo new file mode 100644 index 0000000..992d667 --- /dev/null +++ b/fasto/tests/ordchr.fo @@ -0,0 +1,11 @@ +fun char read_char(int i) = read(char) + +fun [char] read_string(int n) = map(read_char, iota(n)) + +fun int add_one(int x) = x + 1 + +fun [char] main() = + let n = read(int) in + let s1 = read_string(n) in + let s2 = map(chr, map(add_one, map(ord, s1))) in + write(s2) diff --git a/fasto/tests/ordchr.in b/fasto/tests/ordchr.in new file mode 100644 index 0000000..6784e1f --- /dev/null +++ b/fasto/tests/ordchr.in @@ -0,0 +1,4 @@ +3 +f +o +o diff --git a/fasto/tests/ordchr.out b/fasto/tests/ordchr.out new file mode 100644 index 0000000..fa241e7 --- /dev/null +++ b/fasto/tests/ordchr.out @@ -0,0 +1 @@ +gpp diff --git a/fasto/tests/proj_figure3.asm b/fasto/tests/proj_figure3.asm new file mode 100644 index 0000000..2ea2684 --- /dev/null +++ b/fasto/tests/proj_figure3.asm @@ -0,0 +1,326 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $20, -24($29) + sw $19, -20($29) + sw $18, -16($29) + sw $17, -12($29) + sw $16, -8($29) + addi $29, $29, -28 + jal getint +# was: jal getint, $2 +# ori _letBind_2_,$2,0 + ori $3, $2, 0 +# was: ori _size_reg_4_, _letBind_2_, 0 + bgez $3, _safe_lab_5_ +# was: bgez _size_reg_4_, _safe_lab_5_ + ori $5, $0, 6 +# was: ori $5, $0, 6 + la $6, _Msg_IllegalArraySize_ +# was: la $6, _Msg_IllegalArraySize_ + j _RuntimeError_ +_safe_lab_5_: + ori $6, $28, 0 +# was: ori _letBind_3_, $28, 0 + sll $2, $3, 2 +# was: sll _tmp_11_, _size_reg_4_, 2 + addi $2, $2, 4 +# was: addi _tmp_11_, _tmp_11_, 4 + add $28, $28, $2 +# was: add $28, $28, _tmp_11_ + sw $3, 0($6) +# was: sw _size_reg_4_, 0(_letBind_3_) + addi $5, $6, 4 +# was: addi _addr_reg_6_, _letBind_3_, 4 + ori $4, $0, 0 +# was: ori _i_reg_7_, $0, 0 +_loop_beg_8_: + sub $2, $4, $3 +# was: sub _tmp_reg_10_, _i_reg_7_, _size_reg_4_ + bgez $2, _loop_end_9_ +# was: bgez _tmp_reg_10_, _loop_end_9_ + sw $4, 0($5) +# was: sw _i_reg_7_, 0(_addr_reg_6_) + addi $5, $5, 4 +# was: addi _addr_reg_6_, _addr_reg_6_, 4 + addi $4, $4, 1 +# was: addi _i_reg_7_, _i_reg_7_, 1 + j _loop_beg_8_ +_loop_end_9_: +# ori _arr_reg_14_,_letBind_3_,0 + lw $2, 0($6) +# was: lw _size_reg_13_, 0(_arr_reg_14_) + ori $3, $28, 0 +# was: ori _letBind_12_, $28, 0 + sll $4, $2, 2 +# was: sll _tmp_25_, _size_reg_13_, 2 + addi $4, $4, 4 +# was: addi _tmp_25_, _tmp_25_, 4 + add $28, $28, $4 +# was: add $28, $28, _tmp_25_ + sw $2, 0($3) +# was: sw _size_reg_13_, 0(_letBind_12_) + addi $5, $3, 4 +# was: addi _addr_reg_17_, _letBind_12_, 4 + ori $4, $0, 0 +# was: ori _i_reg_18_, $0, 0 + addi $6, $6, 4 +# was: addi _elem_reg_15_, _arr_reg_14_, 4 +_loop_beg_19_: + sub $7, $4, $2 +# was: sub _tmp_reg_21_, _i_reg_18_, _size_reg_13_ + bgez $7, _loop_end_20_ +# was: bgez _tmp_reg_21_, _loop_end_20_ + lw $7, 0($6) +# was: lw _res_reg_16_, 0(_elem_reg_15_) + addi $6, $6, 4 +# was: addi _elem_reg_15_, _elem_reg_15_, 4 + ori $8, $7, 0 +# was: ori _plus_L_23_, _res_reg_16_, 0 + ori $7, $0, 100 +# was: ori _plus_R_24_, $0, 100 + add $7, $8, $7 +# was: add _fun_arg_res_22_, _plus_L_23_, _plus_R_24_ +# ori _res_reg_16_,_fun_arg_res_22_,0 + sw $7, 0($5) +# was: sw _res_reg_16_, 0(_addr_reg_17_) + addi $5, $5, 4 +# was: addi _addr_reg_17_, _addr_reg_17_, 4 + addi $4, $4, 1 +# was: addi _i_reg_18_, _i_reg_18_, 1 + j _loop_beg_19_ +_loop_end_20_: +# ori _arr_reg_28_,_letBind_12_,0 + lw $17, 0($3) +# was: lw _size_reg_27_, 0(_arr_reg_28_) + ori $16, $28, 0 +# was: ori _letBind_26_, $28, 0 + addi $2, $17, 3 +# was: addi _tmp_37_, _size_reg_27_, 3 + sra $2, $2, 2 +# was: sra _tmp_37_, _tmp_37_, 2 + sll $2, $2, 2 +# was: sll _tmp_37_, _tmp_37_, 2 + addi $2, $2, 4 +# was: addi _tmp_37_, _tmp_37_, 4 + add $28, $28, $2 +# was: add $28, $28, _tmp_37_ + sw $17, 0($16) +# was: sw _size_reg_27_, 0(_letBind_26_) + addi $19, $16, 4 +# was: addi _addr_reg_31_, _letBind_26_, 4 + ori $18, $0, 0 +# was: ori _i_reg_32_, $0, 0 + addi $20, $3, 4 +# was: addi _elem_reg_29_, _arr_reg_28_, 4 +_loop_beg_33_: + sub $2, $18, $17 +# was: sub _tmp_reg_35_, _i_reg_32_, _size_reg_27_ + bgez $2, _loop_end_34_ +# was: bgez _tmp_reg_35_, _loop_end_34_ + lw $2, 0($20) +# was: lw _res_reg_30_, 0(_elem_reg_29_) + addi $20, $20, 4 +# was: addi _elem_reg_29_, _elem_reg_29_, 4 +# ori $2,_res_reg_30_,0 + jal chr +# was: jal chr, $2 +# ori _tmp_reg_36_,$2,0 +# ori _res_reg_30_,_tmp_reg_36_,0 + sb $2, 0($19) +# was: sb _res_reg_30_, 0(_addr_reg_31_) + addi $19, $19, 1 +# was: addi _addr_reg_31_, _addr_reg_31_, 1 + addi $18, $18, 1 +# was: addi _i_reg_32_, _i_reg_32_, 1 + j _loop_beg_33_ +_loop_end_34_: + ori $2, $0, 1 +# was: ori _arr_ind_41_, $0, 1 + addi $3, $16, 4 +# was: addi _arr_reg_42_, _letBind_26_, 4 + lw $4, 0($16) +# was: lw _size_reg_43_, 0(_letBind_26_) + bgez $2, _safe_lab_46_ +# was: bgez _arr_ind_41_, _safe_lab_46_ +_error_lab_45_: + ori $5, $0, 10 +# was: ori $5, $0, 10 + la $6, _Msg_IllegalIndex_ +# was: la $6, _Msg_IllegalIndex_ + j _RuntimeError_ +_safe_lab_46_: + sub $4, $2, $4 +# was: sub _tmp_reg_44_, _arr_ind_41_, _size_reg_43_ + bgez $4, _error_lab_45_ +# was: bgez _tmp_reg_44_, _error_lab_45_ + add $3, $3, $2 +# was: add _arr_reg_42_, _arr_reg_42_, _arr_ind_41_ + lb $2, 0($3) +# was: lb _arg_40_, 0(_arr_reg_42_) +# ori $2,_arg_40_,0 + jal ord +# was: jal ord, $2 +# ori _tmp_39_,$2,0 +# ori _letBind_38_,_tmp_39_,0 +# ori $2,_letBind_38_,0 + jal putint +# was: jal putint, $2 + ori $2, $16, 0 +# was: ori _tmp_47_, _letBind_26_, 0 + ori $16, $2, 0 +# was: ori _mainres_1_, _tmp_47_, 0 +# ori $2,_tmp_47_,0 + jal putstring +# was: jal putstring, $2 + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + addi $29, $29, 28 + lw $20, -24($29) + lw $19, -20($29) + lw $18, -16($29) + lw $17, -12($29) + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/proj_figure3.fo b/fasto/tests/proj_figure3.fo new file mode 100644 index 0000000..74e0271 --- /dev/null +++ b/fasto/tests/proj_figure3.fo @@ -0,0 +1,11 @@ +fun int plus100(int x) = x + 100 +fun int plus(int x, int y) = x + y + +fun [char] main() = + let n = read(int) in // read N from the keyboard + let a = iota(n) in // produce a = {0, 1, ..., n - 1} + let b = map(plus100, a) in // b = {100, 101, ..., n + 99} + let d = reduce(plus, 0, a) in // d = 0 + 0 + 1 + 2 + ... + (n - 1) + let c = map(chr, b) in // c = {'d', 'e', 'f', ...} + let e = write(ord(c[1])) in // c[1] == 'e', ord('e') == 101 + write(c) // output "def..." to screen diff --git a/fasto/tests/proj_figure3.in b/fasto/tests/proj_figure3.in new file mode 100644 index 0000000..00750ed --- /dev/null +++ b/fasto/tests/proj_figure3.in @@ -0,0 +1 @@ +3 diff --git a/fasto/tests/proj_figure3.out b/fasto/tests/proj_figure3.out new file mode 100644 index 0000000..d2771af --- /dev/null +++ b/fasto/tests/proj_figure3.out @@ -0,0 +1 @@ +101 def diff --git a/fasto/tests/reduce.asm b/fasto/tests/reduce.asm new file mode 100644 index 0000000..aa4f5ab --- /dev/null +++ b/fasto/tests/reduce.asm @@ -0,0 +1,217 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $16, -8($29) + addi $29, $29, -12 + ori $4, $0, 3 +# was: ori _size_reg_9_, $0, 3 + ori $2, $28, 0 +# was: ori _arr_reg_3_, $28, 0 + sll $3, $4, 2 +# was: sll _tmp_12_, _size_reg_9_, 2 + addi $3, $3, 4 +# was: addi _tmp_12_, _tmp_12_, 4 + add $28, $28, $3 +# was: add $28, $28, _tmp_12_ + sw $4, 0($2) +# was: sw _size_reg_9_, 0(_arr_reg_3_) + addi $4, $2, 4 +# was: addi _addr_reg_10_, _arr_reg_3_, 4 + ori $3, $0, 1 +# was: ori _tmp_reg_11_, $0, 1 + sw $3, 0($4) +# was: sw _tmp_reg_11_, 0(_addr_reg_10_) + addi $4, $4, 4 +# was: addi _addr_reg_10_, _addr_reg_10_, 4 + ori $3, $0, 2 +# was: ori _tmp_reg_11_, $0, 2 + sw $3, 0($4) +# was: sw _tmp_reg_11_, 0(_addr_reg_10_) + addi $4, $4, 4 +# was: addi _addr_reg_10_, _addr_reg_10_, 4 + ori $3, $0, 3 +# was: ori _tmp_reg_11_, $0, 3 + sw $3, 0($4) +# was: sw _tmp_reg_11_, 0(_addr_reg_10_) + addi $4, $4, 4 +# was: addi _addr_reg_10_, _addr_reg_10_, 4 + lw $3, 0($2) +# was: lw _size_reg_4_, 0(_arr_reg_3_) + ori $6, $0, 0 +# was: ori _letBind_2_, $0, 0 + addi $2, $2, 4 +# was: addi _arr_reg_3_, _arr_reg_3_, 4 + ori $4, $0, 0 +# was: ori _ind_var_5_, $0, 0 +_loop_beg_7_: + sub $5, $4, $3 +# was: sub _tmp_reg_6_, _ind_var_5_, _size_reg_4_ + bgez $5, _loop_end_8_ +# was: bgez _tmp_reg_6_, _loop_end_8_ + lw $5, 0($2) +# was: lw _tmp_reg_6_, 0(_arr_reg_3_) + addi $2, $2, 4 +# was: addi _arr_reg_3_, _arr_reg_3_, 4 +# ori _plus_L_14_,_letBind_2_,0 +# ori _plus_R_15_,_tmp_reg_6_,0 + add $6, $6, $5 +# was: add _fun_arg_res_13_, _plus_L_14_, _plus_R_15_ +# ori _letBind_2_,_fun_arg_res_13_,0 + addi $4, $4, 1 +# was: addi _ind_var_5_, _ind_var_5_, 1 + j _loop_beg_7_ +_loop_end_8_: +# ori _tmp_16_,_letBind_2_,0 + ori $16, $6, 0 +# was: ori _mainres_1_, _tmp_16_, 0 + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + jal putint +# was: jal putint, $2 + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + addi $29, $29, 12 + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/reduce.fo b/fasto/tests/reduce.fo new file mode 100644 index 0000000..23b9a44 --- /dev/null +++ b/fasto/tests/reduce.fo @@ -0,0 +1,5 @@ +fun int incr(int a, int b) = a + b + +fun int main() = + let n = reduce(incr, 0, {1, 2, 3}) in + write(n) diff --git a/fasto/tests/reduce.in b/fasto/tests/reduce.in new file mode 100644 index 0000000..e69de29 diff --git a/fasto/tests/reduce.out b/fasto/tests/reduce.out new file mode 100644 index 0000000..80af6ca --- /dev/null +++ b/fasto/tests/reduce.out @@ -0,0 +1 @@ +6 diff --git a/fasto/tests/replicate.asm b/fasto/tests/replicate.asm new file mode 100644 index 0000000..a6af3d4 --- /dev/null +++ b/fasto/tests/replicate.asm @@ -0,0 +1,257 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $21, -28($29) + sw $20, -24($29) + sw $19, -20($29) + sw $18, -16($29) + sw $17, -12($29) + sw $16, -8($29) + addi $29, $29, -32 + ori $2, $0, 7 +# was: ori _size_reg_3_, $0, 7 + bgez $2, _safe_lab_4_ +# was: bgez _size_reg_3_, _safe_lab_4_ + ori $5, $0, 4 +# was: ori $5, $0, 4 + la $6, _Msg_IllegalArraySize_ +# was: la $6, _Msg_IllegalArraySize_ + j _RuntimeError_ +_safe_lab_4_: + ori $7, $0, 0 +# was: ori _elem_reg_5_, $0, 0 + ori $3, $28, 0 +# was: ori _letBind_2_, $28, 0 + addi $4, $2, 3 +# was: addi _tmp_11_, _size_reg_3_, 3 + sra $4, $4, 2 +# was: sra _tmp_11_, _tmp_11_, 2 + sll $4, $4, 2 +# was: sll _tmp_11_, _tmp_11_, 2 + addi $4, $4, 4 +# was: addi _tmp_11_, _tmp_11_, 4 + add $28, $28, $4 +# was: add $28, $28, _tmp_11_ + sw $2, 0($3) +# was: sw _size_reg_3_, 0(_letBind_2_) + addi $4, $3, 4 +# was: addi _addr_reg_6_, _letBind_2_, 4 + ori $5, $0, 0 +# was: ori _i_reg_7_, $0, 0 +_loop_beg_8_: + sub $6, $5, $2 +# was: sub _tmp_reg_10_, _i_reg_7_, _size_reg_3_ + bgez $6, _loop_end_9_ +# was: bgez _tmp_reg_10_, _loop_end_9_ + sb $7, 0($4) +# was: sb _elem_reg_5_, 0(_addr_reg_6_) + addi $4, $4, 1 +# was: addi _addr_reg_6_, _addr_reg_6_, 1 + addi $5, $5, 1 +# was: addi _i_reg_7_, _i_reg_7_, 1 + j _loop_beg_8_ +_loop_end_9_: +# ori _arr_reg_13_,_letBind_2_,0 + lw $16, 0($3) +# was: lw _size_reg_12_, 0(_arr_reg_13_) + ori $17, $28, 0 +# was: ori _mainres_1_, $28, 0 + addi $2, $16, 3 +# was: addi _tmp_24_, _size_reg_12_, 3 + sra $2, $2, 2 +# was: sra _tmp_24_, _tmp_24_, 2 + sll $2, $2, 2 +# was: sll _tmp_24_, _tmp_24_, 2 + addi $2, $2, 4 +# was: addi _tmp_24_, _tmp_24_, 4 + add $28, $28, $2 +# was: add $28, $28, _tmp_24_ + sw $16, 0($17) +# was: sw _size_reg_12_, 0(_mainres_1_) + addi $19, $17, 4 +# was: addi _addr_reg_16_, _mainres_1_, 4 + ori $18, $0, 0 +# was: ori _i_reg_17_, $0, 0 + addi $20, $3, 4 +# was: addi _elem_reg_14_, _arr_reg_13_, 4 +_loop_beg_18_: + sub $2, $18, $16 +# was: sub _tmp_reg_20_, _i_reg_17_, _size_reg_12_ + bgez $2, _loop_end_19_ +# was: bgez _tmp_reg_20_, _loop_end_19_ + lb $21, 0($20) +# was: lb _res_reg_15_, 0(_elem_reg_14_) + addi $20, $20, 1 +# was: addi _elem_reg_14_, _elem_reg_14_, 1 +# ori _tmp_22_,_res_reg_15_,0 +# ori _fun_arg_res_21_,_tmp_22_,0 + la $2, _true +# was: la $2, _true + bne $21, $0, _wBoolF_23_ +# was: bne _fun_arg_res_21_, $0, _wBoolF_23_ + la $2, _false +# was: la $2, _false +_wBoolF_23_: + jal putstring +# was: jal putstring, $2 +# ori _res_reg_15_,_fun_arg_res_21_,0 + sb $21, 0($19) +# was: sb _res_reg_15_, 0(_addr_reg_16_) + addi $19, $19, 1 +# was: addi _addr_reg_16_, _addr_reg_16_, 1 + addi $18, $18, 1 +# was: addi _i_reg_17_, _i_reg_17_, 1 + j _loop_beg_18_ +_loop_end_19_: + ori $2, $17, 0 +# was: ori $2, _mainres_1_, 0 + addi $29, $29, 32 + lw $21, -28($29) + lw $20, -24($29) + lw $19, -20($29) + lw $18, -16($29) + lw $17, -12($29) + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/replicate.fo b/fasto/tests/replicate.fo new file mode 100644 index 0000000..1d47242 --- /dev/null +++ b/fasto/tests/replicate.fo @@ -0,0 +1,5 @@ +fun bool writeBool(bool b) = write(b) + +fun [bool] main() = + let fs = replicate(7, false) in + map(writeBool, fs) diff --git a/fasto/tests/replicate.in b/fasto/tests/replicate.in new file mode 100644 index 0000000..e69de29 diff --git a/fasto/tests/replicate.out b/fasto/tests/replicate.out new file mode 100644 index 0000000..28f6ac4 --- /dev/null +++ b/fasto/tests/replicate.out @@ -0,0 +1,7 @@ +false +false +false +false +false +false +false diff --git a/fasto/tests/scan.asm b/fasto/tests/scan.asm new file mode 100644 index 0000000..665ad98 --- /dev/null +++ b/fasto/tests/scan.asm @@ -0,0 +1,280 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function main +main: + sw $31, -4($29) + sw $21, -28($29) + sw $20, -24($29) + sw $19, -20($29) + sw $18, -16($29) + sw $17, -12($29) + sw $16, -8($29) + addi $29, $29, -32 + ori $4, $0, 3 +# was: ori _size_reg_3_, $0, 3 + ori $3, $28, 0 +# was: ori _letBind_2_, $28, 0 + sll $2, $4, 2 +# was: sll _tmp_6_, _size_reg_3_, 2 + addi $2, $2, 4 +# was: addi _tmp_6_, _tmp_6_, 4 + add $28, $28, $2 +# was: add $28, $28, _tmp_6_ + sw $4, 0($3) +# was: sw _size_reg_3_, 0(_letBind_2_) + addi $4, $3, 4 +# was: addi _addr_reg_4_, _letBind_2_, 4 + ori $2, $0, 1 +# was: ori _tmp_reg_5_, $0, 1 + sw $2, 0($4) +# was: sw _tmp_reg_5_, 0(_addr_reg_4_) + addi $4, $4, 4 +# was: addi _addr_reg_4_, _addr_reg_4_, 4 + ori $2, $0, 2 +# was: ori _tmp_reg_5_, $0, 2 + sw $2, 0($4) +# was: sw _tmp_reg_5_, 0(_addr_reg_4_) + addi $4, $4, 4 +# was: addi _addr_reg_4_, _addr_reg_4_, 4 + ori $2, $0, 3 +# was: ori _tmp_reg_5_, $0, 3 + sw $2, 0($4) +# was: sw _tmp_reg_5_, 0(_addr_reg_4_) + addi $4, $4, 4 +# was: addi _addr_reg_4_, _addr_reg_4_, 4 +# ori _inp_reg_9_,_letBind_2_,0 + ori $8, $0, 0 +# was: ori _acc_reg_13_, $0, 0 + lw $4, 0($3) +# was: lw _size_reg_10_, 0(_inp_reg_9_) + addi $3, $3, 4 +# was: addi _inp_reg_9_, _inp_reg_9_, 4 + ori $2, $28, 0 +# was: ori _letBind_7_, $28, 0 + sll $5, $4, 2 +# was: sll _tmp_16_, _size_reg_10_, 2 + addi $5, $5, 4 +# was: addi _tmp_16_, _tmp_16_, 4 + add $28, $28, $5 +# was: add $28, $28, _tmp_16_ + sw $4, 0($2) +# was: sw _size_reg_10_, 0(_letBind_7_) + addi $6, $2, 4 +# was: addi _res_reg_8_, _letBind_7_, 4 + ori $5, $0, 0 +# was: ori _ind_var_11_, $0, 0 +_loop_beg_14_: + sub $7, $5, $4 +# was: sub _tmp_reg_12_, _ind_var_11_, _size_reg_10_ + bgez $7, _loop_end_15_ +# was: bgez _tmp_reg_12_, _loop_end_15_ + lw $7, 0($3) +# was: lw _tmp_reg_12_, 0(_inp_reg_9_) +# ori _plus_L_18_,_acc_reg_13_,0 +# ori _plus_R_19_,_tmp_reg_12_,0 + add $8, $8, $7 +# was: add _fun_arg_res_17_, _plus_L_18_, _plus_R_19_ +# ori _acc_reg_13_,_fun_arg_res_17_,0 + sw $8, 0($6) +# was: sw _acc_reg_13_, 0(_res_reg_8_) + addi $6, $6, 4 +# was: addi _res_reg_8_, _res_reg_8_, 4 + addi $3, $3, 4 +# was: addi _inp_reg_9_, _inp_reg_9_, 4 + addi $5, $5, 1 +# was: addi _ind_var_11_, _ind_var_11_, 1 + j _loop_beg_14_ +_loop_end_15_: +# ori _arr_reg_21_,_letBind_7_,0 + lw $17, 0($2) +# was: lw _size_reg_20_, 0(_arr_reg_21_) + ori $16, $28, 0 +# was: ori _mainres_1_, $28, 0 + sll $3, $17, 2 +# was: sll _tmp_31_, _size_reg_20_, 2 + addi $3, $3, 4 +# was: addi _tmp_31_, _tmp_31_, 4 + add $28, $28, $3 +# was: add $28, $28, _tmp_31_ + sw $17, 0($16) +# was: sw _size_reg_20_, 0(_mainres_1_) + addi $18, $16, 4 +# was: addi _addr_reg_24_, _mainres_1_, 4 + ori $19, $0, 0 +# was: ori _i_reg_25_, $0, 0 + addi $20, $2, 4 +# was: addi _elem_reg_22_, _arr_reg_21_, 4 +_loop_beg_26_: + sub $2, $19, $17 +# was: sub _tmp_reg_28_, _i_reg_25_, _size_reg_20_ + bgez $2, _loop_end_27_ +# was: bgez _tmp_reg_28_, _loop_end_27_ + lw $21, 0($20) +# was: lw _res_reg_23_, 0(_elem_reg_22_) + addi $20, $20, 4 +# was: addi _elem_reg_22_, _elem_reg_22_, 4 +# ori _tmp_30_,_res_reg_23_,0 +# ori _fun_arg_res_29_,_tmp_30_,0 + ori $2, $21, 0 +# was: ori $2, _fun_arg_res_29_, 0 + jal putint +# was: jal putint, $2 +# ori _res_reg_23_,_fun_arg_res_29_,0 + sw $21, 0($18) +# was: sw _res_reg_23_, 0(_addr_reg_24_) + addi $18, $18, 4 +# was: addi _addr_reg_24_, _addr_reg_24_, 4 + addi $19, $19, 1 +# was: addi _i_reg_25_, _i_reg_25_, 1 + j _loop_beg_26_ +_loop_end_27_: + ori $2, $16, 0 +# was: ori $2, _mainres_1_, 0 + addi $29, $29, 32 + lw $21, -28($29) + lw $20, -24($29) + lw $19, -20($29) + lw $18, -16($29) + lw $17, -12($29) + lw $16, -8($29) + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/scan.fo b/fasto/tests/scan.fo new file mode 100644 index 0000000..64553f0 --- /dev/null +++ b/fasto/tests/scan.fo @@ -0,0 +1,8 @@ +fun int incr(int a, int b) = a + b + +fun int writeInt(int n) = write(n) + +fun [int] main() = + let a = {1, 2, 3} in + let b = scan(incr, 0, a) in + map(writeInt, b) diff --git a/fasto/tests/scan.in b/fasto/tests/scan.in new file mode 100644 index 0000000..e69de29 diff --git a/fasto/tests/scan.out b/fasto/tests/scan.out new file mode 100644 index 0000000..d0b145d --- /dev/null +++ b/fasto/tests/scan.out @@ -0,0 +1 @@ +1 3 6 diff --git a/fasto/tests/short_circuit.asm b/fasto/tests/short_circuit.asm new file mode 100644 index 0000000..a777142 --- /dev/null +++ b/fasto/tests/short_circuit.asm @@ -0,0 +1,193 @@ + .text 0x00400000 + .globl main + la $28, _heap_ + la $4, _true +# was: la _true_addr, _true + ori $3, $0, 4 +# was: ori _true_init, $0, 4 + sw $3, 0($4) +# was: sw _true_init, 0(_true_addr) + la $3, _false +# was: la _false_addr, _false + ori $4, $0, 5 +# was: ori _false_init, $0, 5 + sw $4, 0($3) +# was: sw _false_init, 0(_false_addr) + jal main +_stop_: + ori $2, $0, 10 + syscall +# Function no_way +no_way: + sw $31, -4($29) + addi $29, $29, -8 + jal no_way +# was: jal no_way, +# ori _no_wayres_1_,$2,0 +# ori $2,_no_wayres_1_,0 + addi $29, $29, 8 + lw $31, -4($29) + jr $31 +# Function main +main: + sw $31, -4($29) + addi $29, $29, -8 + ori $3, $0, 0 +# was: ori _tmp_4_, $0, 0 +# ori _letBind_3_,_tmp_4_,0 + la $2, _true +# was: la $2, _true + bne $3, $0, _wBoolF_5_ +# was: bne _letBind_3_, $0, _wBoolF_5_ + la $2, _false +# was: la $2, _false +_wBoolF_5_: + jal putstring +# was: jal putstring, $2 + ori $3, $0, 1 +# was: ori _tmp_7_, $0, 1 + bne $3, $0, _endLabel_8_ +# was: bne _tmp_7_, $0, _endLabel_8_ + jal no_way +# was: jal no_way, + ori $3, $2, 0 +# was: ori _tmp_7_, $2, 0 +_endLabel_8_: +# ori _letBind_6_,_tmp_7_,0 + la $2, _true +# was: la $2, _true + bne $3, $0, _wBoolF_9_ +# was: bne _letBind_6_, $0, _wBoolF_9_ + la $2, _false +# was: la $2, _false +_wBoolF_9_: + jal putstring +# was: jal putstring, $2 + ori $2, $0, 1 +# was: ori _mainres_2_, $0, 1 +# ori $2,_mainres_2_,0 + addi $29, $29, 8 + lw $31, -4($29) + jr $31 +ord: + jr $31 +chr: + andi $2, $2, 255 + jr $31 +putint: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 1 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getint: + ori $2, $0, 5 + syscall + jr $31 +putchar: + addi $29, $29, -8 + sw $2, 0($29) + sw $4, 4($29) + ori $4, $2, 0 + ori $2, $0, 11 + syscall + ori $2, $0, 4 + la $4, _space_ + syscall + lw $2, 0($29) + lw $4, 4($29) + addi $29, $29, 8 + jr $31 +getchar: + addi $29, $29, -8 + sw $4, 0($29) + sw $5, 4($29) + ori $2, $0, 12 + syscall + ori $5, $2, 0 + ori $2, $0, 4 + la $4, _cr_ + syscall + ori $2, $5, 0 + lw $4, 0($29) + lw $5, 4($29) + addi $29, $29, 8 + jr $31 +putstring: + addi $29, $29, -16 + sw $2, 0($29) + sw $4, 4($29) + sw $5, 8($29) + sw $6, 12($29) + lw $4, 0($2) + addi $5, $2, 4 + add $6, $5, $4 + ori $2, $0, 11 +putstring_begin: + sub $4, $5, $6 + bgez $4, putstring_done + lb $4, 0($5) + syscall + addi $5, $5, 1 + j putstring_begin +putstring_done: + lw $2, 0($29) + lw $4, 4($29) + lw $5, 8($29) + lw $6, 12($29) + addi $29, $29, 16 + jr $31 +_RuntimeError_: + la $4, _ErrMsg_ + ori $2, $0, 4 + syscall + ori $4, $5, 0 + ori $2, $0, 1 + syscall + la $4, _colon_space_ + ori $2, $0, 4 + syscall + ori $4, $6, 0 + ori $2, $0, 4 + syscall + la $4, _cr_ + ori $2, $0, 4 + syscall + j _stop_ + .data +# Fixed strings for I/O +_ErrMsg_: + .asciiz "Runtime error at line " +_colon_space_: + .asciiz ": " +_cr_: + .asciiz "\n" +_space_: + .asciiz " " +# Message strings for specific errors +_Msg_IllegalArraySize_: + .asciiz "negative array size" +_Msg_IllegalIndex_: + .asciiz "array index out of bounds" +_Msg_DivZero_: + .asciiz "division by zero" +# String Literals + .align 2 +_true: + .space 4 + .asciiz "true" + .align 2 +_false: + .space 4 + .asciiz "false" + .align 2 +_heap_: + .space 100000 \ No newline at end of file diff --git a/fasto/tests/short_circuit.fo b/fasto/tests/short_circuit.fo new file mode 100644 index 0000000..9b9d355 --- /dev/null +++ b/fasto/tests/short_circuit.fo @@ -0,0 +1,6 @@ +fun bool no_way() = no_way() + +fun bool main() = + let a = write(false && no_way()) in + let b = write(true || no_way()) in + true diff --git a/fasto/tests/short_circuit.in b/fasto/tests/short_circuit.in new file mode 100644 index 0000000..e69de29 diff --git a/fasto/tests/short_circuit.out b/fasto/tests/short_circuit.out new file mode 100644 index 0000000..efa9e8f --- /dev/null +++ b/fasto/tests/short_circuit.out @@ -0,0 +1 @@ +falsetrue diff --git a/fasto/tools/emacs/README.md b/fasto/tools/emacs/README.md new file mode 100644 index 0000000..6129717 --- /dev/null +++ b/fasto/tools/emacs/README.md @@ -0,0 +1,8 @@ +# Emacs mode for Fasto + +This Emacs mode provides: + + + syntax highlighting, and + + automatic indentation + +for Fasto programs. See the file itself for installation instructions. diff --git a/fasto/tools/emacs/fasto-mode.el b/fasto/tools/emacs/fasto-mode.el new file mode 100644 index 0000000..64b4b39 --- /dev/null +++ b/fasto/tools/emacs/fasto-mode.el @@ -0,0 +1,362 @@ +;;; fasto-mode.el --- major mode for editing Fasto source files + +;; Copyright (C) DIKU 2014-2017, University of Copenhagen +;; Based on futhark-mode.el + +;;; Commentary: +;; This mode provides syntax highlighting and automatic indentation for +;; Fasto source files. +;; +;; This mode provides the following features for Fasto source files: +;; +;; + syntax highlighting +;; + automatic indentation +;; +;; To load fasto-mode automatically on Emacs startup, make sure this +;; file is in your load path and then require the mode, e.g. something +;; like this: +;; +;; (add-to-list 'load-path "path/to/fasto/tools/emacs") +;; (require 'fasto-mode) +;; +;; This will also tell your Emacs that ".fo" files are to be handled by +;; fasto-mode. +;; +;; Define your local keybindings in `fasto-mode-map', and add startup +;; functions to `fasto-mode-hook'. +;; +;; Report bugs to Niels. + + +;;; Basics + +(require 'cl) ; `some' + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.fo\\'" . fasto-mode)) + +(defvar fasto-mode-hook nil + "Hook for fasto-mode. Is run whenever the mode is entered.") + +(defvar fasto-mode-map + (make-keymap) + "Keymap for fasto-mode.") + +(defconst fasto-keywords + '("if" "then" "else" "let" "in" "fun" "fn" "op") + "All Fasto keywords.") + +(defconst fasto-builtin-functions + '("iota" "replicate" "map" "reduce" "scan" "read" "write" "not") + "All Fasto builtin SOACs, functions and non-symbolic operators.") + +(defconst fasto-builtin-operators + '("+" "-" "==" "<" "~" "&&" "||") + "All Fasto builtin symbolic operators.") + +(defconst fasto-builtin-types + '("int" "bool" "char") + "All Fasto builtin primitive types.") + +(defconst fasto-booleans + '("true" "false") + "All Fasto booleans.") + +(defconst fasto-type + (concat "\\[*" "\\<" (regexp-opt fasto-builtin-types 'nil) "\\>" "\\]*") + "A regex describing a Fasto type.") + +(defconst fasto-var + (concat "\\(?:" "[_'[:alnum:]]+" "\\)") + "A regex describing a Fasto variable.") + + +;;; Highlighting + +(let ( + (ws "[[:space:]\n]*") + (ws1 "[[:space:]\n]+") + ) + (defvar fasto-font-lock + `( + + ;; Function declarations. + (,(concat "fun" ws1 fasto-type ws1 "\\(" fasto-var "\\)") + . '(1 font-lock-function-name-face)) + + ;; Function parameters. + (,(concat "\\(?:" "(" "\\|" "," "\\)" ws + fasto-type ws1 "\\(" fasto-var "\\)") + . '(1 font-lock-variable-name-face)) + + ;; Let declarations. + (,(concat "let" ws1 + "\\(" fasto-var "\\)") + . '(1 font-lock-variable-name-face)) + + ;; Keywords. + (,(regexp-opt fasto-keywords 'words) + . font-lock-keyword-face) + + ;; Types. + (,fasto-type + . font-lock-type-face) + + ;; Builtins. + ;;; Functions. + (,(regexp-opt fasto-builtin-functions 'words) + . font-lock-builtin-face) + ;;; Operators. + (,(regexp-opt fasto-builtin-operators) + . font-lock-builtin-face) + + ;; Constants. + ;;; Booleans. + (,(regexp-opt fasto-booleans 'words) + . font-lock-constant-face) + + ) + "Highlighting expressions for Fasto.") + ) + +(defvar fasto-mode-syntax-table + (let ((st (make-syntax-table))) + ;; Define the // line comment syntax. + (modify-syntax-entry ?/ ". 123" st) + (modify-syntax-entry ?\n ">" st) + ;; Make apostrophe and underscore be part of variable names. + ;; Technically, they should probably be part of the symbol class, + ;; but it works out better for some of the regexpes if they are part + ;; of the word class. + (modify-syntax-entry ?' "w" st) + (modify-syntax-entry ?_ "w" st) + (modify-syntax-entry ?\\ "_" st) + st) + "Syntax table used in `fasto-mode'.") + + +;;; Indentation + +(defvar fasto-indent-level 2 + "The basic indent level for fasto-mode.") + +(defun fasto-indent-line () + "Indent current line as Fasto code." + (let ((savep (> (current-column) (current-indentation))) + (indent (or (fasto-calculate-indentation) + (current-indentation)))) + (if savep ; The cursor is beyond leading whitespace. + (save-excursion (indent-line-to indent)) + (indent-line-to indent)))) + +(defun fasto-calculate-indentation () + "Calculate the indentation for the current line. +In general, prefer as little indentation as possible." + (let ((parse-sexp-lookup-properties t) + (parse-sexp-ignore-comments t)) + + (save-excursion + (fasto-beginning-of-line-text) + + ;; The following code is fickle and deceptive. Don't change it + ;; unless you kind of know what you're doing! + (or + + ;; Align comment to next non-comment line. + (and (looking-at comment-start) + (forward-comment (count-lines (point-min) (point))) + (current-column)) + + ;; Align global function definitions to column 0. + (and (fasto-looking-at-word "fun") + 0) + + ;; Align closing parentheses and commas to the matching opening + ;; parenthesis. + (save-excursion + (and (looking-at (regexp-opt '(")" "]" ","))) + (ignore-errors + (backward-up-list 1) + (current-column)))) + + ;; Align "in" or "let" to the closest previous "let". + (save-excursion + (and (or (fasto-looking-at-word "in") + (fasto-looking-at-word "let")) + (let ((m + (save-excursion + (fasto-keyword-backward "let")) + )) + (and (not (eq nil m)) + (goto-char m) + (current-column))))) + + ;; Otherwise, if the previous code line ends with "in" align to + ;; the matching "let" column. + (save-excursion + (and (fasto-backward-part) + (looking-at "\\"))) + +(defun fasto-keyword-backward (word) + "Go to a keyword WORD before the current position. +Set mark and return t if found; return nil otherwise." + (let (;; Only look in the current paren-delimited code if present. + (startp (point)) + (topp (or (save-excursion (ignore-errors + (backward-up-list 1) + (point))) + (max + (or (save-excursion (fasto-keyword-backward-raw "fun")) + 0) + (or (save-excursion (fasto-keyword-backward-raw "entry")) + 0)))) + (result nil)) + + (while (and (not result) + (fasto-backward-part) + (>= (point) topp)) + + (if (fasto-looking-at-word word) + (setq result (point)))) + + (or result + (progn + (goto-char startp) + nil)))) + +(defun fasto-keyword-backward-raw (word) + "Go to a keyword WORD before the current position. +Ignore any program structure." + (let ((pstart (point))) + (while (and (fasto-backward-part) + (not (fasto-looking-at-word word)))) + (and (fasto-looking-at-word word) + (point)))) + + +;;; Actual mode declaration + +(define-derived-mode fasto-mode fundamental-mode "Fasto" + "Major mode for editing Fasto source files." + :syntax-table fasto-mode-syntax-table + (set (make-local-variable 'font-lock-defaults) '(fasto-font-lock)) + (set (make-local-variable 'indent-line-function) 'fasto-indent-line) + (set (make-local-variable 'indent-region-function) nil) + (set (make-local-variable 'comment-start) "//") + (set (make-local-variable 'comment-padding) " ")) + +(provide 'fasto-mode) + +;;; fasto-mode.el ends here diff --git a/fasto/tools/vim/README.txt b/fasto/tools/vim/README.txt new file mode 100644 index 0000000..7306fb4 --- /dev/null +++ b/fasto/tools/vim/README.txt @@ -0,0 +1,13 @@ +Vim syntax highlighting for Fasto. +Created by Oleksandr Shturmov on November 1, 2014. + +To install: + +1. Copy fasto.vim into your ~/.vim/syntax/ (create the directory if it doesn't +already exist). + +2. Add the following line to your ~/.vimrc. This will make sure that any .fo +file is recognised as a fasto file. It is important that fasto.vim is present +in ~/.vim/syntax/ for syntax highlighting to work. + +au BufNewFile,BufRead *.fo setlocal ft=fasto diff --git a/fasto/tools/vim/fasto.vim b/fasto/tools/vim/fasto.vim new file mode 100644 index 0000000..e955c3d --- /dev/null +++ b/fasto/tools/vim/fasto.vim @@ -0,0 +1,22 @@ +" Vim syntax file for Fasto. +" Created by Oleksandr Shturmov on November 1, 2014. + +if exists("b:current_syntax") + finish +end + +syn keyword fastoKeyword fun fn op if then else let in +syn keyword fastoType int char bool +syn keyword fastoFunction read write iota replicate map reduce scan + +syn match fastoString "\"\([ -!#-&(-[\]-~]\|\\[\x0-\x7f]\)*\"" + +syn match fastoComment "//.*$" + +highlight link fastoKeyword Keyword +highlight link fastoType Type +highlight link fastoFunction Function + +highlight link fastoString String + +highlight link fastoComment Comment