From eaa183b7dfc841df75d42ace7a90ada1e40ff282 Mon Sep 17 00:00:00 2001 From: Rose Hogenson Date: Tue, 4 Nov 2025 18:58:28 -0800 Subject: Add lists --- Elab.sml | 36 ++++++++++++++++++++++++++++++------ Parser.sml | 24 +++++++++++++++++++++--- ShowSyntax.sml | 4 ++++ Syntax.sml | 2 ++ Types.sml | 24 +++++++++++++++++------- tests/01-simple.sml | 10 ---------- tests/010-simple.sml | 10 ++++++++++ tests/02-lambda.sml | 1 - tests/020-lambda.sml | 1 + tests/03-arg.sml | 1 - tests/030-arg.sml | 1 + tests/04-val.sml | 2 -- tests/040-val.sml | 2 ++ tests/05-let.sml | 4 ---- tests/050-let.sml | 4 ++++ tests/06-let-multiple.sml | 6 ------ tests/060-let-multiple.sml | 6 ++++++ tests/07-add.sml | 1 - tests/070-add.sml | 1 + tests/08-multiply.sml | 1 - tests/080-multiply.sml | 1 + tests/09-subtract.sml | 1 - tests/090-subtract.sml | 1 + tests/10-divide.sml | 1 - tests/100-divide.sml | 1 + tests/11-case.sml | 1 - tests/110-case.sml | 1 + tests/12-case-int.sml | 5 ----- tests/120-case-int.sml | 5 +++++ tests/13-fibonacci.sml | 7 ------- tests/130-fibonacci.sml | 7 +++++++ tests/14-fun.sml | 3 --- tests/140-fun.sml | 3 +++ tests/15-tuple.sml | 3 --- tests/150-tuple.sml | 3 +++ tests/155-case-tuple.sml | 4 ++++ tests/16-datatype.sml | 5 ----- tests/160-datatype.sml | 5 +++++ tests/17-case-datatype.sml | 6 ------ tests/170-case-datatype.sml | 6 ++++++ tests/175-case-datatype-default.sml | 6 ++++++ tests/18-fun-case.sml | 5 ----- tests/180-fun-case.sml | 5 +++++ tests/19-list.sml | 11 ----------- tests/190-list.sml | 10 ++++++++++ tests/20-structure.sml | 5 ----- tests/200-structure.sml | 5 +++++ tests/21-struct-datatype.sml | 6 ------ tests/210-struct-datatype.sml | 6 ++++++ tests/22-nested-struct.sml | 9 --------- tests/220-nested-struct.sml | 9 +++++++++ tests/225-two-structs.sml | 9 +++++++++ tests/23-signature.sml | 10 ---------- tests/230-signature.sml | 10 ++++++++++ tests/24-functor.sml | 17 ----------------- tests/240-functor.sml | 17 +++++++++++++++++ tests/250-list.sml | 6 ++++++ tests/260-cons.sml | 4 ++++ 58 files changed, 223 insertions(+), 137 deletions(-) delete mode 100644 tests/01-simple.sml create mode 100644 tests/010-simple.sml delete mode 100644 tests/02-lambda.sml create mode 100644 tests/020-lambda.sml delete mode 100644 tests/03-arg.sml create mode 100644 tests/030-arg.sml delete mode 100644 tests/04-val.sml create mode 100644 tests/040-val.sml delete mode 100644 tests/05-let.sml create mode 100644 tests/050-let.sml delete mode 100644 tests/06-let-multiple.sml create mode 100644 tests/060-let-multiple.sml delete mode 100644 tests/07-add.sml create mode 100644 tests/070-add.sml delete mode 100644 tests/08-multiply.sml create mode 100644 tests/080-multiply.sml delete mode 100644 tests/09-subtract.sml create mode 100644 tests/090-subtract.sml delete mode 100644 tests/10-divide.sml create mode 100644 tests/100-divide.sml delete mode 100644 tests/11-case.sml create mode 100644 tests/110-case.sml delete mode 100644 tests/12-case-int.sml create mode 100644 tests/120-case-int.sml delete mode 100644 tests/13-fibonacci.sml create mode 100644 tests/130-fibonacci.sml delete mode 100644 tests/14-fun.sml create mode 100644 tests/140-fun.sml delete mode 100644 tests/15-tuple.sml create mode 100644 tests/150-tuple.sml create mode 100644 tests/155-case-tuple.sml delete mode 100644 tests/16-datatype.sml create mode 100644 tests/160-datatype.sml delete mode 100644 tests/17-case-datatype.sml create mode 100644 tests/170-case-datatype.sml create mode 100644 tests/175-case-datatype-default.sml delete mode 100644 tests/18-fun-case.sml create mode 100644 tests/180-fun-case.sml delete mode 100644 tests/19-list.sml create mode 100644 tests/190-list.sml delete mode 100644 tests/20-structure.sml create mode 100644 tests/200-structure.sml delete mode 100644 tests/21-struct-datatype.sml create mode 100644 tests/210-struct-datatype.sml delete mode 100644 tests/22-nested-struct.sml create mode 100644 tests/220-nested-struct.sml create mode 100644 tests/225-two-structs.sml delete mode 100644 tests/23-signature.sml create mode 100644 tests/230-signature.sml delete mode 100644 tests/24-functor.sml create mode 100644 tests/240-functor.sml create mode 100644 tests/250-list.sml create mode 100644 tests/260-cons.sml diff --git a/Elab.sml b/Elab.sml index ba436f5..13bc890 100644 --- a/Elab.sml +++ b/Elab.sml @@ -59,6 +59,8 @@ struct fun patternBindings (expr : Syntax.lexp) (Syntax.TPVar v, _ : Syntax.ty) : (string * Syntax.lexp) list = [(v, expr)] | patternBindings expr (Syntax.TPTuple t, _) = List.concat (map (fn (i, p) => patternBindings (Syntax.LSelect (i, expr)) p) (enumerate t)) + | patternBindings _ (Syntax.TPList [], _) = [] + | patternBindings expr (Syntax.TPList (x :: xs), t) = patternBindings (Syntax.LSelect (0, Syntax.LSelect (1, expr))) x @ patternBindings (Syntax.LSelect (1, Syntax.LSelect (1, expr))) (Syntax.TPList xs, t) | patternBindings expr (Syntax.TPCon (_, arg), _) = patternBindings (Syntax.LSelect (1, expr)) arg | patternBindings _ _ = [] @@ -117,11 +119,15 @@ struct val con1 = List.find (fn (Syntax.TPCon (name, _), Syntax.TDatatype cons) => lookupCon (List.last name) cons = n + | (Syntax.TPList [], _) => n = 0 + | (_, Syntax.TList _) => n = 1 | _ => false) (map hd patterns) val newTupleSize = case con1 of SOME (Syntax.TPCon (_, (Syntax.TPTuple t, _)), _) => length t + | SOME (Syntax.TPList [], _) => 0 + | SOME (_, Syntax.TList _) => 2 | _ => 0 val occHead = hd occurrences val occRest = tl occurrences @@ -130,10 +136,17 @@ struct then Syntax.LSelect (1, occHead) :: occRest else List.tabulate (newTupleSize, fn i => Syntax.LSelect (i, Syntax.LSelect (1, occHead))) @ occRest + val newTupleSize = if newTupleSize = 0 then 1 else newTupleSize fun specializeRow ((Syntax.TPInt i, ty):: rest) = if i = n then SOME ((Syntax.TPWild, ty) :: rest) else NONE - | specializeRow ((Syntax.TPWild, ty) :: rest) = SOME ((Syntax.TPWild, ty) :: rest) - | specializeRow ((Syntax.TPVar _, ty) :: rest) = SOME ((Syntax.TPWild, ty) :: rest) + | specializeRow ((Syntax.TPWild, ty) :: rest) = SOME (List.tabulate (newTupleSize, fn _ => (Syntax.TPWild, ty)) @ rest) + | specializeRow ((Syntax.TPVar _, ty) :: rest) = SOME (List.tabulate (newTupleSize, fn _ => (Syntax.TPWild, ty)) @ rest) + | specializeRow ((Syntax.TPList [], Syntax.TList ty) :: rest) = + if n = 0 then SOME ((Syntax.TPWild, ty) :: rest) else NONE + | specializeRow ((Syntax.TPList (pat :: pats), ty) :: rest) = + if n = 1 then SOME ([pat, (Syntax.TPList pats, ty)] @ rest) else NONE + | specializeRow ((Syntax.TPCon (_, (Syntax.TPTuple pats, _)), Syntax.TList _) :: rest) = + if n = 1 then SOME (pats @ rest) else NONE | specializeRow ((Syntax.TPCon (con, (Syntax.TPTuple [], tupleTy)), conTy) :: rest) = specializeRow ((Syntax.TPCon (con, (Syntax.TPTuple [(Syntax.TPWild, Syntax.TTuple [])], tupleTy)), conTy) :: rest) | specializeRow ((Syntax.TPCon (con, (Syntax.TPTuple args, _)), Syntax.TDatatype cons) :: rest) = @@ -172,6 +185,7 @@ struct List.find (fn (_, (Syntax.TPInt _, _)) => true | (_, (Syntax.TPCon _, _)) => true + | (_, (Syntax.TPList _, _)) => true | _ => false) (enumerate firstRow) in @@ -189,13 +203,16 @@ struct (IntMap.toList (foldl (fn ((Syntax.TPInt i, _), acc) => IntMap.insert i true acc + | ((Syntax.TPList [], _), acc) => IntMap.insert 0 true acc + | ((_, Syntax.TList _), acc) => IntMap.insert 1 true acc | ((Syntax.TPCon (c, _), Syntax.TDatatype cons), acc) => IntMap.insert (lookupCon (List.last c) cons) true acc | (_, acc) => acc) IntMap.empty firstCol)) val nCons = - case List.find (fn (Syntax.TPCon _, _) => true | _ => false) firstCol of + case List.find (fn (Syntax.TPCon _, _) => true | (Syntax.TPList _, _) => true | _ => false) firstCol of SOME (Syntax.TPCon _, Syntax.TDatatype cons) => length cons + | SOME (_, Syntax.TList _) => 2 | _ => ~1 val defaultCase = if length signatures = nCons @@ -273,8 +290,8 @@ struct | Syntax.TEList exprs => foldr (fn (x, acc) => - Syntax.LRecord [elab env x, acc]) - (Syntax.LInt 0) + Syntax.LRecord [Syntax.LInt 1, Syntax.LRecord [elab env x, acc]]) + (Syntax.LRecord [Syntax.LInt 0]) exprs | Syntax.TEApp (f, x) => Syntax.LApp (elab env f, elab env x) | Syntax.TEAndAlso (_, _) => raise Fail "unimplemented" @@ -400,5 +417,12 @@ struct in Syntax.LApp (func, tuple) end | _ => raise Fail ("invalid expression " ^ ShowSyntax.typedExprToString p) - fun elaborate (p : Syntax.typedExpr * Syntax.ty) : Syntax.lexp = elab emptyEnv p + fun elaborate (p : Syntax.typedExpr * Syntax.ty) : Syntax.lexp = + let + val cons = GenSym.new () + val alpha = GenSym.new () + val env = IdentMap.insert (Syntax.ITVar, "::") cons emptyEnv + in + Syntax.LApp (Syntax.LFn (cons, elab env p), Syntax.LFn (alpha, Syntax.LRecord [Syntax.LInt 1, Syntax.LVar alpha])) + end end diff --git a/Parser.sml b/Parser.sml index 8f43352..9f31f8d 100644 --- a/Parser.sml +++ b/Parser.sml @@ -28,8 +28,18 @@ struct , "signature", "struct", "structure", "where", ":>" ] - val emptyInfixOperators : infixTable = - Vector.tabulate (10, fn _ => ([], [])) + val defaultInfixOperators : infixTable = Vector.fromList + [ ([], []) + , ([], []) + , ([], []) + , ([], []) + , ([], []) + , ([], ["::"]) + , ([], []) + , ([], []) + , ([], []) + , ([], []) + ] fun printSourceLoc ({file, row, column} : sourceLoc) : string = file ^ ":" ^ Int.toString row ^ "." ^ Int.toString column @@ -69,7 +79,7 @@ struct fun newState (fileName : string) (fileStream : TextIO.instream) : state = { stream = TextIO.getInstream fileStream, loc = newLoc fileName, - userState = {infixTable = emptyInfixOperators} + userState = {infixTable = defaultInfixOperators} } fun updateUserState (f : userState -> userState) : userState parser = @@ -414,6 +424,10 @@ struct val rec atpat : Syntax.pat parser = fn st => (Syntax.PWild <$ reserved "_" <|> Syntax.PInt <$> integer + <|> (symbol "[" >> + bind (sepBy pat (symbol ",")) (fn pats => + symbol "]" >> + const (Syntax.PList pats))) <|> bind (between (symbol "(") (symbol ")") (sepBy pat (symbol ","))) (fn pats => const (case pats of @@ -476,6 +490,10 @@ struct bind expr (fn e => reserved "end" >> const (Syntax.ELet (List.mapPartial (fn x => x) decs, e))))) + <|> (symbol "[" >> + bind (sepBy expr (symbol ",")) (fn exprs => + symbol "]" >> + const (Syntax.EList exprs))) <|> (symbol "(" >> bind (sepBy expr (symbol ",")) (fn exprs => symbol ")" >> diff --git a/ShowSyntax.sml b/ShowSyntax.sml index 519fb2b..70f082b 100644 --- a/ShowSyntax.sml +++ b/ShowSyntax.sml @@ -44,6 +44,8 @@ and patToStringI (indent : string) (Syntax.PWild : Syntax.pat) : string = "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 + | patToStringI (indent : string) (Syntax.PList x : Syntax.pat) : string = + "PList " ^ listToString (patToStringI) indent x and patToString (x : Syntax.pat) : string = patToStringI "" x and identTypeToStringI (indent : string) (Syntax.ITVar : Syntax.identType) : string = @@ -140,6 +142,8 @@ and typedPatToStringI (indent : string) (Syntax.TPWild : Syntax.typedPat) : stri "TPTuple " ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ typedPatToStringI indent' x0 ^ ",\n" ^ indent' ^ tyToStringI indent' x1 ^ "\n" ^ indent ^ ")" end)) indent x | typedPatToStringI (indent : string) (Syntax.TPCon x : Syntax.typedPat) : string = "TPCon " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ listToString (stringToStringI) indent' x0 ^ ",\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ typedPatToStringI indent' x0 ^ ",\n" ^ indent' ^ tyToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x + | typedPatToStringI (indent : string) (Syntax.TPList x : Syntax.typedPat) : string = + "TPList " ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ " " in "(\n" ^ indent' ^ typedPatToStringI indent' x0 ^ ",\n" ^ indent' ^ tyToStringI indent' x1 ^ "\n" ^ indent ^ ")" end)) indent x and typedPatToString (x : Syntax.typedPat) : string = typedPatToStringI "" x and typedExprToStringI (indent : string) (Syntax.TEIdent x : Syntax.typedExpr) : string = diff --git a/Syntax.sml b/Syntax.sml index 0eccd36..8145211 100644 --- a/Syntax.sml +++ b/Syntax.sml @@ -13,6 +13,7 @@ struct | PInt of int | PTuple of pat list | PCon of string list * pat + | PList of pat list datatype identType = ITVar @@ -77,6 +78,7 @@ struct | TPInt of int | TPTuple of (typedPat * ty) list | TPCon of string list * (typedPat * ty) + | TPList of (typedPat * ty) list datatype typedExpr = TEIdent of identType * string diff --git a/Types.sml b/Types.sml index 6b945f9..6cf419f 100644 --- a/Types.sml +++ b/Types.sml @@ -148,6 +148,8 @@ structure Types = struct bind makeBinding (Syntax.ITVar, v) (GenSym.new ()) env | bindPat makeBinding (Syntax.PTuple pats) env = foldl (fn (pat, env) => bindPat makeBinding pat env) env pats + | bindPat makeBinding (Syntax.PList pats) env = + foldl (fn (pat, env) => bindPat makeBinding pat env) env pats | bindPat makeBinding (Syntax.PCon (_, pat)) env = bindPat makeBinding pat env | bindPat _ _ env = env @@ -157,11 +159,6 @@ structure Types = struct | SOME (Arg t) => TyVar t | NONE => raise Fail ("unbound var " ^ printIdent name) - fun patBindings (Syntax.PVar v) : string list = [v] - | patBindings (Syntax.PTuple pats) = List.concat (map patBindings pats) - | patBindings (Syntax.PCon (_, pat)) = patBindings pat - | patBindings _ = [] - fun tyToSyntaxTy (TyVar v) = Syntax.TVar v | tyToSyntaxTy (TyCon (Bool, [])) = Syntax.TBool | tyToSyntaxTy (TyCon (Int, [])) = Syntax.TInt @@ -220,6 +217,13 @@ structure Types = struct Syntax.PTuple [] => (Syntax.TPCon (con, (Syntax.TPTuple [], Syntax.TTuple [])), conType) | _ => raise Fail ("non-function " ^ (String.concatWith "." con) ^ " applied to argument in pattern") end + | tagPat env (Syntax.PList pats) = + let + val taggedPats = map (tagPat env) pats + val elemType = TyVar (GenSym.new ()) + val _ = app (fn (_, t) => unify elemType t) taggedPats + in (Syntax.TPList (map (fn (x, t) => (x, tyToSyntaxTy t)) taggedPats), TyCon (List, [elemType])) + end fun F (env : env) (Syntax.EIdent i) : Syntax.typedExpr * ty = (Syntax.TEIdent i, lookupBinding i env) @@ -306,7 +310,7 @@ structure Types = struct arms in (Syntax.TECase ((arg, tyToSyntaxTy argType), arms), resultType) end | F env (Syntax.EStruct decls) = - let val (env, decls) = tagDecs env decls + let val (env', decls) = tagDecs env decls in ( Syntax.TEStruct decls , TyStruct @@ -314,7 +318,9 @@ structure Types = struct (map (fn (name, Let v) => (name, TyVar v) | (name, Arg v) => (name, TyVar v)) - (IdentMap.toList (#bindings env)))) + (List.filter + (fn (id, _) => not (isSome (IdentMap.lookup id (#bindings env)))) + (IdentMap.toList (#bindings env'))))) ) end | F env (Syntax.EFunctorApp (func, arg)) = @@ -465,6 +471,10 @@ structure Types = struct , boundVars = TyVarMap.empty , typesByName = StringMap.empty } + val alpha = TyVar (GenSym.new ()) + val cons = GenSym.new () + val _ = unify (TyVar cons) (TyCon (Fun, [TyCon (Tuple, [alpha, TyCon (List, [alpha])]), TyCon (List, [alpha])])) + val env = bind Let (Syntax.ITVar, "::") cons env val (expr, ty) = F env expr in reexpand (expr, tyToSyntaxTy ty) end end diff --git a/tests/01-simple.sml b/tests/01-simple.sml deleted file mode 100644 index e41f9b4..0000000 --- a/tests/01-simple.sml +++ /dev/null @@ -1,10 +0,0 @@ -(* - This file is part of Foobar. - - Foobar is free software: you can redistribute it and/or modify it under the - terms of the GNU General Public License as published by the Free Software - Foundation, either version 3 of the License, or (at your option) any - later version. -*) - -val _ = __builtin "exit" 42 diff --git a/tests/010-simple.sml b/tests/010-simple.sml new file mode 100644 index 0000000..e41f9b4 --- /dev/null +++ b/tests/010-simple.sml @@ -0,0 +1,10 @@ +(* + This file is part of Foobar. + + Foobar is free software: you can redistribute it and/or modify it under the + terms of the GNU General Public License as published by the Free Software + Foundation, either version 3 of the License, or (at your option) any + later version. +*) + +val _ = __builtin "exit" 42 diff --git a/tests/02-lambda.sml b/tests/02-lambda.sml deleted file mode 100644 index 41470a2..0000000 --- a/tests/02-lambda.sml +++ /dev/null @@ -1 +0,0 @@ -val _ = (fn _ => __builtin "exit" 42) () diff --git a/tests/020-lambda.sml b/tests/020-lambda.sml new file mode 100644 index 0000000..41470a2 --- /dev/null +++ b/tests/020-lambda.sml @@ -0,0 +1 @@ +val _ = (fn _ => __builtin "exit" 42) () diff --git a/tests/03-arg.sml b/tests/03-arg.sml deleted file mode 100644 index 8d10139..0000000 --- a/tests/03-arg.sml +++ /dev/null @@ -1 +0,0 @@ -val _ = (fn x => __builtin "exit" x) 42 diff --git a/tests/030-arg.sml b/tests/030-arg.sml new file mode 100644 index 0000000..8d10139 --- /dev/null +++ b/tests/030-arg.sml @@ -0,0 +1 @@ +val _ = (fn x => __builtin "exit" x) 42 diff --git a/tests/04-val.sml b/tests/04-val.sml deleted file mode 100644 index 20d07b4..0000000 --- a/tests/04-val.sml +++ /dev/null @@ -1,2 +0,0 @@ -val x = 42 -val _ = __builtin "exit" x diff --git a/tests/040-val.sml b/tests/040-val.sml new file mode 100644 index 0000000..20d07b4 --- /dev/null +++ b/tests/040-val.sml @@ -0,0 +1,2 @@ +val x = 42 +val _ = __builtin "exit" x diff --git a/tests/05-let.sml b/tests/05-let.sml deleted file mode 100644 index d1c27f5..0000000 --- a/tests/05-let.sml +++ /dev/null @@ -1,4 +0,0 @@ -val _ = - let val x = 42 in - __builtin "exit" x - end diff --git a/tests/050-let.sml b/tests/050-let.sml new file mode 100644 index 0000000..d1c27f5 --- /dev/null +++ b/tests/050-let.sml @@ -0,0 +1,4 @@ +val _ = + let val x = 42 in + __builtin "exit" x + end diff --git a/tests/06-let-multiple.sml b/tests/06-let-multiple.sml deleted file mode 100644 index 47441ac..0000000 --- a/tests/06-let-multiple.sml +++ /dev/null @@ -1,6 +0,0 @@ -val _ = - let - val x = 42 - val y = x - in __builtin "exit" y - end diff --git a/tests/060-let-multiple.sml b/tests/060-let-multiple.sml new file mode 100644 index 0000000..47441ac --- /dev/null +++ b/tests/060-let-multiple.sml @@ -0,0 +1,6 @@ +val _ = + let + val x = 42 + val y = x + in __builtin "exit" y + end diff --git a/tests/07-add.sml b/tests/07-add.sml deleted file mode 100644 index 9892b23..0000000 --- a/tests/07-add.sml +++ /dev/null @@ -1 +0,0 @@ -val _ = __builtin "exit" (__builtin "add" (40, 2)) diff --git a/tests/070-add.sml b/tests/070-add.sml new file mode 100644 index 0000000..9892b23 --- /dev/null +++ b/tests/070-add.sml @@ -0,0 +1 @@ +val _ = __builtin "exit" (__builtin "add" (40, 2)) diff --git a/tests/08-multiply.sml b/tests/08-multiply.sml deleted file mode 100644 index d75c316..0000000 --- a/tests/08-multiply.sml +++ /dev/null @@ -1 +0,0 @@ -val _ = __builtin "exit" (__builtin "mul" (6, 7)) diff --git a/tests/080-multiply.sml b/tests/080-multiply.sml new file mode 100644 index 0000000..d75c316 --- /dev/null +++ b/tests/080-multiply.sml @@ -0,0 +1 @@ +val _ = __builtin "exit" (__builtin "mul" (6, 7)) diff --git a/tests/09-subtract.sml b/tests/09-subtract.sml deleted file mode 100644 index 2374816..0000000 --- a/tests/09-subtract.sml +++ /dev/null @@ -1 +0,0 @@ -val _ = __builtin "exit" (__builtin "sub" (84, 42)) diff --git a/tests/090-subtract.sml b/tests/090-subtract.sml new file mode 100644 index 0000000..2374816 --- /dev/null +++ b/tests/090-subtract.sml @@ -0,0 +1 @@ +val _ = __builtin "exit" (__builtin "sub" (84, 42)) diff --git a/tests/10-divide.sml b/tests/10-divide.sml deleted file mode 100644 index a701180..0000000 --- a/tests/10-divide.sml +++ /dev/null @@ -1 +0,0 @@ -val _ = __builtin "exit" (__builtin "div" (84, 2)) diff --git a/tests/100-divide.sml b/tests/100-divide.sml new file mode 100644 index 0000000..a701180 --- /dev/null +++ b/tests/100-divide.sml @@ -0,0 +1 @@ +val _ = __builtin "exit" (__builtin "div" (84, 2)) diff --git a/tests/11-case.sml b/tests/11-case.sml deleted file mode 100644 index 297ae5b..0000000 --- a/tests/11-case.sml +++ /dev/null @@ -1 +0,0 @@ -val _ = case 42 of x => __builtin "exit" x diff --git a/tests/110-case.sml b/tests/110-case.sml new file mode 100644 index 0000000..297ae5b --- /dev/null +++ b/tests/110-case.sml @@ -0,0 +1 @@ +val _ = case 42 of x => __builtin "exit" x diff --git a/tests/12-case-int.sml b/tests/12-case-int.sml deleted file mode 100644 index 98967e4..0000000 --- a/tests/12-case-int.sml +++ /dev/null @@ -1,5 +0,0 @@ -val _ = - case 18 of - 17 => __builtin "exit" 41 - | 18 => __builtin "exit" 42 - | _ => __builtin "exit" 43 diff --git a/tests/120-case-int.sml b/tests/120-case-int.sml new file mode 100644 index 0000000..98967e4 --- /dev/null +++ b/tests/120-case-int.sml @@ -0,0 +1,5 @@ +val _ = + case 18 of + 17 => __builtin "exit" 41 + | 18 => __builtin "exit" 42 + | _ => __builtin "exit" 43 diff --git a/tests/13-fibonacci.sml b/tests/13-fibonacci.sml deleted file mode 100644 index ec89f70..0000000 --- a/tests/13-fibonacci.sml +++ /dev/null @@ -1,7 +0,0 @@ -val rec fib = fn n => - case n of - 0 => 0 - | 1 => 1 - | _ => __builtin "add" (fib (__builtin "sub" (n, 1)), fib (__builtin "sub" (n, 2))) - -val _ = __builtin "exit" (__builtin "add" (fib 9, 8)) diff --git a/tests/130-fibonacci.sml b/tests/130-fibonacci.sml new file mode 100644 index 0000000..ec89f70 --- /dev/null +++ b/tests/130-fibonacci.sml @@ -0,0 +1,7 @@ +val rec fib = fn n => + case n of + 0 => 0 + | 1 => 1 + | _ => __builtin "add" (fib (__builtin "sub" (n, 1)), fib (__builtin "sub" (n, 2))) + +val _ = __builtin "exit" (__builtin "add" (fib 9, 8)) diff --git a/tests/14-fun.sml b/tests/14-fun.sml deleted file mode 100644 index 210b30d..0000000 --- a/tests/14-fun.sml +++ /dev/null @@ -1,3 +0,0 @@ -fun f x y = __builtin "exit" (__builtin "sub" (x, y)) - -val _ = f 60 18 diff --git a/tests/140-fun.sml b/tests/140-fun.sml new file mode 100644 index 0000000..210b30d --- /dev/null +++ b/tests/140-fun.sml @@ -0,0 +1,3 @@ +fun f x y = __builtin "exit" (__builtin "sub" (x, y)) + +val _ = f 60 18 diff --git a/tests/15-tuple.sml b/tests/15-tuple.sml deleted file mode 100644 index 114fd25..0000000 --- a/tests/15-tuple.sml +++ /dev/null @@ -1,3 +0,0 @@ -fun f (x, y) = __builtin "exit" (__builtin "add" (x, y)) - -val _ = f (40, 2) diff --git a/tests/150-tuple.sml b/tests/150-tuple.sml new file mode 100644 index 0000000..114fd25 --- /dev/null +++ b/tests/150-tuple.sml @@ -0,0 +1,3 @@ +fun f (x, y) = __builtin "exit" (__builtin "add" (x, y)) + +val _ = f (40, 2) diff --git a/tests/155-case-tuple.sml b/tests/155-case-tuple.sml new file mode 100644 index 0000000..774fb34 --- /dev/null +++ b/tests/155-case-tuple.sml @@ -0,0 +1,4 @@ +val _ = __builtin "exit" + (case (1, 2, 42) of + (_, 2, x) => x + | _ => 13) diff --git a/tests/16-datatype.sml b/tests/16-datatype.sml deleted file mode 100644 index 7514606..0000000 --- a/tests/16-datatype.sml +++ /dev/null @@ -1,5 +0,0 @@ -datatype D = D of int - -fun f (D x) = __builtin "exit" x - -val _ = f (D 42) diff --git a/tests/160-datatype.sml b/tests/160-datatype.sml new file mode 100644 index 0000000..7514606 --- /dev/null +++ b/tests/160-datatype.sml @@ -0,0 +1,5 @@ +datatype D = D of int + +fun f (D x) = __builtin "exit" x + +val _ = f (D 42) diff --git a/tests/17-case-datatype.sml b/tests/17-case-datatype.sml deleted file mode 100644 index 974f263..0000000 --- a/tests/17-case-datatype.sml +++ /dev/null @@ -1,6 +0,0 @@ -datatype D = A | B - -val _ = - case B of - A => __builtin "exit" 0 - | B => __builtin "exit" 42 diff --git a/tests/170-case-datatype.sml b/tests/170-case-datatype.sml new file mode 100644 index 0000000..974f263 --- /dev/null +++ b/tests/170-case-datatype.sml @@ -0,0 +1,6 @@ +datatype D = A | B + +val _ = + case B of + A => __builtin "exit" 0 + | B => __builtin "exit" 42 diff --git a/tests/175-case-datatype-default.sml b/tests/175-case-datatype-default.sml new file mode 100644 index 0000000..221bc13 --- /dev/null +++ b/tests/175-case-datatype-default.sml @@ -0,0 +1,6 @@ +datatype D = A of int * int | B + +val _ = __builtin "exit" + (case A (42, 13) of + A (x, 13) => x + | _ => 10) diff --git a/tests/18-fun-case.sml b/tests/18-fun-case.sml deleted file mode 100644 index d64b7d7..0000000 --- a/tests/18-fun-case.sml +++ /dev/null @@ -1,5 +0,0 @@ -fun fib 1 = 1 - | fib 2 = 2 - | fib n = __builtin "add" (fib (__builtin "sub" (n, 1)), fib (__builtin "sub" (n, 2))) - -val _ = __builtin "exit" (__builtin "add" (fib 8, 8)) diff --git a/tests/180-fun-case.sml b/tests/180-fun-case.sml new file mode 100644 index 0000000..d64b7d7 --- /dev/null +++ b/tests/180-fun-case.sml @@ -0,0 +1,5 @@ +fun fib 1 = 1 + | fib 2 = 2 + | fib n = __builtin "add" (fib (__builtin "sub" (n, 1)), fib (__builtin "sub" (n, 2))) + +val _ = __builtin "exit" (__builtin "add" (fib 8, 8)) diff --git a/tests/19-list.sml b/tests/19-list.sml deleted file mode 100644 index 52404dc..0000000 --- a/tests/19-list.sml +++ /dev/null @@ -1,11 +0,0 @@ -infix 6 + -infixr 5 :: - -datatype 'a list = Nil | :: of 'a * 'a list - -fun x + y = __builtin "add" (x, y) - -fun foldl _ acc Nil = acc - | foldl f acc (x :: xs) = foldl f (f (x, acc)) xs - -val _ = __builtin "exit" (foldl op + 0 (1 :: 2 :: 3 :: 6 :: 8 :: 10 :: 12 :: Nil)) diff --git a/tests/190-list.sml b/tests/190-list.sml new file mode 100644 index 0000000..de69c4a --- /dev/null +++ b/tests/190-list.sml @@ -0,0 +1,10 @@ +infix 6 + + +datatype 'a list = Nil | :: of 'a * 'a list + +fun x + y = __builtin "add" (x, y) + +fun foldl _ acc Nil = acc + | foldl f acc (x :: xs) = foldl f (f (x, acc)) xs + +val _ = __builtin "exit" (foldl op + 0 (1 :: 2 :: 3 :: 6 :: 8 :: 10 :: 12 :: Nil)) diff --git a/tests/20-structure.sml b/tests/20-structure.sml deleted file mode 100644 index dfc7b9b..0000000 --- a/tests/20-structure.sml +++ /dev/null @@ -1,5 +0,0 @@ -structure S = struct - val fourtyTwo = 42 -end - -val _ = __builtin "exit" S.fourtyTwo diff --git a/tests/200-structure.sml b/tests/200-structure.sml new file mode 100644 index 0000000..dfc7b9b --- /dev/null +++ b/tests/200-structure.sml @@ -0,0 +1,5 @@ +structure S = struct + val fourtyTwo = 42 +end + +val _ = __builtin "exit" S.fourtyTwo diff --git a/tests/21-struct-datatype.sml b/tests/21-struct-datatype.sml deleted file mode 100644 index ab714ea..0000000 --- a/tests/21-struct-datatype.sml +++ /dev/null @@ -1,6 +0,0 @@ -structure S = struct - datatype D = D of int -end - -val S.D x = S.D 42 -val _ = __builtin "exit" x diff --git a/tests/210-struct-datatype.sml b/tests/210-struct-datatype.sml new file mode 100644 index 0000000..ab714ea --- /dev/null +++ b/tests/210-struct-datatype.sml @@ -0,0 +1,6 @@ +structure S = struct + datatype D = D of int +end + +val S.D x = S.D 42 +val _ = __builtin "exit" x diff --git a/tests/22-nested-struct.sml b/tests/22-nested-struct.sml deleted file mode 100644 index 1eaf6ab..0000000 --- a/tests/22-nested-struct.sml +++ /dev/null @@ -1,9 +0,0 @@ -structure S = struct - structure I = struct - val fourtyTwo = 42 - end -end - -structure T = S.I - -val _ = __builtin "exit" T.fourtyTwo diff --git a/tests/220-nested-struct.sml b/tests/220-nested-struct.sml new file mode 100644 index 0000000..1eaf6ab --- /dev/null +++ b/tests/220-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 diff --git a/tests/225-two-structs.sml b/tests/225-two-structs.sml new file mode 100644 index 0000000..465840f --- /dev/null +++ b/tests/225-two-structs.sml @@ -0,0 +1,9 @@ +structure A = struct + val fourtyTwo = 42 +end +val B = 10 +structure X = struct + val Y = A.fourtyTwo +end + +val _ = __builtin "exit" X.Y diff --git a/tests/23-signature.sml b/tests/23-signature.sml deleted file mode 100644 index 01a8494..0000000 --- a/tests/23-signature.sml +++ /dev/null @@ -1,10 +0,0 @@ -signature SIG = sig - val x : int -end - -structure Struct :> SIG = struct - val privateField = 41 - val x = 42 -end - -val _ = __builtin "exit" Struct.x diff --git a/tests/230-signature.sml b/tests/230-signature.sml new file mode 100644 index 0000000..01a8494 --- /dev/null +++ b/tests/230-signature.sml @@ -0,0 +1,10 @@ +signature SIG = sig + val x : int +end + +structure Struct :> SIG = struct + val privateField = 41 + val x = 42 +end + +val _ = __builtin "exit" Struct.x diff --git a/tests/24-functor.sml b/tests/24-functor.sml deleted file mode 100644 index d18337e..0000000 --- a/tests/24-functor.sml +++ /dev/null @@ -1,17 +0,0 @@ -signature MagicNumber = sig - val n : int -end - -functor Exiter(N : MagicNumber) = struct - fun exit _ = __builtin "exit" N.n -end - -structure FourtyTwo = struct - val a = 16 - val n = 42 - val z = 38 -end - -structure FourtyTwoExiter = Exiter(FourtyTwo) - -val _ = FourtyTwoExiter.exit () diff --git a/tests/240-functor.sml b/tests/240-functor.sml new file mode 100644 index 0000000..d18337e --- /dev/null +++ b/tests/240-functor.sml @@ -0,0 +1,17 @@ +signature MagicNumber = sig + val n : int +end + +functor Exiter(N : MagicNumber) = struct + fun exit _ = __builtin "exit" N.n +end + +structure FourtyTwo = struct + val a = 16 + val n = 42 + val z = 38 +end + +structure FourtyTwoExiter = Exiter(FourtyTwo) + +val _ = FourtyTwoExiter.exit () diff --git a/tests/250-list.sml b/tests/250-list.sml new file mode 100644 index 0000000..4aeecf2 --- /dev/null +++ b/tests/250-list.sml @@ -0,0 +1,6 @@ +val _ = __builtin "exit" + (case [1, 2, 42] of + [] => 10 + | [x] => x + | [_, _, x] => x + | _ => 13) diff --git a/tests/260-cons.sml b/tests/260-cons.sml new file mode 100644 index 0000000..f01cefe --- /dev/null +++ b/tests/260-cons.sml @@ -0,0 +1,4 @@ +val _ = __builtin "exit" + (case 42 :: [] of + x :: _ => x + | _ => 13) -- cgit v1.3.1