diff options
Diffstat (limited to 'syntax.sml')
| -rw-r--r-- | syntax.sml | 231 |
1 files changed, 0 insertions, 231 deletions
diff --git a/syntax.sml b/syntax.sml deleted file mode 100644 index 2f7a96e..0000000 --- a/syntax.sml +++ /dev/null @@ -1,231 +0,0 @@ -structure Syntax = -struct - (* SML syntax *) - datatype etype = - Tyvar of string - | Tycon of etype list * string - | TyTuple of etype list - | Tyfun of etype * etype - - datatype pat = - PWild - | PVar of string - | PInt of int - | PTuple of pat list - | PCon of string list * pat - - datatype expr = - EIdent of string list - | EBuiltin of string - | EInt of int - | EStr of string - | ETuple of expr list - | EList of expr list - | EApp of expr * expr - | ETyped of expr * etype - | EAndAlso of expr * expr - | EOrElse of expr * expr - | ELet of dec list * expr - | ELambda of pat * expr - | ECase of expr * (pat * expr) list - - and dec = - DVal of pat * expr - | DValRec of pat * expr - | DFun of string * (pat list * expr) list - | DDatatype of string * (string * etype option) list - | DStruct of string * dec list - - (* Lambda language *) - type var = int - - datatype primop = - PExit - | PAdd - | PSub - | PMul - | PDiv - | PLess - | PEq - | PIf - | PRead - | PWrite - | PWriteErr - - datatype lexp = - LVar of var - | LFn of var * lexp - | LFix of (var * var * lexp) list * lexp - | LApp of lexp * lexp - | LInt of int - | LString of string - | LRecord of lexp list - | LSelect of int * lexp - | LPrim of primop - | LSwitch of lexp * (int * lexp) list * lexp option - - (* CPS *) - datatype value = - VVar of var - | VLabel of var - | VInt of int - - datatype cexp = - CRecord of ((value * int list) list * var) list * cexp - | CSelect of int * value * var * cexp - | CApp of value * value list - | CFix of (var * var list * cexp) list * cexp - | CPrimop of primop * value list * var list * cexp list - - datatype opcode = - OAlloc of var * value - | OCall - | OPoke of int * var * value - | OPeek of var * int * value - | OShuf of var * value - | OExit of value - | OAdd of var * value * value - | OSub of var * value * value - | OMul of var * value * value - | ODiv of var * value * value - | OLess of var * value * value - | OEq of var * value * value - | OIf of value * var - | OLabel of var - | ORead of var * var * value * value - | OWrite of var * value * value - | OWriteErr of var * value * value - - fun listToString (show : 'a -> string) (l : 'a list) = - "[" ^ String.concatWith ", " (map show l) ^ "]" - - fun multilineListToString (show : string -> 'a -> string) (indent : string) (l : 'a list) = - case l of - [] => "[]" - | [x] => "[ " ^ show (indent ^ " ") x ^ " ]" - | (x :: xs) => - let val indent' = indent ^ " " - in "[ " ^ show indent' x ^ concat (map (fn x => "\n" ^ indent ^ ", " ^ show indent' x) xs) ^ "\n" ^ indent ^ "]" - end - - fun quote (s : string) : string = "\"" ^ String.toString s ^ "\"" - - fun optionToString (show : 'a -> string) (x : 'a option) = - case x of - NONE => "NONE" - | SOME x => "SOME " ^ show x - - fun etypeToString (x : etype) : string = - case x of - Tyvar s => "Tyvar " ^ quote s - | Tycon (args, con) => "Tycon (" ^ listToString etypeToString args ^ ", " ^ quote con ^ ")" - | TyTuple args => "TyTuple " ^ listToString etypeToString args - | Tyfun (a, b) => "Tyfun (" ^ etypeToString a ^ ", " ^ etypeToString b ^ ")" - - fun patToString (p : pat) : string = - case p of - PWild => "PWild" - | PVar v => "PVar " ^ quote v - | PInt i => "PInt " ^ Int.toString i - | PTuple pats => "PTuple " ^ listToString patToString pats - | PCon (con, v) => "PCon " ^ "(" ^ listToString quote con ^ ", " ^ patToString v ^ ")" - - fun exprToStringI (indent : string) (x : expr) : string = - let val self = exprToStringI indent - in case x of - EIdent i => "EIdent " ^ listToString quote i - | EBuiltin b => "EBuiltin " ^ quote b - | EInt i => "EInt " ^ Int.toString i - | EStr s => "EStr " ^ quote s - | ETuple xs => "ETuple " ^ listToString self xs - | EList l => "EList " ^ listToString self l - | EApp (f, x) => "EApp (" ^ self f ^ ", " ^ self x ^ ")" - | ETyped (e, t) => "ETyped (" ^ self e ^ ", " ^ etypeToString t ^ ")" - | EAndAlso (a, b) => "EAndAlso (" ^ self a ^ ", " ^ self b ^ ")" - | EOrElse (a, b) => "EOrElse (" ^ self a ^ ", " ^ self b ^ ")" - | ELet (decs, e) => "ELet (" ^ multilineListToString decToStringI indent decs ^ ", " ^ self e ^ ")" - | ELambda (pat, e) => "ELambda (" ^ patToString pat ^ ", " ^ exprToStringI indent e ^ ")" - | ECase (e, branches) => "ECase (" ^ self e ^ ", " ^ multilineListToString (fn indent => fn (pat, body) => "(" ^ patToString pat ^ ", " ^ exprToStringI indent body ^ ")") indent branches ^ ")" - end - - and decToStringI (indent : string) (x : dec) : string = - case x of - DVal (p, e) => "DVal (" ^ patToString p ^ ", " ^ exprToStringI indent e ^ ")" - | DValRec (p, e) => "DValRec (" ^ patToString p ^ ", " ^ exprToStringI indent e ^ ")" - | DFun (name, cases) => "DFun (" ^ quote name ^ ", " ^ multilineListToString (fn indent => fn (ps, b) => "(" ^ listToString patToString ps ^ ", " ^ exprToStringI indent b ^ ")") indent cases ^ ")" - | DDatatype (name, arms) => "DDatatype (" ^ quote name ^ ", " ^ listToString (fn (con, v) => "(" ^ quote con ^ ", " ^ optionToString etypeToString v ^ ")") arms ^ ")" - | DStruct (name, decls) => "DStruct (" ^ quote name ^ ",\n" ^ indent ^ "\t" ^ multilineListToString decToStringI (indent ^ "\t") decls ^ ")" - - val exprToString : expr -> string = exprToStringI "" - - val decToString : dec -> string = decToStringI "" - - fun primopToString (x : primop) : string = - case x of - PExit => "PExit" - | PAdd => "PAdd" - | PSub => "PSub" - | PMul => "PMul" - | PDiv => "PDiv" - | PLess => "PLess" - | PEq => "PEq" - | PIf => "PIf" - | PRead => "PRead" - | PWrite => "PWrite" - | PWriteErr => "PWriteErr" - - fun lexpToStringI (indent : string) (x : lexp) : string = - case x of - LVar v => "LVar " ^ Int.toString v - | LFn (arg, expr) => "LFun (" ^ Int.toString arg ^ ",\n" ^ indent ^ "\t" ^ lexpToStringI (indent ^ "\t") expr ^ ")" - | LFix (decls, body) => "LFix (" ^ multilineListToString (fn indent => fn (arg, var, expr) => "(" ^ Int.toString arg ^ ", " ^ Int.toString var ^ ", " ^ lexpToStringI indent expr ^ ")") indent decls ^ ",\n" ^ indent ^ lexpToStringI indent body ^ ")" - | LApp (a, b) => "LApp (" ^ lexpToStringI indent a ^ ",\n" ^ indent ^ "\t" ^ lexpToStringI (indent ^ "\t") b ^ ")" - | LInt i => "LInt " ^ Int.toString i - | LString s => "LString " ^ quote s - | LRecord l => "LRecord " ^ listToString (lexpToStringI indent) l - | LSelect (i, r) => "LSelect (" ^ Int.toString i ^ ", " ^ lexpToStringI indent r ^ ")" - | LPrim p => "LPrim " ^ primopToString p - | LSwitch (e, arms, otherwise) => "LSwitch (" ^ lexpToStringI indent e ^ ",\n" ^ indent ^ "\t" ^ multilineListToString (fn indent => fn (x, e) => "(" ^ Int.toString x ^ ", " ^ lexpToStringI indent e ^ ")") (indent ^ "\t") arms ^ ",\n" ^ indent ^ "\t" ^ optionToString (lexpToStringI (indent ^ "\t")) otherwise ^ ")" - - fun lexpToString (x : lexp) : string = lexpToStringI "" x - - fun valueToString (x : value) : string = - case x of - VVar v => "VVar " ^ Int.toString v - | VLabel l => "VLabel " ^ Int.toString l - | VInt i => "VInt " ^ Int.toString i - - fun cexpToStringI (indent : string) (x : cexp) : string = - let - val self = cexpToStringI indent - val newIndent = indent ^ "\t" - in case x of - CRecord (records, c) => "CRecord (" ^ listToString (fn (a, b) => listToString (fn (x, y) => "(" ^ valueToString x ^ ", " ^ listToString Int.toString y ^ ")") a ^ ", " ^ Int.toString b ^ ")") records ^ ",\n" ^ indent ^ self c ^ ")" - | CSelect (a, b, c, d) => "CSelect (" ^ Int.toString a ^ ", " ^ valueToString b ^ ", " ^ Int.toString c ^ ",\n" ^ indent ^ self d ^ ")" - | CApp (a, b) => "CApp (" ^ valueToString a ^ ", " ^ listToString valueToString b ^ ")" - | CFix (a, b) => "CFix (" ^ multilineListToString (fn indent' => fn (x, y, z) => "(" ^ Int.toString x ^ ", " ^ listToString Int.toString y ^ ",\n" ^ indent' ^ "\t" ^ cexpToStringI (indent' ^ "\t") z) newIndent a ^ ",\n" ^ newIndent ^ cexpToStringI newIndent b ^ ")" - | CPrimop (a, b, c, d) => "CPrimop (" ^ primopToString a ^ ", " ^ listToString valueToString b ^ ", " ^ listToString Int.toString c ^ ",\n" ^ indent ^ multilineListToString cexpToStringI indent d ^ ")" - end - - val cexpToString : cexp -> string = cexpToStringI "" - - fun opcodeToString (oper : opcode) : string = - case oper of - OAlloc (r, s) => "Var " ^ Int.toString r ^ " = OAlloc (" ^ valueToString s ^ ")" - | OCall => "OCall" - | OPoke (i, p, v) => "Var " ^ Int.toString p ^ "[" ^ Int.toString i ^ "] = " ^ valueToString v - | OPeek (r, i, p) => "Var " ^ Int.toString r ^ " = " ^ valueToString p ^ "[" ^ Int.toString i ^ "]" - | OShuf (d, s) => "Var " ^ Int.toString d ^ " = " ^ valueToString s - | OExit v => "OExit (" ^ valueToString v ^ ")" - | OAdd (r, v1, v2) => "Var " ^ Int.toString r ^ " = OAdd (" ^ valueToString v1 ^ ", " ^ valueToString v2 ^ ")" - | OSub (r, v1, v2) => "Var " ^ Int.toString r ^ " = OSub (" ^ valueToString v1 ^ ", " ^ valueToString v2 ^ ")" - | OMul (r, v1, v2) => "Var " ^ Int.toString r ^ " = OMul (" ^ valueToString v1 ^ ", " ^ valueToString v2 ^ ")" - | ODiv (r, v1, v2) => "Var " ^ Int.toString r ^ " = ODiv (" ^ valueToString v1 ^ ", " ^ valueToString v2 ^ ")" - | OLess (r, v1, v2) => "Var " ^ Int.toString r ^ " = OLess (" ^ valueToString v1 ^ ", " ^ valueToString v2 ^ ")" - | OEq (r, v1, v2) => "Var " ^ Int.toString r ^ " = OEq (" ^ valueToString v1 ^ ", " ^ valueToString v2 ^ ")" - | OIf (condition, target) => "OIf (" ^ valueToString condition ^ ") goto " ^ Int.toString target - | OLabel l => "OLabel " ^ Int.toString l - | ORead (r, ptr, off, len) => "Var " ^ Int.toString r ^ " = ORead (Var " ^ Int.toString ptr ^ ", " ^ valueToString off ^ ", " ^ valueToString len ^ ")" - | OWrite (ptr, off, len) => "OWrite (Var " ^ Int.toString ptr ^ ", " ^ valueToString off ^ ", " ^ valueToString len ^ ")" - | OWriteErr (ptr, off, len) => "OWriteErr (Var " ^ Int.toString ptr ^ ", " ^ valueToString off ^ ", " ^ valueToString len ^ ")" -end |