summaryrefslogtreecommitdiffstats
path: root/Syntax.sml
diff options
context:
space:
mode:
Diffstat (limited to 'Syntax.sml')
-rw-r--r--Syntax.sml134
1 files changed, 1 insertions, 133 deletions
diff --git a/Syntax.sml b/Syntax.sml
index 2f7a96e..bb394b4 100644
--- a/Syntax.sml
+++ b/Syntax.sml
@@ -34,6 +34,7 @@ struct
| DValRec of pat * expr
| DFun of string * (pat list * expr) list
| DDatatype of string * (string * etype option) list
+ | DType of string * etype
| DStruct of string * dec list
(* Lambda language *)
@@ -95,137 +96,4 @@ struct
| 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
generated by cgit v1.3.1 (git 2.54.0) at 2026-09-04 04:05:26 +0000