From e5034d3a668fbf0a4367bb582d759ba82b5576a3 Mon Sep 17 00:00:00 2001 From: Rose Hogenson Date: Wed, 22 Jan 2025 19:45:12 -0800 Subject: Support struct expressions --- Elab.sml | 47 +++++++++---- Parser.sml | 27 +++++--- ShowSyntax.sml | 162 ++++++++++++++++++++++++--------------------- Syntax.sml | 6 +- generate-show-syntax.sml | 30 ++++----- main.sml | 4 +- tests/22-nested-struct.sml | 9 +++ 7 files changed, 165 insertions(+), 120 deletions(-) create mode 100644 tests/22-nested-struct.sml diff --git a/Elab.sml b/Elab.sml index 60760cd..74e331b 100644 --- a/Elab.sml +++ b/Elab.sml @@ -186,6 +186,7 @@ struct in (patterns, occurrences, actions) end + (* https://compiler.club/compiling-pattern-matching/ *) fun compilePatternMatching (env : env) ([] : Syntax.pat list list, _ : Syntax.lexp list, _ : Syntax.lexp list) : Syntax.lexp = raise Fail "nonexhaustive match" | compilePatternMatching env (patterns as firstRow :: rows, occurrences, actions) = @@ -245,12 +246,21 @@ struct fun structBoundVars (decls : Syntax.dec list) : string list = List.concatMap declBoundVars decls - fun bindStructType (name : string) (decls : Syntax.dec list) (Env env) : env = + fun bindStruct (name : string) (structEnv : env) (Env { vars, types, structTypes }) : env = + Env { vars = vars, types = types, structTypes = StringMap.insert name structEnv structTypes } + + fun bindStructType (name : string) (decls : Syntax.dec list) (env : env) : env = let val structEnv = foldl (fn (Syntax.DDatatype (_, cons), env) => bindDataCons cons env - | (Syntax.DStruct (name, decls), env) => bindStructType name decls env + | (Syntax.DStruct (name, Syntax.SStruct decls), env) => bindStructType name decls env + | (Syntax.DStruct (name, Syntax.SIdent ident), env) => + let + fun lookup [name] env = lookupStructType name env + | lookup (name :: names) env = lookup names (lookupStructType name env) + | lookup _ _ = raise Fail "invalid struct identifier" + in lookup ident env end | (_, env) => env) emptyEnv decls @@ -260,7 +270,7 @@ struct structEnv (enumerate (structBoundVars decls)) in - Env { vars = #vars env, types = #types env, structTypes = StringMap.insert name structEnv (#structTypes env) } + bindStruct name structEnv env end fun actionVector (env : env) (expr : Syntax.lexp) (arms : (Syntax.pat * Syntax.expr) list) : Syntax.lexp list = @@ -313,8 +323,7 @@ struct fun go env [i] acc = Syntax.LSelect (lookupVar i env, acc) | go env (accessor :: accessors) acc = let val env = lookupStructType accessor env - in go env accessors (Syntax.LSelect (lookupVar accessor env, acc)) - end + in go env accessors (Syntax.LSelect (lookupVar accessor env, acc)) end | go _ [] _ = raise Fail "go empty" in go env accessors s end @@ -395,25 +404,35 @@ struct ] , elab env (Syntax.ELet (decls, body)) ) - end - end - | Syntax.ELet (Syntax.DStruct (name, structDecls) :: decls, body) => + end end + | Syntax.ELet (Syntax.DStruct (name, Syntax.SStruct structDecls) :: decls, body) => let val names = structBoundVars structDecls val tuple = elab env (Syntax.ELet (structDecls, Syntax.ETuple (map (fn n => Syntax.EIdent [n]) names))) val v = GenSym.new () val env = bindStructType name structDecls env val env = bindVar name v env - in Syntax.LApp (Syntax.LFn (v, elab env (Syntax.ELet (decls, body))), tuple) - end + in Syntax.LApp (Syntax.LFn (v, elab env (Syntax.ELet (decls, body))), tuple) end + | Syntax.ELet (Syntax.DStruct (name, Syntax.SIdent (structName :: accessors)) :: decls, body) => + let + val s = Syntax.LVar (lookupVar structName env) + fun go env [] acc = (env, acc) + | go env (accessor :: accessors) acc = + go + (lookupStructType accessor env) + accessors + (Syntax.LSelect (lookupVar accessor env, acc)) + val (structEnv, structExpr) = go (lookupStructType structName env) accessors s + val v = GenSym.new () + val env = bindStruct name structEnv env + val env = bindVar name v env + in Syntax.LApp (Syntax.LFn (v, elab env (Syntax.ELet (decls, body))), structExpr) end | Syntax.ELambda body => let val v = GenSym.new () - in Syntax.LFn (v, elabCase env (Syntax.LVar v) [body]) - end + in Syntax.LFn (v, elabCase env (Syntax.LVar v) [body]) end | Syntax.ECase (expr, arms) => let val v = GenSym.new () - in Syntax.LApp (Syntax.LFn (v, elabCase env (Syntax.LVar v) arms), elab env expr) - end + in Syntax.LApp (Syntax.LFn (v, elabCase env (Syntax.LVar v) arms), elab env expr) end fun elaborate (p : Syntax.expr) : Syntax.lexp = elab emptyEnv p end diff --git a/Parser.sml b/Parser.sml index 50d302d..4e20c13 100644 --- a/Parser.sml +++ b/Parser.sml @@ -606,11 +606,15 @@ struct ((reserved "structure" >> bind identifier (fn strID => reserved "=" >> - reserved "struct" >> - bind (many strdec) (fn bindings => - reserved "end" >> - const (SOME (Syntax.DStruct (strID, List.mapPartial (fn x => x) bindings)))))) + bind structExpr (fn str => + const (SOME (Syntax.DStruct (strID, str)))))) <|> dec) st + and structExpr : Syntax.structExpr parser = fn st => + ((reserved "struct" >> + bind (many strdec) (fn bindings => + reserved "end" >> + const (Syntax.SStruct (List.mapPartial (fn x => x) bindings)))) + <|> Syntax.SIdent <$> longIdentifier) st (* There's ambiguity between pattern variables and constructors that can only * be resolved by checking for constructors in scope *) @@ -637,17 +641,18 @@ struct Syntax.DFun (f, map (fn (args, body) => (map (fixPatConstructors constructors) args, fixConstructors constructors body)) arms) | fixDecConstructors _ (decl as Syntax.DDatatype _) = decl | fixDecConstructors _ (decl as Syntax.DType _) = decl - | fixDecConstructors constructors (Syntax.DStruct (name, decs)) = - let - val constructors = ref constructors - val decs : Syntax.dec list = - map + | fixDecConstructors constructors (Syntax.DStruct (name, str)) = Syntax.DStruct (name, fixStructExprConstructors constructors str) + + and fixStructExprConstructors (constructors : unit StringMap.map) (Syntax.SStruct decls) : Syntax.structExpr = + let val constructors = ref constructors in + Syntax.SStruct + (map (fn dec => (constructors := foldl (fn (x, acc) => StringMap.insert x () acc) (!constructors) (findConstructors dec) ; fixDecConstructors (!constructors) dec)) - decs - in Syntax.DStruct (name, decs) + decls) end + | fixStructExprConstructors _ expr = expr and fixConstructors (constructors : unit StringMap.map) (Syntax.ETuple exprs) : Syntax.expr = Syntax.ETuple (map (fixConstructors constructors) exprs) diff --git a/ShowSyntax.sml b/ShowSyntax.sml index 645ef84..651ddda 100644 --- a/ShowSyntax.sml +++ b/ShowSyntax.sml @@ -18,173 +18,181 @@ fun optionToString (_ : string -> 'a -> string) (_ : string) NONE : string = "NO fun listToString (_ : string -> 'a -> string) (_ : string) ([] : 'a list) : string = "[]" | listToString show indent [x] = "[" ^ show indent x ^ "]" | listToString show indent xs = - let val indent' = indent ^ " " in - "[\n" ^ indent' ^ String.concatWith (",\n" ^ indent') (map (show indent') xs) ^ "\n" ^ indent ^ "]" - end + let val indent' = indent ^ " " in + "[\n" + ^ indent' ^ String.concatWith (",\n" ^ indent') (map (show indent') xs) ^ "\n" + ^ indent ^ "]" + end fun etypeToStringI (indent : string) (Syntax.Tyvar x : Syntax.etype) : string = - "Tyvar " ^ stringToStringI indent x + "Tyvar " ^ stringToStringI indent x | etypeToStringI (indent : string) (Syntax.Tycon x : Syntax.etype) : string = - "Tycon " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString (etypeToStringI) indent' x0 ^ ",\n" ^ indent' ^ stringToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "Tycon " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString (etypeToStringI) indent' x0 ^ ",\n" ^ indent' ^ stringToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | etypeToStringI (indent : string) (Syntax.TyTuple x : Syntax.etype) : string = - "TyTuple " ^ listToString (etypeToStringI) indent x + "TyTuple " ^ listToString (etypeToStringI) indent x | etypeToStringI (indent : string) (Syntax.Tyfun x : Syntax.etype) : string = - "Tyfun " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ etypeToStringI indent' x0 ^ ",\n" ^ indent' ^ etypeToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "Tyfun " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ etypeToStringI indent' x0 ^ ",\n" ^ indent' ^ etypeToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x and etypeToString (x : Syntax.etype) : string = etypeToStringI "" x and patToStringI (indent : string) (Syntax.PWild : Syntax.pat) : string = - "PWild" + "PWild" | patToStringI (indent : string) (Syntax.PVar x : Syntax.pat) : string = - "PVar " ^ stringToStringI indent x + "PVar " ^ stringToStringI indent x | patToStringI (indent : string) (Syntax.PInt x : Syntax.pat) : string = - "PInt " ^ intToStringI indent x + "PInt " ^ intToStringI indent x | patToStringI (indent : string) (Syntax.PTuple x : Syntax.pat) : string = - "PTuple " ^ listToString (patToStringI) indent x + "PTuple " ^ listToString (patToStringI) indent x | patToStringI (indent : string) (Syntax.PCon x : Syntax.pat) : string = - "PCon " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString (stringToStringI) indent' x0 ^ ",\n" ^ indent' ^ patToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "PCon " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString (stringToStringI) indent' x0 ^ ",\n" ^ indent' ^ patToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x and patToString (x : Syntax.pat) : string = patToStringI "" x and exprToStringI (indent : string) (Syntax.EIdent x : Syntax.expr) : string = - "EIdent " ^ listToString (stringToStringI) indent x + "EIdent " ^ listToString (stringToStringI) indent x | exprToStringI (indent : string) (Syntax.EBuiltin x : Syntax.expr) : string = - "EBuiltin " ^ stringToStringI indent x + "EBuiltin " ^ stringToStringI indent x | exprToStringI (indent : string) (Syntax.EInt x : Syntax.expr) : string = - "EInt " ^ intToStringI indent x + "EInt " ^ intToStringI indent x | exprToStringI (indent : string) (Syntax.EStr x : Syntax.expr) : string = - "EStr " ^ stringToStringI indent x + "EStr " ^ stringToStringI indent x | exprToStringI (indent : string) (Syntax.ETuple x : Syntax.expr) : string = - "ETuple " ^ listToString (exprToStringI) indent x + "ETuple " ^ listToString (exprToStringI) indent x | exprToStringI (indent : string) (Syntax.EList x : Syntax.expr) : string = - "EList " ^ listToString (exprToStringI) indent x + "EList " ^ listToString (exprToStringI) indent x | exprToStringI (indent : string) (Syntax.EApp x : Syntax.expr) : string = - "EApp " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ exprToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "EApp " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ exprToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | exprToStringI (indent : string) (Syntax.ETyped x : Syntax.expr) : string = - "ETyped " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ exprToStringI indent' x0 ^ ",\n" ^ indent' ^ etypeToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "ETyped " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ exprToStringI indent' x0 ^ ",\n" ^ indent' ^ etypeToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | exprToStringI (indent : string) (Syntax.EAndAlso x : Syntax.expr) : string = - "EAndAlso " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ exprToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "EAndAlso " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ exprToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | exprToStringI (indent : string) (Syntax.EOrElse x : Syntax.expr) : string = - "EOrElse " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ exprToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "EOrElse " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ exprToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | exprToStringI (indent : string) (Syntax.ELet x : Syntax.expr) : string = - "ELet " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString (decToStringI) indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "ELet " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString (decToStringI) indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | exprToStringI (indent : string) (Syntax.ELambda x : Syntax.expr) : string = - "ELambda " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ patToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "ELambda " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ patToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | exprToStringI (indent : string) (Syntax.ECase x : Syntax.expr) : string = - "ECase " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ exprToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ patToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "ECase " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ exprToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ patToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x and exprToString (x : Syntax.expr) : string = exprToStringI "" x and decToStringI (indent : string) (Syntax.DVal x : Syntax.dec) : string = - "DVal " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ patToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "DVal " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ patToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | decToStringI (indent : string) (Syntax.DValRec x : Syntax.dec) : string = - "DValRec " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ patToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "DValRec " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ patToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | decToStringI (indent : string) (Syntax.DFun x : Syntax.dec) : string = - "DFun " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString (patToStringI) indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "DFun " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString (patToStringI) indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | decToStringI (indent : string) (Syntax.DDatatype x : Syntax.dec) : string = - "DDatatype " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ optionToString (etypeToStringI) indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "DDatatype " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ optionToString (etypeToStringI) indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | decToStringI (indent : string) (Syntax.DType x : Syntax.dec) : string = - "DType " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ etypeToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "DType " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ etypeToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | decToStringI (indent : string) (Syntax.DStruct x : Syntax.dec) : string = - "DStruct " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString (decToStringI) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "DStruct " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ structExprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x and decToString (x : Syntax.dec) : string = decToStringI "" x +and structExprToStringI (indent : string) (Syntax.SIdent x : Syntax.structExpr) : string = + "SIdent " ^ listToString (stringToStringI) indent x + | structExprToStringI (indent : string) (Syntax.SStruct x : Syntax.structExpr) : string = + "SStruct " ^ listToString (decToStringI) indent x +and structExprToString (x : Syntax.structExpr) : string = structExprToStringI "" x + and primopToStringI (indent : string) (Syntax.PExit : Syntax.primop) : string = - "PExit" + "PExit" | primopToStringI (indent : string) (Syntax.PAdd : Syntax.primop) : string = - "PAdd" + "PAdd" | primopToStringI (indent : string) (Syntax.PSub : Syntax.primop) : string = - "PSub" + "PSub" | primopToStringI (indent : string) (Syntax.PMul : Syntax.primop) : string = - "PMul" + "PMul" | primopToStringI (indent : string) (Syntax.PDiv : Syntax.primop) : string = - "PDiv" + "PDiv" | primopToStringI (indent : string) (Syntax.PLess : Syntax.primop) : string = - "PLess" + "PLess" | primopToStringI (indent : string) (Syntax.PEq : Syntax.primop) : string = - "PEq" + "PEq" | primopToStringI (indent : string) (Syntax.PIf : Syntax.primop) : string = - "PIf" + "PIf" | primopToStringI (indent : string) (Syntax.PRead : Syntax.primop) : string = - "PRead" + "PRead" | primopToStringI (indent : string) (Syntax.PWrite : Syntax.primop) : string = - "PWrite" + "PWrite" | primopToStringI (indent : string) (Syntax.PWriteErr : Syntax.primop) : string = - "PWriteErr" + "PWriteErr" and primopToString (x : Syntax.primop) : string = primopToStringI "" x and lexpToStringI (indent : string) (Syntax.LVar x : Syntax.lexp) : string = - "LVar " ^ varToStringI indent x + "LVar " ^ varToStringI indent x | lexpToStringI (indent : string) (Syntax.LFn x : Syntax.lexp) : string = - "LFn " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ lexpToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "LFn " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ lexpToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | lexpToStringI (indent : string) (Syntax.LFix x : Syntax.lexp) : string = - "LFix " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ varToStringI indent' x1 ^ ",\n" ^ indent' ^ lexpToStringI indent' x2 ^ "\n" ^ indent ^ ")" end)) indent' x0 ^ ",\n" ^ indent' ^ lexpToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "LFix " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ varToStringI indent' x1 ^ ",\n" ^ indent' ^ lexpToStringI indent' x2 ^ "\n" ^ indent ^ ")" end)) indent' x0 ^ ",\n" ^ indent' ^ lexpToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | lexpToStringI (indent : string) (Syntax.LApp x : Syntax.lexp) : string = - "LApp " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ lexpToStringI indent' x0 ^ ",\n" ^ indent' ^ lexpToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "LApp " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ lexpToStringI indent' x0 ^ ",\n" ^ indent' ^ lexpToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | lexpToStringI (indent : string) (Syntax.LInt x : Syntax.lexp) : string = - "LInt " ^ intToStringI indent x + "LInt " ^ intToStringI indent x | lexpToStringI (indent : string) (Syntax.LString x : Syntax.lexp) : string = - "LString " ^ stringToStringI indent x + "LString " ^ stringToStringI indent x | lexpToStringI (indent : string) (Syntax.LRecord x : Syntax.lexp) : string = - "LRecord " ^ listToString (lexpToStringI) indent x + "LRecord " ^ listToString (lexpToStringI) indent x | lexpToStringI (indent : string) (Syntax.LSelect x : Syntax.lexp) : string = - "LSelect " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ intToStringI indent' x0 ^ ",\n" ^ indent' ^ lexpToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "LSelect " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ intToStringI indent' x0 ^ ",\n" ^ indent' ^ lexpToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | lexpToStringI (indent : string) (Syntax.LPrim x : Syntax.lexp) : string = - "LPrim " ^ primopToStringI indent x + "LPrim " ^ primopToStringI indent x | lexpToStringI (indent : string) (Syntax.LSwitch x : Syntax.lexp) : string = - "LSwitch " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ lexpToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ intToStringI indent' x0 ^ ",\n" ^ indent' ^ lexpToStringI indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x1 ^ ",\n" ^ indent' ^ optionToString (lexpToStringI) indent' x2 ^ "\n" ^ indent ^ ")" end) indent x + "LSwitch " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ lexpToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ intToStringI indent' x0 ^ ",\n" ^ indent' ^ lexpToStringI indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x1 ^ ",\n" ^ indent' ^ optionToString (lexpToStringI) indent' x2 ^ "\n" ^ indent ^ ")" end) indent x and lexpToString (x : Syntax.lexp) : string = lexpToStringI "" x and valueToStringI (indent : string) (Syntax.VVar x : Syntax.value) : string = - "VVar " ^ varToStringI indent x + "VVar " ^ varToStringI indent x | valueToStringI (indent : string) (Syntax.VLabel x : Syntax.value) : string = - "VLabel " ^ varToStringI indent x + "VLabel " ^ varToStringI indent x | valueToStringI (indent : string) (Syntax.VInt x : Syntax.value) : string = - "VInt " ^ intToStringI indent x + "VInt " ^ intToStringI indent x and valueToString (x : Syntax.value) : string = valueToStringI "" x and cexpToStringI (indent : string) (Syntax.CRecord x : Syntax.cexp) : string = - "CRecord " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ valueToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString (intToStringI) indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x0 ^ ",\n" ^ indent' ^ varToStringI indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x0 ^ ",\n" ^ indent' ^ cexpToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "CRecord " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ valueToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString (intToStringI) indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x0 ^ ",\n" ^ indent' ^ varToStringI indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x0 ^ ",\n" ^ indent' ^ cexpToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | cexpToStringI (indent : string) (Syntax.CSelect x : Syntax.cexp) : string = - "CSelect " ^ (fn indent => fn (x0, x1, x2, x3) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ intToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ varToStringI indent' x2 ^ ",\n" ^ indent' ^ cexpToStringI indent' x3 ^ "\n" ^ indent ^ ")" end) indent x + "CSelect " ^ (fn indent => fn (x0, x1, x2, x3) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ intToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ varToStringI indent' x2 ^ ",\n" ^ indent' ^ cexpToStringI indent' x3 ^ "\n" ^ indent ^ ")" end) indent x | cexpToStringI (indent : string) (Syntax.CApp x : Syntax.cexp) : string = - "CApp " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ valueToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString (valueToStringI) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "CApp " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ valueToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString (valueToStringI) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | cexpToStringI (indent : string) (Syntax.CFix x : Syntax.cexp) : string = - "CFix " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString (varToStringI) indent' x1 ^ ",\n" ^ indent' ^ cexpToStringI indent' x2 ^ "\n" ^ indent ^ ")" end)) indent' x0 ^ ",\n" ^ indent' ^ cexpToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "CFix " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString (varToStringI) indent' x1 ^ ",\n" ^ indent' ^ cexpToStringI indent' x2 ^ "\n" ^ indent ^ ")" end)) indent' x0 ^ ",\n" ^ indent' ^ cexpToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | cexpToStringI (indent : string) (Syntax.CPrimop x : Syntax.cexp) : string = - "CPrimop " ^ (fn indent => fn (x0, x1, x2, x3) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ primopToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString (valueToStringI) indent' x1 ^ ",\n" ^ indent' ^ listToString (varToStringI) indent' x2 ^ ",\n" ^ indent' ^ listToString (cexpToStringI) indent' x3 ^ "\n" ^ indent ^ ")" end) indent x + "CPrimop " ^ (fn indent => fn (x0, x1, x2, x3) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ primopToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString (valueToStringI) indent' x1 ^ ",\n" ^ indent' ^ listToString (varToStringI) indent' x2 ^ ",\n" ^ indent' ^ listToString (cexpToStringI) indent' x3 ^ "\n" ^ indent ^ ")" end) indent x and cexpToString (x : Syntax.cexp) : string = cexpToStringI "" x and opcodeToStringI (indent : string) (Syntax.OAlloc x : Syntax.opcode) : string = - "OAlloc " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "OAlloc " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | opcodeToStringI (indent : string) (Syntax.OCall : Syntax.opcode) : string = - "OCall" + "OCall" | opcodeToStringI (indent : string) (Syntax.OPoke x : Syntax.opcode) : string = - "OPoke " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ intToStringI indent' x0 ^ ",\n" ^ indent' ^ varToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x + "OPoke " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ intToStringI indent' x0 ^ ",\n" ^ indent' ^ varToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x | opcodeToStringI (indent : string) (Syntax.OPeek x : Syntax.opcode) : string = - "OPeek " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ intToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x + "OPeek " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ intToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x | opcodeToStringI (indent : string) (Syntax.OShuf x : Syntax.opcode) : string = - "OShuf " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "OShuf " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | opcodeToStringI (indent : string) (Syntax.OExit x : Syntax.opcode) : string = - "OExit " ^ valueToStringI indent x + "OExit " ^ valueToStringI indent x | opcodeToStringI (indent : string) (Syntax.OAdd x : Syntax.opcode) : string = - "OAdd " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x + "OAdd " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x | opcodeToStringI (indent : string) (Syntax.OSub x : Syntax.opcode) : string = - "OSub " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x + "OSub " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x | opcodeToStringI (indent : string) (Syntax.OMul x : Syntax.opcode) : string = - "OMul " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x + "OMul " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x | opcodeToStringI (indent : string) (Syntax.ODiv x : Syntax.opcode) : string = - "ODiv " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x + "ODiv " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x | opcodeToStringI (indent : string) (Syntax.OLess x : Syntax.opcode) : string = - "OLess " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x + "OLess " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x | opcodeToStringI (indent : string) (Syntax.OEq x : Syntax.opcode) : string = - "OEq " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x + "OEq " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x | opcodeToStringI (indent : string) (Syntax.OIf x : Syntax.opcode) : string = - "OIf " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ valueToStringI indent' x0 ^ ",\n" ^ indent' ^ varToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + "OIf " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ valueToStringI indent' x0 ^ ",\n" ^ indent' ^ varToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x | opcodeToStringI (indent : string) (Syntax.OLabel x : Syntax.opcode) : string = - "OLabel " ^ varToStringI indent x + "OLabel " ^ varToStringI indent x | opcodeToStringI (indent : string) (Syntax.ORead x : Syntax.opcode) : string = - "ORead " ^ (fn indent => fn (x0, x1, x2, x3) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ varToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ ",\n" ^ indent' ^ valueToStringI indent' x3 ^ "\n" ^ indent ^ ")" end) indent x + "ORead " ^ (fn indent => fn (x0, x1, x2, x3) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ varToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ ",\n" ^ indent' ^ valueToStringI indent' x3 ^ "\n" ^ indent ^ ")" end) indent x | opcodeToStringI (indent : string) (Syntax.OWrite x : Syntax.opcode) : string = - "OWrite " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x + "OWrite " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x | opcodeToStringI (indent : string) (Syntax.OWriteErr x : Syntax.opcode) : string = - "OWriteErr " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x + "OWriteErr " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ varToStringI indent' x0 ^ ",\n" ^ indent' ^ valueToStringI indent' x1 ^ ",\n" ^ indent' ^ valueToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x and opcodeToString (x : Syntax.opcode) : string = opcodeToStringI "" x end diff --git a/Syntax.sml b/Syntax.sml index bb394b4..5d45133 100644 --- a/Syntax.sml +++ b/Syntax.sml @@ -35,7 +35,11 @@ struct | DFun of string * (pat list * expr) list | DDatatype of string * (string * etype option) list | DType of string * etype - | DStruct of string * dec list + | DStruct of string * structExpr + + and structExpr = + SIdent of string list + | SStruct of dec list (* Lambda language *) type var = int diff --git a/generate-show-syntax.sml b/generate-show-syntax.sml index 7e7e38a..d58d73d 100644 --- a/generate-show-syntax.sml +++ b/generate-show-syntax.sml @@ -17,17 +17,18 @@ val header = ^ "fun listToString (_ : string -> 'a -> string) (_ : string) ([] : 'a list) : string = \"[]\"\n" ^ " | listToString show indent [x] = \"[\" ^ show indent x ^ \"]\"\n" ^ " | listToString show indent xs =\n" - ^ " let val indent' = indent ^ \" \" in\n" - ^ " \"[\\n\" ^ indent' ^ String.concatWith (\",\\n\" ^ indent') (map (show indent') xs) ^ \"\\n\" ^ indent ^ \"]\"\n" - ^ " end\n" + ^ " let val indent' = indent ^ \" \" in\n" + ^ " \"[\\n\"\n" + ^ " ^ indent' ^ String.concatWith (\",\\n\" ^ indent') (map (show indent') xs) ^ \"\\n\"\n" + ^ " ^ indent ^ \"]\"\n" + ^ " end\n" fun showTy (Syntax.Tyvar var) : string = var ^ "ToStringI" | showTy (Syntax.Tycon ([ty], con)) = con ^ "ToString (" ^ showTy ty ^ ")" | showTy (Syntax.TyTuple tys) = - let val vars = List.tabulate (length tys, fn i => "x" ^ Int.toString i) - in - "(fn indent => fn (" ^ String.concatWith ", " vars ^ ") => let val indent' = indent ^ \" \" in \"(\\n\" ^ indent' ^ " ^ String.concatWith " ^ \",\\n\" ^ indent' ^ " (map (fn (var, ty) => showTy ty ^ " indent' " ^ var) (ListPair.zip (vars, tys))) ^ " ^ \"\\n\" ^ indent ^ \")\" end)" - end + let val vars = List.tabulate (length tys, fn i => "x" ^ Int.toString i) in + "(fn indent => fn (" ^ String.concatWith ", " vars ^ ") => let val indent' = indent ^ \" \" in \"(\\n\" ^ indent' ^ " ^ String.concatWith " ^ \",\\n\" ^ indent' ^ " (map (fn (var, ty) => showTy ty ^ " indent' " ^ var) (ListPair.zip (vars, tys))) ^ " ^ \"\\n\" ^ indent ^ \")\" end)" + end | showTy _ = "(fn _ => fn _ => \"UNHANDLED\")" val opts = { o = ref "/dev/stdout" } @@ -43,23 +44,22 @@ val ast = | Result.Right x => x val (structName, decls) = case ast of - Syntax.ELet (Syntax.DStruct str :: _, _) => str + Syntax.ELet (Syntax.DStruct (structName, Syntax.SStruct decls) :: _, _) => (structName, decls) | _ => raise Fail "ast has unexpected format (I can't print it sorry)" val out = TextIO.openOut (!(#o opts)) val _ = TextIO.output (out, "(*\n This file was generated by generate-show-syntax.sml. Do not edit manually.\n To regenerate, use\n\n sml generate-show-syntax.sml -o " ^ !(#o opts) ^ " " ^ filename ^ "\n*)\n\n") val _ = TextIO.output (out, "structure Show" ^ structName ^ " = struct\n") val _ = TextIO.output (out, header) val _ = map - (fn (i, Syntax.DDatatype (typeName, cases)) => ( - TextIO.output (out, + (fn (i, Syntax.DDatatype (typeName, cases)) => + (TextIO.output (out, "\n" ^ (if i = 0 then "fun" else "and") ^ " " ^ String.concatWith "\n | " (map - (fn (caseName, NONE) => typeName ^ "ToStringI (indent : string) (" ^ structName ^ "." ^ caseName ^ " : " ^ structName ^ "." ^ typeName ^ ") : string =\n \"" ^ caseName ^ "\"" - | (caseName, SOME ty) => typeName ^ "ToStringI (indent : string) (" ^ structName ^ "." ^ caseName ^ " x : " ^ structName ^ "." ^ typeName ^ ") : string =\n \"" ^ caseName ^ " \" ^ " ^ showTy ty ^ " indent x") + (fn (caseName, NONE) => typeName ^ "ToStringI (indent : string) (" ^ structName ^ "." ^ caseName ^ " : " ^ structName ^ "." ^ typeName ^ ") : string =\n \"" ^ caseName ^ "\"" + | (caseName, SOME ty) => typeName ^ "ToStringI (indent : string) (" ^ structName ^ "." ^ caseName ^ " x : " ^ structName ^ "." ^ typeName ^ ") : string =\n \"" ^ caseName ^ " \" ^ " ^ showTy ty ^ " indent x") cases) - ^ "\n"); - TextIO.output (out, "and " ^ typeName ^ "ToString (x : " ^ structName ^ "." ^ typeName ^ ") : string = " ^ typeName ^ "ToStringI \"\" x\n") - ) + ^ "\n") ; + TextIO.output (out, "and " ^ typeName ^ "ToString (x : " ^ structName ^ "." ^ typeName ^ ") : string = " ^ typeName ^ "ToStringI \"\" x\n")) | _ => ()) (ListPair.zip (List.tabulate (length decls, fn i => i), decls)) val _ = TextIO.output(out, "end\n") diff --git a/main.sml b/main.sml index 13e6774..99d72bb 100644 --- a/main.sml +++ b/main.sml @@ -4,13 +4,13 @@ use "Buffer.sml"; use "GenSym.sml"; use "Map.sml"; use "Syntax.sml"; +use "Opts.sml"; +use "Parser.sml"; use "ShowSyntax.sml"; use "CodeGen.sml"; use "CPS.sml"; use "Elab.sml"; use "Linker.sml"; -use "Opts.sml"; -use "Parser.sml"; use "Compiler.sml"; val _ = Compiler.main (CommandLine.arguments ()) diff --git a/tests/22-nested-struct.sml b/tests/22-nested-struct.sml new file mode 100644 index 0000000..1eaf6ab --- /dev/null +++ b/tests/22-nested-struct.sml @@ -0,0 +1,9 @@ +structure S = struct + structure I = struct + val fourtyTwo = 42 + end +end + +structure T = S.I + +val _ = __builtin "exit" T.fourtyTwo -- cgit v1.3.1