From 3e59b823392701f538f972d689d04b0182696e51 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 9 Aug 2008 16:48:32 -0400 Subject: Lists all the way through --- src/cjr.sml | 3 +- src/cjr_env.sml | 3 +- src/cjr_print.sml | 64 +++++++++++++-------------- src/cjrize.sml | 126 ++++++++++++++++++++++++++++++----------------------- src/core_util.sml | 22 ++++++---- src/lacweb.grm | 8 ++-- src/mono.sml | 2 +- src/mono_env.sml | 2 +- src/mono_opt.sml | 7 +++ src/mono_print.sml | 2 +- src/mono_shake.sml | 2 +- src/mono_util.sml | 16 ++++--- src/monoize.sml | 95 +++++++++++++++++++++++----------------- tests/list.lac | 19 ++++++++ 14 files changed, 218 insertions(+), 153 deletions(-) create mode 100644 tests/list.lac diff --git a/src/cjr.sml b/src/cjr.sml index d9dc51c1..cda7245a 100644 --- a/src/cjr.sml +++ b/src/cjr.sml @@ -35,7 +35,7 @@ datatype typ' = TTop | TFun of typ * typ | TRecord of int - | TDatatype of datatype_kind * int * (string * int * typ option) list + | TDatatype of datatype_kind * int * (string * int * typ option) list ref | TFfi of string * string withtype typ = typ' located @@ -75,6 +75,7 @@ withtype exp = exp' located datatype decl' = DStruct of int * (string * typ) list | DDatatype of datatype_kind * string * int * (string * int * typ option) list + | DDatatypeForward of datatype_kind * string * int | DVal of string * int * typ * exp | DFun of string * int * (string * typ) list * typ * exp | DFunRec of (string * int * (string * typ) list * typ * exp) list diff --git a/src/cjr_env.sml b/src/cjr_env.sml index 83f0cc30..331af45f 100644 --- a/src/cjr_env.sml +++ b/src/cjr_env.sml @@ -140,12 +140,13 @@ fun declBinds env (d, loc) = DDatatype (_, x, n, xncs) => let val env = pushDatatype env x n xncs - val dt = (TDatatype (classifyDatatype xncs, n, xncs), loc) + val dt = (TDatatype (classifyDatatype xncs, n, ref xncs), loc) in foldl (fn ((x', n', NONE), env) => pushENamed env x' n' dt | ((x', n', SOME t), env) => pushENamed env x' n' (TFun (t, dt), loc)) env xncs end + | DDatatypeForward (_, x, n) => pushDatatype env x n [] | DStruct (n, xts) => pushStruct env n xts | DVal (x, n, t, _) => pushENamed env x n t | DFun (fx, n, args, ran, _) => diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 2189a436..4b173aa1 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -53,7 +53,7 @@ structure CM = BinaryMapFn(struct val debug = ref false -val dummyTyp = (TDatatype (Enum, 0, []), ErrorMsg.dummySpan) +val dummyTyp = (TDatatype (Enum, 0, ref []), ErrorMsg.dummySpan) fun p_typ' par env (t, loc) = case t of @@ -106,7 +106,7 @@ fun p_pat_preamble env (p, _) = string (Int.toString (E.countERels env)), string ";", newline], - env) + E.pushERel env x t) | PPrim _ => (box [], env) | PCon (_, _, NONE) => (box [], env) | PCon (_, _, SOME p) => p_pat_preamble env p @@ -180,7 +180,7 @@ fun p_pat (env, exit, depth) (p, _) = let val (x, to, _) = E.lookupConstructor env n in - ("__lwc_" ^ x, to) + ("lw_" ^ x, to) end | PConFfi {mod = m, con, arg, ...} => ("lw_" ^ m ^ "_" ^ con, arg) @@ -247,7 +247,7 @@ fun p_pat (env, exit, depth) (p, _) = space, string "disc", string (Int.toString depth), - string ".", + string ".__lwf_", string x, string ";", newline, @@ -282,11 +282,13 @@ fun patConInfo env pc = val (dx, _) = E.lookupDatatype env dn in ("__lwd_" ^ dx ^ "_" ^ Int.toString dn, - "__lwc_" ^ x ^ "_" ^ Int.toString n) + "__lwc_" ^ x ^ "_" ^ Int.toString n, + "lw_" ^ x) end | PConFfi {mod = m, datatyp, con, ...} => ("lw_" ^ m ^ "_" ^ datatyp, - "lw_" ^ m ^ "_" ^ con) + "lw_" ^ m ^ "_" ^ con, + "lw_" ^ con) fun p_exp' par env (e, loc) = case e of @@ -296,7 +298,7 @@ fun p_exp' par env (e, loc) = | ECon (Enum, pc, _) => p_patCon env pc | ECon (Default, pc, eo) => let - val (xd, xc) = patConInfo env pc + val (xd, xc, xn) = patConInfo env pc in box [string "({", newline, @@ -322,7 +324,7 @@ fun p_exp' par env (e, loc) = case eo of NONE => box [] | SOME e => box [string "tmp->data.", - string xd, + string xn, space, string "=", space, @@ -493,19 +495,23 @@ fun p_fun env (fx, n, args, ran, e) = fun p_decl env (dAll as (d, _) : decl) = case d of DStruct (n, xts) => - box [string "struct", - space, - string ("__lws_" ^ Int.toString n), - space, - string "{", - newline, - p_list_sep (box []) (fn (x, t) => box [p_typ env t, - space, - string "__lwf_", - string x, - string ";", - newline]) xts, - string "};"] + let + val env = E.declBinds env dAll + in + box [string "struct", + space, + string ("__lws_" ^ Int.toString n), + space, + string "{", + newline, + p_list_sep (box []) (fn (x, t) => box [p_typ env t, + space, + string "__lwf_", + string x, + string ";", + newline]) xts, + string "};"] + end | DDatatype (Enum, x, n, xncs) => box [string "enum", space, @@ -552,7 +558,7 @@ fun p_decl env (dAll as (d, _) : decl) = newline, p_list_sep newline (fn (x, n, t) => box [p_typ env t, space, - string ("__lwc_" ^ x), + string ("lw_" ^ x), string ";"]) xncsArgs, newline, string "}", @@ -562,6 +568,8 @@ fun p_decl env (dAll as (d, _) : decl) = string "};"] end + | DDatatypeForward _ => box [] + | DVal (x, n, t, e) => box [p_typ env t, space, @@ -1003,18 +1011,6 @@ fun p_file env (ds, ps) = newline, string "int lw_input_num(char *name) {", newline, - string "if", - space, - string "(name[0]", - space, - string "==", - space, - string "0)", - space, - string "return", - space, - string "-1;", - newline, makeSwitch (fnums, 0), string "}", newline, diff --git a/src/cjrize.sml b/src/cjrize.sml index 5ba8ccb7..166e5fcc 100644 --- a/src/cjrize.sml +++ b/src/cjrize.sml @@ -30,6 +30,8 @@ structure Cjrize :> CJRIZE = struct structure L = Mono structure L' = Cjr +structure IM = IntBinaryMap + structure Sm :> sig type t @@ -61,45 +63,57 @@ fun declares (_, _, ds) = ds end -fun cifyTyp ((t, loc), sm) = - case t of - L.TFun (t1, t2) => - let - val (t1, sm) = cifyTyp (t1, sm) - val (t2, sm) = cifyTyp (t2, sm) - in - ((L'.TFun (t1, t2), loc), sm) - end - | L.TRecord xts => - let - val old_xts = xts - val (xts, sm) = ListUtil.foldlMap (fn ((x, t), sm) => - let - val (t, sm) = cifyTyp (t, sm) - in - ((x, t), sm) - end) - sm xts - val (sm, si) = Sm.find (sm, old_xts, xts) - in - ((L'.TRecord si, loc), sm) - end - | L.TDatatype (dk, n, xncs) => - let - val (xncs, sm) = ListUtil.foldlMap (fn ((x, n, to), sm) => - case to of - NONE => ((x, n, NONE), sm) - | SOME t => - let - val (t, sm) = cifyTyp (t, sm) - in - ((x, n, SOME t), sm) - end) - sm xncs - in - ((L'.TDatatype (dk, n, xncs), loc), sm) - end - | L.TFfi mx => ((L'.TFfi mx, loc), sm) +fun cifyTyp x = + let + fun cify dtmap ((t, loc), sm) = + case t of + L.TFun (t1, t2) => + let + val (t1, sm) = cify dtmap (t1, sm) + val (t2, sm) = cify dtmap (t2, sm) + in + ((L'.TFun (t1, t2), loc), sm) + end + | L.TRecord xts => + let + val old_xts = xts + val (xts, sm) = ListUtil.foldlMap (fn ((x, t), sm) => + let + val (t, sm) = cify dtmap (t, sm) + in + ((x, t), sm) + end) + sm xts + val (sm, si) = Sm.find (sm, old_xts, xts) + in + ((L'.TRecord si, loc), sm) + end + | L.TDatatype (n, ref (dk, xncs)) => + (case IM.find (dtmap, n) of + SOME r => ((L'.TDatatype (dk, n, r), loc), sm) + | NONE => + let + val r = ref [] + val dtmap = IM.insert (dtmap, n, r) + + val (xncs, sm) = ListUtil.foldlMap (fn ((x, n, to), sm) => + case to of + NONE => ((x, n, NONE), sm) + | SOME t => + let + val (t, sm) = cify dtmap (t, sm) + in + ((x, n, SOME t), sm) + end) + sm xncs + in + r := xncs; + ((L'.TDatatype (dk, n, r), loc), sm) + end) + | L.TFfi mx => ((L'.TFfi mx, loc), sm) + in + cify IM.empty x + end val dummye = (L'.EPrim (Prim.Int 0), ErrorMsg.dummySpan) @@ -356,22 +370,26 @@ fun cifyDecl ((d, loc), sm) = fun cjrize ds = let - val (ds, ps, sm) = foldl (fn (d, (ds, ps, sm)) => - let - val (dop, pop, sm) = cifyDecl (d, sm) - val ds = case dop of - NONE => ds - | SOME d => d :: ds - val ps = case pop of - NONE => ps - | SOME p => p :: ps - in - (ds, ps, sm) - end) - ([], [], Sm.empty) ds + val (dsF, ds, ps, sm) = foldl (fn (d, (dsF, ds, ps, sm)) => + let + val (dop, pop, sm) = cifyDecl (d, sm) + val (dsF, ds) = case dop of + NONE => (dsF, ds) + | SOME (d as (L'.DDatatype (dk, x, n, _), loc)) => + ((L'.DDatatypeForward (dk, x, n), loc) :: dsF, + d :: ds) + | SOME d => (dsF, d :: ds) + val ps = case pop of + NONE => ps + | SOME p => p :: ps + in + (dsF, ds, ps, sm) + end) + ([], [], [], Sm.empty) ds in - (List.revAppend (map (fn v => (L'.DStruct v, ErrorMsg.dummySpan)) (Sm.declares sm), - rev ds), + (List.revAppend (dsF, + List.revAppend (map (fn v => (L'.DStruct v, ErrorMsg.dummySpan)) (Sm.declares sm), + rev ds)), ps) end diff --git a/src/core_util.sml b/src/core_util.sml index 3fc57739..e89a579b 100644 --- a/src/core_util.sml +++ b/src/core_util.sml @@ -571,14 +571,20 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} = fn c' => (DCon (x, n, k', c'), loc))) | DDatatype (x, n, xs, xncs) => - S.map2 (ListUtil.mapfold (fn (x, n, c) => - case c of - NONE => S.return2 (x, n, c) - | SOME c => - S.map2 (mfc ctx c, - fn c' => (x, n, SOME c'))) xncs, - fn xncs' => - (DDatatype (x, n, xs, xncs'), loc)) + let + val k = (KType, loc) + val k' = foldl (fn (_, k') => (KArrow (k, k'), loc)) k xs + val ctx' = bind (ctx, NamedC (x, n, k', NONE)) + in + S.map2 (ListUtil.mapfold (fn (x, n, c) => + case c of + NONE => S.return2 (x, n, c) + | SOME c => + S.map2 (mfc ctx' c, + fn c' => (x, n, SOME c'))) xncs, + fn xncs' => + (DDatatype (x, n, xs, xncs'), loc)) + end | DVal vi => S.map2 (mfvi ctx vi, fn vi' => diff --git a/src/lacweb.grm b/src/lacweb.grm index 7fb7b020..a206182b 100644 --- a/src/lacweb.grm +++ b/src/lacweb.grm @@ -308,8 +308,8 @@ cterm : LPAREN cexp RPAREN (#1 cexp, s (LPARENleft, RPARENright)) | FOLD (CFold, s (FOLDleft, FOLDright)) | UNIT (CUnit, s (UNITleft, UNITright)) -ctuple : cterm STAR cterm ([cterm1, cterm2]) - | cterm STAR ctuple (cterm :: ctuple) +ctuple : capps STAR capps ([capps1, capps2]) + | capps STAR ctuple (capps :: ctuple) rcon : ([]) | ident EQ cexp ([(ident, cexp)]) @@ -341,9 +341,7 @@ eexp : eapps (eapps) (EAbs ("_", SOME (TRecord (CRecord [], loc), loc), eexp), loc) end) - | LPAREN etuple RPAREN COLON cexp(case etuple of - [eexp] => (EAnnot (eexp, cexp), s (LPARENleft, cexpright)) - | _ => raise Fail "Multiple arguments to expression type annotation") + | eexp COLON cexp (EAnnot (eexp, cexp), s (eexpleft, cexpright)) | eexp MINUSMINUS cexp (ECut (eexp, cexp), s (eexpleft, cexpright)) | CASE eexp OF barOpt branch branchs (ECase (eexp, branch :: branchs), s (CASEleft, branchsright)) | IF eexp THEN eexp ELSE eexp (let diff --git a/src/mono.sml b/src/mono.sml index b19f5af6..9599433c 100644 --- a/src/mono.sml +++ b/src/mono.sml @@ -34,7 +34,7 @@ datatype datatype_kind = datatype Core.datatype_kind datatype typ' = TFun of typ * typ | TRecord of (string * typ) list - | TDatatype of datatype_kind * int * (string * int * typ option) list + | TDatatype of int * (datatype_kind * (string * int * typ option) list) ref | TFfi of string * string withtype typ = typ' located diff --git a/src/mono_env.sml b/src/mono_env.sml index 3beced1c..60b22642 100644 --- a/src/mono_env.sml +++ b/src/mono_env.sml @@ -98,7 +98,7 @@ fun declBinds env (d, loc) = DDatatype (x, n, xncs) => let val env = pushDatatype env x n xncs - val dt = (TDatatype (MonoUtil.classifyDatatype xncs, n, xncs), loc) + val dt = (TDatatype (n, ref (MonoUtil.classifyDatatype xncs, xncs)), loc) in foldl (fn ((x', n', NONE), env) => pushENamed env x' n' dt NONE "" | ((x', n', SOME t), env) => pushENamed env x' n' (TFun (t, dt), loc) NONE "") diff --git a/src/mono_opt.sml b/src/mono_opt.sml index 38812167..4b417217 100644 --- a/src/mono_opt.sml +++ b/src/mono_opt.sml @@ -135,6 +135,11 @@ fun exp e = | ESeq ((EWrite (EPrim (Prim.String s1), _), loc), (EWrite (EPrim (Prim.String s2), _), _)) => EWrite (EPrim (Prim.String (s1 ^ s2)), loc) + | ESeq ((EWrite (EPrim (Prim.String s1), _), loc), + (ESeq ((EWrite (EPrim (Prim.String s2), _), _), + e), _)) => + ESeq ((EWrite (EPrim (Prim.String (s1 ^ s2)), loc), loc), + e) | EFfiApp ("Basis", "htmlifyString", [(EPrim (Prim.String s), _)]) => EPrim (Prim.String (htmlifyString s)) @@ -142,6 +147,8 @@ fun exp e = EWrite (EPrim (Prim.String (htmlifyString s)), loc) | EWrite (EFfiApp ("Basis", "htmlifyString", [e]), _) => EFfiApp ("Basis", "htmlifyString_w", [e]) + | EFfiApp ("Basis", "htmlifyString_w", [(EPrim (Prim.String s), loc)]) => + EWrite (EPrim (Prim.String (htmlifyString s)), loc) | EFfiApp ("Basis", "attrifyInt", [(EPrim (Prim.Int n), _)]) => EPrim (Prim.String (attrifyInt n)) diff --git a/src/mono_print.sml b/src/mono_print.sml index fc19d8b5..afa86c18 100644 --- a/src/mono_print.sml +++ b/src/mono_print.sml @@ -53,7 +53,7 @@ fun p_typ' par env (t, _) = space, p_typ env t]) xcs, string "}"] - | TDatatype (_, n, _) => + | TDatatype (n, _) => ((if !debug then string (#1 (E.lookupDatatype env n) ^ "__" ^ Int.toString n) else diff --git a/src/mono_shake.sml b/src/mono_shake.sml index 498a1ac6..e694c0dd 100644 --- a/src/mono_shake.sml +++ b/src/mono_shake.sml @@ -58,7 +58,7 @@ fun shake file = fun typ (c, s) = case c of - TDatatype (_, n, _) => + TDatatype (n, _) => if IS.member (#con s, n) then s else diff --git a/src/mono_util.sml b/src/mono_util.sml index f00db1fd..3c76e029 100644 --- a/src/mono_util.sml +++ b/src/mono_util.sml @@ -52,7 +52,7 @@ fun compare ((t1, _), (t2, _)) = in joinL compareFields (xts1, xts2) end - | (TDatatype (_, n1, _), TDatatype (_, n2, _)) => Int.compare (n1, n2) + | (TDatatype (n1, _), TDatatype (n2, _)) => Int.compare (n1, n2) | (TFfi (m1, x1), TFfi (m2, x2)) => join (String.compare (m1, m2), fn () => String.compare (x1, x2)) | (TFun _, _) => LESS @@ -297,9 +297,13 @@ fun mapfoldB {typ = fc, exp = fe, decl = fd, bind} = fn vi' => (DVal vi', loc)) | DValRec vis => - S.map2 (ListUtil.mapfold (mfvi ctx) vis, - fn vis' => - (DValRec vis', loc)) + let + val ctx' = foldl (fn ((x, n, t, _, s), ctx') => bind (ctx', NamedE (x, n, t, NONE, s))) ctx vis + in + S.map2 (ListUtil.mapfold (mfvi ctx') vis, + fn vis' => + (DValRec vis', loc)) + end | DExport (ek, s, n, ts) => S.map2 (ListUtil.mapfold mft ts, fn ts' => @@ -350,7 +354,7 @@ fun mapfoldB (all as {bind, ...}) = DDatatype (x, n, xncs) => let val ctx = bind (ctx, Datatype (x, n, xncs)) - val t = (TDatatype (classifyDatatype xncs, n, xncs), #2 d') + val t = (TDatatype (n, ref (classifyDatatype xncs, xncs)), #2 d') in foldl (fn ((x, n, to), ctx) => let @@ -364,7 +368,7 @@ fun mapfoldB (all as {bind, ...}) = end | DVal (x, n, t, e, s) => bind (ctx, NamedE (x, n, t, SOME e, s)) | DValRec vis => foldl (fn ((x, n, t, e, s), ctx) => - bind (ctx, NamedE (x, n, t, SOME e, s))) ctx vis + bind (ctx, NamedE (x, n, t, NONE, s))) ctx vis | DExport _ => ctx in S.map2 (mff ctx' ds', diff --git a/src/monoize.sml b/src/monoize.sml index 9f75e8f9..98b9075a 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -33,7 +33,9 @@ structure Env = CoreEnv structure L = Core structure L' = Mono -val dummyTyp = (L'.TDatatype (L'.Enum, 0, []), E.dummySpan) +structure IM = IntBinaryMap + +val dummyTyp = (L'.TDatatype (0, ref (L'.Enum, [])), E.dummySpan) fun monoName env (all as (c, loc)) = let @@ -47,46 +49,58 @@ fun monoName env (all as (c, loc)) = | _ => poly () end -fun monoType env (all as (c, loc)) = +fun monoType env = let - fun poly () = - (E.errorAt loc "Unsupported type constructor"; - Print.eprefaces' [("Constructor", CorePrint.p_con env all)]; - dummyTyp) - in - case c of - L.TFun (c1, c2) => (L'.TFun (monoType env c1, monoType env c2), loc) - | L.TCFun _ => poly () - | L.TRecord (L.CRecord ((L.KType, _), xcs), _) => - (L'.TRecord (map (fn (x, t) => (monoName env x, monoType env t)) xcs), loc) - | L.TRecord _ => poly () - - | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) => - (L'.TFfi ("Basis", "string"), loc) - | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) => - (L'.TFfi ("Basis", "string"), loc) - - | L.CRel _ => poly () - | L.CNamed n => + fun mt env dtmap (all as (c, loc)) = let - val (_, xs, xncs) = Env.lookupDatatype env n - - val xncs = map (fn (x, n, to) => (x, n, Option.map (monoType env) to)) xncs + fun poly () = + (E.errorAt loc "Unsupported type constructor"; + Print.eprefaces' [("Constructor", CorePrint.p_con env all)]; + dummyTyp) in - case xs of - [] => (L'.TDatatype (MonoUtil.classifyDatatype xncs, n, xncs), loc) - | _ => poly () + case c of + L.TFun (c1, c2) => (L'.TFun (mt env dtmap c1, mt env dtmap c2), loc) + | L.TCFun _ => poly () + | L.TRecord (L.CRecord ((L.KType, _), xcs), _) => + (L'.TRecord (map (fn (x, t) => (monoName env x, mt env dtmap t)) xcs), loc) + | L.TRecord _ => poly () + + | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) => + (L'.TFfi ("Basis", "string"), loc) + | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) => + (L'.TFfi ("Basis", "string"), loc) + + | L.CRel _ => poly () + | L.CNamed n => + (case IM.find (dtmap, n) of + SOME r => (L'.TDatatype (n, r), loc) + | NONE => + let + val r = ref (L'.Default, []) + val (_, xs, xncs) = Env.lookupDatatype env n + + val dtmap' = IM.insert (dtmap, n, r) + + val xncs = map (fn (x, n, to) => (x, n, Option.map (mt env dtmap') to)) xncs + in + case xs of + [] =>(r := (MonoUtil.classifyDatatype xncs, xncs); + (L'.TDatatype (n, r), loc)) + | _ => poly () + end) + | L.CFfi mx => (L'.TFfi mx, loc) + | L.CApp _ => poly () + | L.CAbs _ => poly () + + | L.CName _ => poly () + + | L.CRecord _ => poly () + | L.CConcat _ => poly () + | L.CFold _ => poly () + | L.CUnit => poly () end - | L.CFfi mx => (L'.TFfi mx, loc) - | L.CApp _ => poly () - | L.CAbs _ => poly () - - | L.CName _ => poly () - - | L.CRecord _ => poly () - | L.CConcat _ => poly () - | L.CFold _ => poly () - | L.CUnit => poly () + in + mt env IM.empty end val dummyExp = (L'.EPrim (Prim.Int 0), E.dummySpan) @@ -204,7 +218,7 @@ fun fooifyExp fk env = L'.TFfi (m, x) => ((L'.EFfiApp (m, fk2s fk ^ "ify" ^ capitalize x, [e]), loc), fm) | L'.TRecord [] => ((L'.EPrim (Prim.String ""), loc), fm) - | L'.TDatatype (dk, i, _) => + | L'.TDatatype (i, ref (dk, _)) => let fun makeDecl n fm = let @@ -733,9 +747,10 @@ fun monoDecl (env, fm) (all as (d, loc)) = L.DCon _ => NONE | L.DDatatype (x, n, [], xncs) => let - val d = (L'.DDatatype (x, n, map (fn (x, n, to) => (x, n, Option.map (monoType env) to)) xncs), loc) + val env' = Env.declBinds env all + val d = (L'.DDatatype (x, n, map (fn (x, n, to) => (x, n, Option.map (monoType env') to)) xncs), loc) in - SOME (Env.declBinds env all, fm, d) + SOME (env', fm, d) end | L.DDatatype _ => poly () | L.DVal (x, n, t, e, s) => diff --git a/tests/list.lac b/tests/list.lac new file mode 100644 index 00000000..a4602d0e --- /dev/null +++ b/tests/list.lac @@ -0,0 +1,19 @@ +datatype list a = Nil | Cons of a * list a + +val isNil = fn t ::: Type => fn ls : list t => + case ls of Nil => True | _ => False + +val show = fn b => if b then "True" else "False" + +val rec delist : list string -> xml body [] [] = fn x => + case x of + Nil => Nil + | Cons (h, t) => {cdata h} :: {delist t} + +val main : unit -> page = fn () => + {cdata (show (isNil (Nil : list bool)))}, + {cdata (show (isNil (Cons (1, Nil))))}, + {cdata (show (isNil (Cons ("A", Cons ("B", Nil)))))} + +

{delist (Cons ("X", Cons ("Y", Cons ("Z", Nil))))}

+ -- cgit v1.2.3