├── .depend ├── .gitignore ├── LICENSE ├── Makefile ├── README.md ├── Simplify-1.5.4.exe.win ├── Simplify-1.5.4.linux ├── bad-programs ├── failrefine.f ├── fib_refine.f └── mergesort_refine.f ├── pmlatex ├── refute ├── 1.f ├── 2.f ├── Makefile └── refute_harness ├── scripts ├── fault_injection ├── graph.gpl ├── hist_total.pl ├── make_hist ├── make_release.sh ├── make_table.pl ├── s └── statwrap.tex ├── src ├── basicalg.ml ├── basicalg.mli ├── compile.ml ├── compile.mli ├── constraint.ml ├── constraint.mli ├── db.ml ├── db.mli ├── debug.ml ├── debug.mli ├── eval.ml ├── eval.mli ├── formulaparse.ml ├── formulaparse.mli ├── gcenv.ml ├── gcenv.mli ├── gpl.ml ├── lexer.mll ├── main.ml ├── options.ml ├── options.mli ├── parser.mly ├── pdb.ml ├── platex.ml ├── prim_defs.ml ├── prim_defs.mli ├── primitives.ml ├── primitives.mli ├── print.ml ├── print.mli ├── sformula.ml ├── sformula.mli ├── simplify.ml ├── simplify.mli ├── subtype.ml ├── subtype.mli ├── support.ml ├── support.mli ├── syntax.ml ├── syntax.mli └── unittest.ml └── tests ├── Makefile ├── app.sage ├── arith.sage ├── assoc.sage ├── assume.sage ├── assumefail.sage ├── bad ├── arith.1.f ├── arith.10.f ├── arith.2.f ├── arith.3.f ├── arith.4.f ├── arith.5.f ├── arith.6.f ├── arith.7.f ├── arith.8.f ├── arith.9.f ├── arith.f ├── bst.1.f ├── bst.10.f ├── bst.2.f ├── bst.3.f ├── bst.4.f ├── bst.5.f ├── bst.6.f ├── bst.7.f ├── bst.8.f ├── bst.9.f ├── bst.f ├── heap.1.f ├── heap.10.f ├── heap.2.f ├── heap.3.f ├── heap.4.f ├── heap.5.f ├── heap.6.f ├── heap.7.f ├── heap.8.f ├── heap.9.f ├── heap.f ├── mergesort.1.f ├── mergesort.10.f ├── mergesort.2.f ├── mergesort.3.f ├── mergesort.4.f ├── mergesort.5.f ├── mergesort.6.f ├── mergesort.7.f ├── mergesort.8.f ├── mergesort.9.f ├── mergesort.f ├── polylist.1.f ├── polylist.10.f ├── polylist.2.f ├── polylist.3.f ├── polylist.4.f ├── polylist.5.f ├── polylist.6.f ├── polylist.7.f ├── polylist.8.f ├── polylist.9.f ├── polylist.f ├── printf.1.f ├── printf.10.f ├── printf.2.f ├── printf.3.f ├── printf.4.f ├── printf.5.f ├── printf.6.f ├── printf.7.f ├── printf.8.f ├── printf.9.f ├── printf.f ├── quicksort.1.f ├── quicksort.10.f ├── quicksort.2.f ├── quicksort.3.f ├── quicksort.4.f ├── quicksort.5.f ├── quicksort.6.f ├── quicksort.7.f ├── quicksort.8.f ├── quicksort.9.f ├── quicksort.f ├── regexp.1.f ├── regexp.10.f ├── regexp.2.f ├── regexp.3.f ├── regexp.4.f ├── regexp.5.f ├── regexp.6.f ├── regexp.7.f ├── regexp.8.f ├── regexp.9.f ├── regexp.f ├── stlc.1.f ├── stlc.10.f ├── stlc.2.f ├── stlc.3.f ├── stlc.4.f ├── stlc.5.f ├── stlc.6.f ├── stlc.7.f ├── stlc.8.f └── stlc.9.f ├── bst.sage ├── cast.sage ├── church_pairs.sage ├── commands.sage ├── datatype1.sage ├── fail1.sage ├── fail2.sage ├── fail4.sage ├── failrefine.sage ├── fib_refine.sage ├── foo.sage ├── gctest.sage ├── gctest2.sage ├── gctest3.sage ├── heap.sage ├── if.sage ├── mergesort.sage ├── polylist.sage ├── polymorphic.sage ├── primitives.sage ├── printf.sage ├── quicksort.sage ├── range.sage ├── redblack.sage ├── refine.sage ├── regexp.sage ├── sheard.sage ├── stlc.sage ├── stlc_norefine.sage ├── sugar_as.sage ├── sugar_fn.sage ├── sugar_if.sage ├── sugar_iff.sage ├── sugar_inteq.sage ├── sugar_let.sage ├── sugar_letrec.sage ├── sugar_rec.sage ├── test_harness.pl ├── testlist └── tree.sage /.depend: -------------------------------------------------------------------------------- 1 | src/support.cmo: src/support.cmi 2 | src/support.cmx: src/support.cmi 3 | src/options.cmo: src/options.cmi 4 | src/options.cmx: src/options.cmi 5 | src/syntax.cmo: src/syntax.cmi 6 | src/syntax.cmx: src/syntax.cmi 7 | src/print.cmo: src/print.cmi 8 | src/print.cmx: src/print.cmi 9 | src/primitives.cmo: src/primitives.cmi 10 | src/primitives.cmx: src/primitives.cmi 11 | src/parser.cmo: src/parser.cmi 12 | src/parser.cmx: src/parser.cmi 13 | src/eval.cmo: src/eval.cmi 14 | src/eval.cmx: src/eval.cmi 15 | src/gcenv.cmo: src/gcenv.cmi 16 | src/gcenv.cmx: src/gcenv.cmi 17 | src/db.cmo: src/db.cmi 18 | src/db.cmx: src/db.cmi 19 | src/subtype.cmo: src/subtype.cmi 20 | src/subtype.cmx: src/subtype.cmi 21 | src/prim_defs.cmo: src/prim_defs.cmi 22 | src/prim_defs.cmx: src/prim_defs.cmi 23 | src/compile.cmo: src/compile.cmi 24 | src/compile.cmx: src/compile.cmi 25 | src/formulaparse.cmo: src/formulaparse.cmi 26 | src/formulaparse.cmx: src/formulaparse.cmi 27 | src/simplify.cmo: src/simplify.cmi 28 | src/simplify.cmx: src/simplify.cmi 29 | src/sformula.cmo: src/sformula.cmi 30 | src/sformula.cmx: src/sformula.cmi 31 | src/basicalg.cmo: src/basicalg.cmi 32 | src/basicalg.cmx: src/basicalg.cmi 33 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.annot 2 | *.cmo 3 | *.cma 4 | *.cmi 5 | *.a 6 | *.o 7 | *.cmx 8 | *.cmxs 9 | *.cmxa 10 | 11 | /src/lexer.ml 12 | /src/parser.ml 13 | /src/parser.mli 14 | /src/parser.output 15 | /sage 16 | /platex 17 | /unittest 18 | /pdb 19 | -------------------------------------------------------------------------------- /Simplify-1.5.4.exe.win: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ucsc-proglang/sage/c62165999833fb044d2d86ffb0710b917b1ddacd/Simplify-1.5.4.exe.win -------------------------------------------------------------------------------- /Simplify-1.5.4.linux: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ucsc-proglang/sage/c62165999833fb044d2d86ffb0710b917b1ddacd/Simplify-1.5.4.linux -------------------------------------------------------------------------------- /bad-programs/failrefine.f: -------------------------------------------------------------------------------- 1 | (fn (x:Int.x=0) => x) 1;; 2 | -------------------------------------------------------------------------------- /bad-programs/fib_refine.f: -------------------------------------------------------------------------------- 1 | let rec fib (x:Int.x >= 1) = 2 | IF (Unit->Int) 3 | (x <= 2) 4 | (fn u => 1) 5 | (fn u => (fib (x-1)) + (fib (x-2))) 6 | unit;; 7 | 8 | fib 1;; 9 | fib 2;; 10 | fib 3;; 11 | -------------------------------------------------------------------------------- /pmlatex: -------------------------------------------------------------------------------- 1 | echo "$"`./platex`"$" 2 | -------------------------------------------------------------------------------- /refute/1.f: -------------------------------------------------------------------------------- 1 | ((0-4) as Int) as (x:Int.x>=0);; 2 | -------------------------------------------------------------------------------- /refute/2.f: -------------------------------------------------------------------------------- 1 | (fn (x:Int.x=0) => x) 1;; 2 | -------------------------------------------------------------------------------- /refute/Makefile: -------------------------------------------------------------------------------- 1 | SAGE = ../sage 2 | FFLAGS = -db ../cow.db -gcenv -nosimplify 3 | LOGS = $(patsubst %.f, %.out, $(wildcard *.f)) 4 | 5 | all: $(LOGS) $(SAGE) 6 | 7 | %.out: %.f 8 | @ ./refute_harness "$(SAGE) $(FFLAGS)" $< $@ 9 | 10 | clean: 11 | rm -f $(LOGS) 12 | -------------------------------------------------------------------------------- /refute/refute_harness: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # $1: command to run interpreter 3 | # $2: test file 4 | # $3: test log 5 | $1 $2 > $3 || true 6 | -------------------------------------------------------------------------------- /scripts/fault_injection: -------------------------------------------------------------------------------- 1 | #!/bin/tcsh 2 | # $1: command to run interpreter 3 | # $2: test file 4 | echo $* 5 | 6 | setenv TIMEOUT 5s 7 | 8 | setenv FLAGS '-maxeval 100 -prover "../Simplify" -phisto -noeval -infer' 9 | 10 | setenv FF `echo $2 | sed -e "s/\.sage//g"` 11 | 12 | # num 13 | ##################### 14 | setenv COUNT `ls bad/${FF}.*.sage | wc -l` 15 | 16 | 17 | # num w/ type errors 18 | ##################### 19 | setenv WT `grep -v "WELLTYPED" bad/${FF}.*.sage | sort | uniq | wc -l ` 20 | 21 | # with refinments 22 | ##################### 23 | echo "" > bad/${FF}.out 24 | foreach f (`ls bad/${FF}.*.sage`) 25 | echo $f 26 | (tcsh -c "limit cputime $TIMEOUT; $1 ${FLAGS} $f") > $f.tmp 27 | echo $f ":" `grep "Warning:" $f.tmp | wc -l` > $f.out 28 | end 29 | setenv REFINE `grep -v "0" bad/${FF}.*.sage.out | wc -l ` 30 | 31 | # without refinements 32 | ##################### 33 | echo "" > bad/${FF}.nr.out 34 | foreach f (`ls bad/${FF}.*.sage`) 35 | echo $f 36 | (tcsh -c "limit cputime $TIMEOUT; $1 -noeval -norefine $f") > $f.tmp2 37 | echo $f ":" `grep "Warning:" $f.tmp2 | wc -l` > $f.nr.out 38 | end 39 | setenv ML `grep -v "0" bad/${FF}.*.sage.nr.out | wc -l ` 40 | echo "${FF}.sage & $COUNT & $WT & $REFINE & $ML \\\\ % XXX" 41 | -------------------------------------------------------------------------------- /scripts/graph.gpl: -------------------------------------------------------------------------------- 1 | set terminal postscript portrait 8 2 | set output "hist.ps" 3 | set size 0.47, 0.15 4 | set pointsize 0.3 5 | set title "" 6 | set xlabel "Evaluation Steps" 7 | set ylabel "N (log scale)" 1.5 8 | set xrange [0:200] 9 | set logscale y 10 | set xtics nomirror ("0" 0, "50" 50, "100" 100, "150" 150, ">=200" 200) 11 | set ytics nomirror 12 | set tics out 13 | set nokey 14 | set border 3 15 | 16 | plot "hist.dat" with boxes fs solid 0.50 17 | -------------------------------------------------------------------------------- /scripts/hist_total.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | my (@fields, $filename, @totals, $i); 4 | 5 | while(<>) { 6 | @fields = split; 7 | $filename = shift @fields; 8 | for($i = 0; $i < scalar (@fields); $i++) { 9 | $totals[$i] += $fields[$i]; 10 | } 11 | } 12 | 13 | for($i = 0; $i < scalar (@totals); $i++) { 14 | print $i; print ".5"; print " $totals[$i] \n"; 15 | } 16 | 17 | -------------------------------------------------------------------------------- /scripts/make_hist: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | grep HISTO $* | sed -e 's/:E/ E/' | cut -d ' ' -f 1,4- > histall.dat 3 | ../scripts/hist_total.pl < histall.dat > hist.dat 4 | gnuplot ../scripts/graph.gpl 5 | 6 | -------------------------------------------------------------------------------- /scripts/make_release.sh: -------------------------------------------------------------------------------- 1 | 2 | echo Making release out of directory $PWD 3 | make clean 4 | 5 | TMPDIR=sage-src 6 | 7 | # We now longer really hack any of the repos contents, but 8 | mkdir $TMPDIR 9 | cp -r .depend `ls | grep -v '_darcs' | grep -v 'Simplify$'` $TMPDIR/ 10 | 11 | tar czf sage.tar.gz $TMPDIR 12 | zip sage.zip -r $TMPDIR 13 | rm -rf $TMPDIR 14 | -------------------------------------------------------------------------------- /scripts/make_table.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | $tlines = $tnsyes = $tnsmaybe = $tnsno = $tsyes = $tsmaybe = $tsno = 0; 4 | foreach $base (@ARGV) { 5 | $file = $base . ".sage"; 6 | $nslog = $base . ".nsout"; 7 | $log = $base . ".out"; 8 | @nsline = split(/\s+/, `grep MAYBE $nslog`); 9 | @nsstats = split(/\//, $nsline[2]); 10 | @sline = split(/\s+/, `grep MAYBE $log`); 11 | @stats = split(/\//, $sline[2]); 12 | ($_,$lines, $file) = split(/\s+/, " " . `wc -l $file`); 13 | 14 | $tlines += $lines; 15 | $tnsyes += $nsstats[0]; 16 | $tnsmaybe += $nsstats[2]; 17 | $tnsno += $nsstats[3]; 18 | $tsyes += $stats[0]; 19 | $tsmaybe += $stats[2]; 20 | $tsno += $stats[3]; 21 | print "\\texttt{$file} & $lines & $nsstats[0] & $nsstats[2] & "; 22 | print "$nsstats[3] & $stats[0] & $stats[2] & $stats[3] \\\\\n"; 23 | } 24 | 25 | print "\\hline\n"; 26 | print "Total & $tlines & $tnsyes & $tnsmaybe & $tnsno & "; 27 | print "$tsyes & $tsmaybe & $tsno \\\\\n"; 28 | -------------------------------------------------------------------------------- /scripts/s: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | SAGE=../sage 3 | 4 | args=($@) 5 | file=${args[$# - 1]} 6 | 7 | if [ -f $file ]; then 8 | $SAGE $@ 9 | echo -n "Committing file..." 10 | svn commit --non-interactive -m "automatic commit of $file" $file 11 | echo "done." 12 | else 13 | echo "$file not found" 14 | fi 15 | -------------------------------------------------------------------------------- /scripts/statwrap.tex: -------------------------------------------------------------------------------- 1 | \documentclass{article} 2 | \begin{document} 3 | \begin{tabular}{l|r|r@{~~}r@{~~}r|r@{~~}r@{~~}r} 4 | & & \multicolumn{3}{c|}{Without Prover} & 5 | \multicolumn{3}{c}{With Prover} \\ 6 | \multicolumn{1}{c|}{Benchmark} & \multicolumn{1}{c|}{Lines} & 7 | $\ \surd\ $ & $\ ?\ $ & $\ \times\ $ & $\ \surd\ $ & 8 | $\ ?\ $ & $\ \times\ $ \\ 9 | \hline 10 | \input{../tests/stats} 11 | \end{tabular} 12 | \end{document} 13 | -------------------------------------------------------------------------------- /src/basicalg.mli: -------------------------------------------------------------------------------- 1 | open Syntax 2 | open Subtype 3 | 4 | (** The basic subtyping algorithm *) 5 | val basic_subtype : subtype_algorithm 6 | 7 | -------------------------------------------------------------------------------- /src/compile.mli: -------------------------------------------------------------------------------- 1 | open Syntax 2 | open Support.Error 3 | 4 | (** Type-checked compilation of Sage terms *) 5 | 6 | (** [compile ctx tm] returns a pair [tm', ty] where [tm'] is the 7 | result of compilation and [ty] is its type. *) 8 | val compile_tm : context -> term -> term * term 9 | 10 | (** [typeof ctx tm] is valid only for already-compiled terms, 11 | and returns the memoized type for that term. *) 12 | val typeof : context -> term -> term 13 | 14 | (** matches the [unrefine] function in our paper *) 15 | val strip_refine_and_eval : info -> context -> ty -> ty 16 | -------------------------------------------------------------------------------- /src/constraint.mli: -------------------------------------------------------------------------------- 1 | open Support.Error 2 | open Syntax 3 | 4 | type constraint_t = info * context * term * term 5 | 6 | val type_constraints : context -> term -> term * constraint_t list 7 | 8 | val greedy_unify : constraint_t list -> replacement 9 | 10 | val print_constraint : constraint_t -> unit 11 | 12 | -------------------------------------------------------------------------------- /src/db.mli: -------------------------------------------------------------------------------- 1 | open Support.Pervasive 2 | open Support.Error 3 | 4 | open Syntax 5 | 6 | (* a database maps casts to term options, which are None 7 | * if the casts are known to fail, or the "via" term 8 | * otherwise. *) 9 | type cast = context * ty * ty 10 | 11 | type cast_result = term option bool3 12 | 13 | exception NotFoundInDB 14 | 15 | class database : 16 | string -> 17 | object 18 | method declare : info -> context -> ty -> ty -> cast_result -> unit 19 | method fini : unit -> unit 20 | method get_name : unit -> string 21 | method init : unit -> unit 22 | method clear_counts : string -> unit 23 | method print_state : unit -> unit 24 | method subtype : info -> context -> ty -> ty -> cast_result 25 | end 26 | -------------------------------------------------------------------------------- /src/debug.ml: -------------------------------------------------------------------------------- 1 | open Print 2 | open Options 3 | 4 | type key = string 5 | 6 | let debug_on key = ((mem "all" !option_debug_keys) || (mem key !option_debug_keys)) 7 | 8 | let debug key f = 9 | if debug_on key then f() else () 10 | 11 | let debug_pr key str = 12 | if debug_on key then (pr str) else () 13 | 14 | let debug_pr_newline key str = 15 | if debug_on key then (pr str; force_newline()) else () 16 | 17 | let counter = ref(0) 18 | 19 | let debug_wrapper (id :key) (intro : unit ->unit) (concl : 'a -> unit) 20 | (fn : unit -> 'a) : 'a = 21 | if debug_on id 22 | then 23 | begin 24 | let ind = !counter in 25 | counter := ind + 1; 26 | open_box 4; 27 | print_int ind; pr " >> "; 28 | intro(); 29 | let result = fn() in 30 | close_box(); 31 | (* if (!counter - 1) = ind 32 | then close_box();*) 33 | force_newline(); 34 | print_int ind; pr " << "; 35 | concl result; 36 | print_cut(); 37 | result 38 | end 39 | else fn() 40 | 41 | -------------------------------------------------------------------------------- /src/debug.mli: -------------------------------------------------------------------------------- 1 | 2 | (** This module contains debug printing functions. 3 | Debugging code is executed dependant on keys specify key with "-d KEY" on command line: *) 4 | 5 | type key = string 6 | 7 | (** Wrapper to prevent unit function from running if key turned off *) 8 | val debug : key -> (unit -> unit) -> unit 9 | 10 | (** [debug_pr key str] prints [str] if [key] is turned on *) 11 | val debug_pr : key -> string -> unit 12 | 13 | (** See [debug_pr] *) 14 | val debug_pr_newline : key -> string -> unit 15 | 16 | (** debug_wrapper - execute pre and post functions if key turned on. *) 17 | val debug_wrapper : key -> (unit -> unit) -> ('a -> unit) -> (unit -> 'a) -> 'a 18 | 19 | -------------------------------------------------------------------------------- /src/eval.mli: -------------------------------------------------------------------------------- 1 | open Support.Error 2 | open Syntax 3 | 4 | exception NoEvalRule of string * context * term 5 | 6 | val eval_compiler : (context -> term -> (term * term)) ref 7 | val eval_v : context -> term -> term 8 | 9 | (* Evaluator with counter that also evals fix at top level *) 10 | val eval_reset_counter : unit -> unit 11 | val eval_counter : unit -> int 12 | 13 | val eval_type_many : int -> context -> ty -> ty 14 | val eval_type : context -> ty -> ty 15 | val simplify_type : context -> ty -> ty 16 | -------------------------------------------------------------------------------- /src/formulaparse.mli: -------------------------------------------------------------------------------- 1 | type var = string 2 | type number = string 3 | type sTerm = 4 | SVar of var 5 | | SInt of number 6 | | SFun of var * sTerm list 7 | | SAdd of sTerm * sTerm 8 | | SSub of sTerm * sTerm 9 | | SMul of sTerm * sTerm 10 | 11 | type sPred = 12 | SAnd of sPred * sPred 13 | | SOr of sPred * sPred 14 | | SNot of sPred 15 | | SImp of sPred * sPred 16 | | SIff of sPred * sPred 17 | (* | SForAll of var list * sPred*) 18 | | SEq of sTerm * sTerm 19 | | SNeq of sTerm * sTerm 20 | | SLt of sTerm * sTerm 21 | | SLeq of sTerm * sTerm 22 | | SGt of sTerm * sTerm 23 | | SGeq of sTerm * sTerm 24 | | STrue 25 | | SFalse 26 | | SPropVar of var 27 | (* | SAndL of (sPred list)*) 28 | 29 | val s_and: string -> string -> string 30 | val s_imp: string -> string -> string 31 | 32 | val lift_sterm: string -> string 33 | 34 | val bool_term_rules: string 35 | 36 | val parse_spred: sPred -> string 37 | val parse_sterm: sTerm -> string 38 | -------------------------------------------------------------------------------- /src/gcenv.mli: -------------------------------------------------------------------------------- 1 | open Syntax 2 | open Support.Pervasive 3 | 4 | type rev_map 5 | 6 | (** Garbage-collects the context according to the root set contained in 7 | the term list, and returns a new context and list of fixed-up 8 | terms *) 9 | val gc_env_list : context -> term list -> (context * term list * rev_map) 10 | 11 | (** Convenience wrapper to gc_env_list on 2 elements *) 12 | val gc_env_2 : context -> term -> term 13 | -> (context * term * term * rev_map) 14 | 15 | (** Convenience wrapper to gc_env_list on 3 elements *) 16 | val gc_env_3 : context -> term -> term -> term 17 | -> (context * term * term * term * rev_map) 18 | 19 | val ungc_env : rev_map -> int -> context -> term -> term 20 | -------------------------------------------------------------------------------- /src/gpl.ml: -------------------------------------------------------------------------------- 1 | (* 2 | This file is part of Sage - A prototype hybrid-checked programming language 3 | Copyright (C) 2005 ??? 4 | 5 | Sage is free software; you can redistribute it and/or modify 6 | it under the terms of the GNU General Public License as published by 7 | the Free Software Foundation; either version 2 of the License, or 8 | (at your option) any later version. 9 | 10 | Sage is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU General Public License for more details. 14 | 15 | You should have received a copy of the GNU General Public License 16 | along with Sage; if not, write to the Free Software 17 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 18 | *) 19 | 20 | -------------------------------------------------------------------------------- /src/options.mli: -------------------------------------------------------------------------------- 1 | (** The options module handles the arguments through the parse_args 2 | method. *) 3 | 4 | (** parse_args - parses command-line args, returns list of filenames 5 | to process (may be empty) *) 6 | val parse_args : unit -> string list 7 | 8 | (** {6 Accessor Thunks for Options} 9 | Access values of all command-line options through thunks. See the arg_defs 10 | list in the source file options.mli to see meanings of each option. *) 11 | val search_path: unit -> string list 12 | val infer: unit -> bool 13 | val db: unit -> string option 14 | val psub: unit -> bool 15 | val peval: unit -> bool 16 | val pcasts: unit -> bool 17 | val csteps: unit -> bool 18 | val phisto: unit -> bool 19 | val pqph: unit -> bool 20 | val maxeval: unit -> int 21 | val stupid: unit -> bool 22 | val evalcomp: unit -> bool 23 | val perfect: unit -> bool 24 | val norefine: unit -> bool 25 | val gcenv: unit -> bool 26 | val loadprelude: unit -> bool 27 | val prelude: unit -> string 28 | val nosimplify: unit -> bool 29 | val simplifytimeout: unit -> int 30 | val pmaybe: unit -> bool 31 | val checkassumes: unit -> bool 32 | val noeval: unit -> bool 33 | val slog: unit -> bool 34 | val prover: unit -> string 35 | val prover_options: unit -> string 36 | val steps: unit -> bool 37 | val nopenv: unit -> bool 38 | val width: unit -> int 39 | val basicsteps: unit -> int 40 | 41 | 42 | (** {6 Debug wrapper code} 43 | debugging code executed dependant on keys 44 | specify key with "-d KEY" on command line: 45 | Always execute body. 46 | *) 47 | type key = string 48 | 49 | (** wrapper to allow unit function to execute only if key is on *) 50 | val debug : key -> (unit -> unit) -> unit 51 | 52 | (** print string if key turned on *) 53 | val debug_pr : key -> string -> unit 54 | 55 | (** same as [debug_pr] but adds newline *) 56 | val debug_pr_newline : key -> string -> unit 57 | 58 | (** executes all three functions if key turned on (in the order 1 3 2) but 59 | only the last function otherwise. *) 60 | val debug_wrapper : key -> (unit -> unit) -> ('a -> unit) -> 61 | (unit -> 'a) -> 'a 62 | 63 | (** {6 at_exit support } *) 64 | 65 | (** add an at_exit function *) 66 | val at_exit : (unit -> unit) -> unit 67 | 68 | (** calls at_exit functions *) 69 | val call_at_exits : unit -> unit 70 | -------------------------------------------------------------------------------- /src/pdb.ml: -------------------------------------------------------------------------------- 1 | open Sys 2 | open Db 3 | open Format 4 | 5 | let main () = 6 | Arg.parse [] 7 | (fun s -> 8 | if (file_exists s) then 9 | let db = (new database s) in 10 | db#init(); 11 | db#print_state() 12 | else 13 | print_string "DB does not exist"; force_newline() 14 | ) "" 15 | 16 | let () = set_max_boxes 1000 17 | let () = set_margin 120 18 | let () = main() 19 | -------------------------------------------------------------------------------- /src/prim_defs.mli: -------------------------------------------------------------------------------- 1 | open Syntax 2 | 3 | (** Definitions of the primitive constants in Sage, including their types, 4 | evaluation functions, casting behavior, and status as values. 5 | *) 6 | 7 | (** A list containing the definitions of each primitive. See the definition of 8 | [prim_info] for a description of the format of the entries in this list *) 9 | val prim_definitions : (string * prim_info) list 10 | 11 | (** [parse_string_term vars str] parses the term described by [str] in the 12 | environment where the variables in [vars] are in scope. Ideally, this 13 | should be in a different module, but restrictions on module recursion 14 | make this difficult. *) 15 | val parse_term_string : Syntax.var_list -> string -> Syntax.term 16 | 17 | (** A list of the valid primitive names, for use in the parser. This should 18 | include the first element of all of the pairs in [prim_definitions]. *) 19 | val prim_name_list : string list 20 | -------------------------------------------------------------------------------- /src/primitives.mli: -------------------------------------------------------------------------------- 1 | open Syntax 2 | open Support.Error 3 | 4 | (** {6 Primitive Constructors} *) 5 | 6 | val tm_prim : 7 | ?fi:info -> ?labels:label list -> string -> term 8 | 9 | (** Given a string representing an integer, creates a singleton type for that 10 | integer. *) 11 | val int_singleton : (string -> term) ref 12 | 13 | (** [make_cast fi ctx tyS tyT tm] creates a cast from type [tyS] to type [tyT] 14 | of term [tm], in the context [ctx], using [fi] to associate terms in the 15 | result with a file location. *) 16 | val make_cast : info -> context -> term -> term -> term -> term 17 | 18 | (** [make_refinement fi ctx var ty tm] creates the term [Refine ty (fn (x:ty) 19 | => tm)] * in the context [ctx] and with file info [fi]. *) 20 | val make_refinement : info -> variable list -> variable -> term -> 21 | term -> term 22 | 23 | (** [make_prim_app_sequence fi ctx pname labels terms] creates an application 24 | of the primitive given by [pname] to the term list [terms], in context 25 | [ctx] and with file info [fi]. The label list [labels] fills in the label 26 | field of the primitive. *) 27 | val make_prim_app_sequence : info -> variable list -> string -> label list -> 28 | term list -> term 29 | 30 | (** {6 Primitive Inspection} *) 31 | 32 | (** [get_prim_info fi ctx pname labels] retrieves the [prim_info] structure 33 | for the primitive denoted by [pname] and [labels]. Exits with an error 34 | message if the primitive requested does not exist. *) 35 | val get_prim_info : info -> context -> string -> label list -> prim_info 36 | 37 | (** Returns the name of the given primitive term. Raises [Invalid_argument] if 38 | the term is not a primitive. *) 39 | val prim_name : term -> string 40 | 41 | (** Returns the labels of the given primitive term. Raises [Invalid_argument] 42 | if the term is not a primitive. *) 43 | val prim_labels : term -> label list 44 | 45 | (** [primitive_ty fi ctx pname labels] returns the type of the primitive 46 | associated with [pname] and [labels], adjusted for the context [ctx]. 47 | Behaves like [get_prim_info] if the requested primitive does not exist. *) 48 | val primitive_ty : info -> context -> string -> label list -> term 49 | 50 | (** Behaves like [primitive_ty], but returns the arity of the primitive, 51 | rather than its type. *) 52 | val primitive_arity : info -> context -> string -> label list -> int 53 | 54 | (** Returns true if the given term is a primitive or an application of a 55 | primitive, and false otherwise. *) 56 | val is_primitive : term -> bool 57 | 58 | (** Returns true if the given term is a primitive with a name equal to the 59 | given name, or an application of such a primitive, and false otherwise. *) 60 | val is_named_primitive : term -> string -> bool 61 | 62 | (** Returns true if the given term is a value, false otherwise. TODO: do we 63 | * need a context and a file info? *) 64 | val is_val : info -> context -> term -> bool 65 | 66 | (** Returns true if the given term is an application of a primitive to its 67 | full number of arguments, and false otherwise. *) 68 | val is_full_prim_app : info -> context -> term -> bool 69 | 70 | (** Given an arrow type of any arity, returns a list of its component terms. 71 | TODO: should this be in term.ml? *) 72 | val fully_split_arrow : term -> (variable * term) list 73 | 74 | (** {6 Icky stuff} *) 75 | 76 | (** A reference to the list of primitives from prim_defs.ml, used to get 77 | around module recursion limitations. *) 78 | val prim_list : (string * prim_info) list ref 79 | 80 | (** A global reference used to get around module recursion limitations. *) 81 | val toplevel_parse_thunk: (string -> Syntax.var_list -> string list -> 82 | (Syntax.command list * Syntax.var_list)) ref 83 | -------------------------------------------------------------------------------- /src/print.mli: -------------------------------------------------------------------------------- 1 | open Support.Pervasive 2 | open Support.Error 3 | open Syntax 4 | 5 | (** Functions for printing terms, bindings, contexts, et cetera, and for 6 | converting terms to strings. *) 7 | 8 | (** [print_tm vars tm] prints the term [tm] to standard output, using [vars] 9 | to map variable indices to names. *) 10 | val print_tm : var_list -> term -> unit 11 | 12 | (** [print_binding ctx binding] prints a string representation of [binding] to 13 | standard output, using the context [ctx] to look up variables. Should 14 | [ctx] be a variable list, instead? *) 15 | val print_binding : context -> binding -> unit 16 | 17 | (** Print the names, types, and possibly terms in a context to standard 18 | output *) 19 | val print_ctx : context -> unit 20 | 21 | (** Convert a replacement to textual form and print to standard output. *) 22 | val print_replacement : replacement -> unit 23 | 24 | (** [print_str_tm str ctx tm] prints the the string [str] to standard output, 25 | followed by the textual representation of term [tm] in context [ctx]. *) 26 | val print_str_tm : string -> context -> term -> unit 27 | 28 | (** Alias for [Format.print_break 0 0]. *) 29 | val break: unit -> unit 30 | 31 | (** [print_subtype_judgement ctx s t] Prints just ctx :- s <: t *) 32 | val print_subtype_judgement : context -> ty -> ty -> unit 33 | 34 | (** [print_subtype_result ctx b] Print just "Yes", "Maybe", or "No", 35 | including the optional counterexample. *) 36 | val print_subtype_result : context -> term option bool3 -> unit 37 | 38 | (** [print_subtype_test ctx s t b] is a trivial wrapper on the 39 | above two functions. *) 40 | val print_subtype_test : context -> ty -> ty -> term option bool3 -> unit 41 | 42 | (** [string_of_tm buf vars tm] converts the term [tm] into a string, in the 43 | context described by [vars], and appends the result to the contents of 44 | pre-allocated buffer [buf]. *) 45 | val string_of_tm : Buffer.t -> var_list -> term -> unit 46 | -------------------------------------------------------------------------------- /src/sformula.mli: -------------------------------------------------------------------------------- 1 | (** -----------------------SFORMULA MODULE ----------------------- 2 | The sformula module preprocesses the proving juedgement E|- s 3 | to make the Sage Syntax palatable to Simplify. At the end of the 4 | prove method call_simplify is called which is located in the simplify 5 | module. 6 | *) 7 | 8 | open Syntax 9 | open Support.Pervasive 10 | 11 | (** 12 | prove - the method accepts the judgement E|- s, converts it into legal 13 | Simplify formulas and then sends it to Simplify.call_simplify. 14 | The returned value is the judgement Simplify has made: True/Maybe/False 15 | NOTE: If it returns [False], it will always be [False None] 16 | *) 17 | 18 | val prove: context -> term -> 'a option bool3 19 | 20 | -------------------------------------------------------------------------------- /src/simplify.ml: -------------------------------------------------------------------------------- 1 | open Unix 2 | open Buffer 3 | open Str 4 | open Options 5 | open Support.Error 6 | open Support.Pervasive 7 | open Print 8 | 9 | let stdin_write = ref(out_channel_of_descr stdout) 10 | and stdout_read = ref(in_channel_of_descr stdin) 11 | and simplify_on = ref(false) 12 | 13 | (**** logging utilities ****) 14 | let counter = ref 0 15 | 16 | let next_log_file() = 17 | let name = "sexp." ^ (string_of_int !counter) ^ ".log" in 18 | counter := !counter + 1; 19 | name 20 | 21 | let log log_file str = 22 | match (log_file) with 23 | | None -> () 24 | | Some(file) -> 25 | output_string file str; 26 | output_string file "\n\n"; 27 | flush file 28 | 29 | let close_log log_file = 30 | match (log_file) with 31 | | None -> () 32 | | Some(file) -> close_out file 33 | 34 | (********) 35 | 36 | let stop_simplify () = 37 | (ignore (close_process (!stdout_read, !stdin_write))) 38 | 39 | let write_to_simplify formula = 40 | output_string !stdin_write (formula ^ "\n"); 41 | flush !stdin_write 42 | 43 | let start_simplify () = 44 | putenv "PROVER_KILL_TIME" (string_of_int (Options.simplifytimeout())); 45 | let cmd = Options.prover() ^ " " ^ Options.prover_options() in 46 | pr "Starting Simplify with Command: "; 47 | pr cmd; 48 | Format.force_newline(); 49 | let (read_simplify, write_simplify) = 50 | open_process cmd in 51 | stdin_write := write_simplify; 52 | stdout_read := read_simplify; 53 | simplify_on := true; 54 | Options.at_exit stop_simplify; 55 | write_to_simplify Formulaparse.bool_term_rules 56 | 57 | let send_to_simplify formula = 58 | if not (!simplify_on) 59 | then start_simplify (); 60 | write_to_simplify formula 61 | 62 | let parse_answer res = 63 | try 64 | ignore (search_forward (regexp (quote "Valid.")) res 0); 65 | True 66 | with 67 | Not_found -> 68 | try 69 | let rng_end = search_forward (regexp (quote "Invalid.")) res 0 in 70 | try 71 | let rng_beg = 72 | (search_forward (regexp (quote "context:")) res 0) + 7 73 | in 74 | let counterexample = String.sub res rng_beg (rng_end-rng_beg) in 75 | False (Some counterexample) 76 | with 77 | Not_found -> False None 78 | with 79 | Not_found -> err "Bad answer from Simplify - check Simplify.out!" 80 | 81 | let rec get_simplify_response () = 82 | let response = input_line !stdout_read in 83 | if (String.length response) = 0 84 | then get_simplify_response() 85 | else response 86 | 87 | let num_calls = ref 0 88 | 89 | let () = Options.at_exit (fun () -> 90 | pr(Printf.sprintf "Number of Simplify queries: %d\n" !num_calls)) 91 | 92 | let call_simplify formula = 93 | num_calls := !num_calls+1; 94 | let log_file = if (Options.slog()) then 95 | Some(open_out (next_log_file())) 96 | else 97 | None 98 | in 99 | log log_file formula; 100 | send_to_simplify formula; 101 | let response = get_simplify_response() in 102 | log log_file (";; " ^ response); 103 | close_log log_file; 104 | parse_answer response 105 | 106 | -------------------------------------------------------------------------------- /src/simplify.mli: -------------------------------------------------------------------------------- 1 | (** 2 | The simplify module accepts a simplify formula, calls simplify on formula, 3 | and returns the response. 4 | *) 5 | 6 | open Support.Pervasive 7 | 8 | (** 9 | the method accepts a simplify formula. If Simplify is not already running, 10 | the module then forks a parallel process which runs the Simplify program. 11 | Then the simplify formula is piped to Simplify and the program waits for 12 | and then returns the response. 13 | *) 14 | val call_simplify: string -> string option bool3 15 | 16 | -------------------------------------------------------------------------------- /src/subtype.ml: -------------------------------------------------------------------------------- 1 | open Support.Error 2 | open Support.Pervasive 3 | open Syntax 4 | open List 5 | open Db 6 | open Print 7 | open Format 8 | open Options 9 | open Primitives 10 | open Eval 11 | open Sys 12 | open Gcenv 13 | 14 | (* ---------------------------------------------------------------------- *) 15 | (* Subtyping *) 16 | type subtype_tester = info -> context -> ty -> ty -> term option bool3 17 | 18 | type subtype_algorithm = subtype_tester -> subtype_tester 19 | 20 | 21 | (* Refs to the subtype testing function and the cleanup function *) 22 | let sub : subtype_tester ref = 23 | let err_fn _ _ _ = err "Subtype not initialized" in ref err_fn 24 | 25 | let sub_fini = ref (function () -> ()) 26 | 27 | let sub_good = 28 | let f _ _ _ _ = () in ref f 29 | 30 | let sub_bad = 31 | let f _ _ _ _ _ = () in ref f 32 | 33 | (**************************) 34 | 35 | let rec init_subtype algs dbo file_names = 36 | match (algs, dbo) with 37 | | ([],_) -> 38 | let is_sub fi ctx tyS tyT = Maybe in 39 | sub := is_sub 40 | 41 | | (alg::_,None) -> 42 | if file_exists "default.db" then remove "default.db"; 43 | init_subtype algs (Some "default.db") file_names 44 | 45 | | (alg::_,Some(db_name)) -> ( 46 | (* Create DB, and query that first *) 47 | let db = (new database db_name) in 48 | db#init(); 49 | if file_names <> [] then List.iter (db # clear_counts) file_names; 50 | let rec is_sub fi ctx t1 t2 = 51 | try db # subtype fi ctx t1 t2 52 | with NotFoundInDB -> 53 | let result = alg (db # subtype) fi ctx t1 t2 in 54 | db # declare fi ctx t1 t2 result; 55 | result 56 | in 57 | sub := is_sub; 58 | 59 | sub_bad := (fun fi ctx s t u -> db#declare fi ctx s t (False u)); 60 | sub_good := (fun fi ctx s t -> db#declare fi ctx s t True); 61 | sub_fini := (function () -> db#fini()) 62 | ) 63 | 64 | (* Main entry points: *) 65 | 66 | (* currently do nothing...*) 67 | 68 | let invalid_subtype fi ctx s t u = 69 | let s = eval_type ctx s in 70 | let t = eval_type ctx t in 71 | (!sub_bad) fi ctx s t u 72 | 73 | let valid_subtype fi ctx s t = 74 | let s = eval_type ctx s in 75 | let t = eval_type ctx t in 76 | (!sub_good) fi ctx s t 77 | 78 | let maybe_tests = ref [] 79 | let eval_steps = ref [] 80 | 81 | let rec print_maybes maybe_tests = 82 | List.iter 83 | (fun (ctx, s, t) -> 84 | print_info (tm_info s); 85 | force_newline(); 86 | print_subtype_judgement ctx s t; 87 | force_newline()) 88 | maybe_tests 89 | 90 | let num_in_range lo hi l = 91 | List.length(filter (function x -> (lo <= x & x < hi)) l) 92 | 93 | let rec make_histo l buckets = 94 | match buckets with 95 | | [] -> [] 96 | | lo::[] -> (num_in_range lo 100000 l)::[] 97 | | lo::hi::rest -> (num_in_range lo hi l)::(make_histo l (hi::rest)) 98 | 99 | let print_int_list l = 100 | iter (function (x) -> (Format.print_int x); pr " ") l 101 | 102 | let make_buckets c n = 103 | let rec h a = 104 | if a = n then [] 105 | else a::(h (a+c)) 106 | in 107 | h 0 108 | 109 | let print_stats() = 110 | if (Options.pmaybe()) then ( 111 | pr "--------------------------------------------"; 112 | force_newline(); 113 | pr "maybe tests:"; 114 | force_newline(); 115 | print_maybes !maybe_tests; 116 | pr "--------------------------------------------"; 117 | force_newline() 118 | ); 119 | if (Options.phisto()) then ( 120 | pr "EVAL HISTOGRAM: "; 121 | print_int_list (make_histo (!eval_steps) (make_buckets 1 100)); 122 | force_newline() 123 | ) 124 | 125 | let fini_subtype () = (!sub_fini) (); print_stats() 126 | 127 | (********************************************) 128 | 129 | let is_subtype fi ctx s t = 130 | eval_reset_counter(); 131 | let s = eval_type ctx s in 132 | let t = eval_type ctx t in 133 | let (ctx', s', t', inv) = gc_env_2 ctx s t in 134 | let result = (!sub) fi ctx' s' t' in 135 | if (Options.psub()) then ( 136 | pr "is_subtype: "; 137 | print_subtype_test ctx s t result; 138 | ); 139 | if result = Maybe then ( 140 | let (ctx', s', t', _) = gc_env_2 ctx' s' t' in 141 | maybe_tests := (ctx', s', t') :: !maybe_tests 142 | ); 143 | eval_steps := (eval_counter())::!eval_steps; 144 | result 145 | -------------------------------------------------------------------------------- /src/subtype.mli: -------------------------------------------------------------------------------- 1 | open Syntax 2 | open Support.Error 3 | open Support.Pervasive 4 | 5 | (** Type of main subtyping function. 6 | Returns Some(term) when the term should be applied as a cast. It is 7 | possible that this cast will always succeed and can be optimized away. 8 | Returns None when it can prove that the subtyping relationship does not 9 | hold. *) 10 | type subtype_tester = info -> context -> ty -> ty -> term option bool3 11 | 12 | (** Type of subtyping algorithms. An algorithm takes a delegate for 13 | doing recursive calls and returns a function matching the type above for 14 | actually doing the tests. *) 15 | type subtype_algorithm = subtype_tester -> subtype_tester 16 | 17 | (** Initialize the subtyping module, passing in the list a algorithms 18 | to use and the optional database name, and the option file name *) 19 | val init_subtype : 20 | subtype_algorithm list -> string option -> string list -> unit 21 | 22 | (** Call before exiting to write any state to disk *) 23 | val fini_subtype : unit -> unit 24 | 25 | (** Test a subtyping relation *) 26 | val is_subtype : subtype_tester 27 | 28 | (** Report that a subtyping relation is invalid *) 29 | val invalid_subtype : info -> context -> ty -> ty -> term option -> unit 30 | 31 | (** Report that a subtyping relation is valid *) 32 | val valid_subtype : info -> context -> ty -> ty -> unit 33 | 34 | val print_stats:unit -> unit 35 | -------------------------------------------------------------------------------- /src/support.ml: -------------------------------------------------------------------------------- 1 | open Format 2 | 3 | let foldi_left f init arr = 4 | snd (List.fold_left 5 | (fun (i, accum) next -> i + 1, f i accum next) 6 | (0,init) 7 | arr) 8 | 9 | let mapi f li = 10 | List.rev ( 11 | foldi_left 12 | (fun i newlist elem -> (f i elem) :: newlist) 13 | [] 14 | li 15 | ) 16 | 17 | let countlist l = 18 | let rec countlist' l c = 19 | match l with 20 | | [] -> [] 21 | | l::ls -> c::(countlist' ls (c + 1)) 22 | in 23 | countlist' l 0 24 | 25 | (* tail recursive to use fold_left + rev instead of fold_right, but 26 | mostly irrelevant *) 27 | let rec split3 l = 28 | let li1, li2, li3 = 29 | List.fold_left 30 | (fun (li1,li2,li3) (e1, e2, e3) -> (e1::li1, e2::li2, e3::li3)) 31 | ([],[],[]) 32 | l 33 | in 34 | List.rev li1, List.rev li2, List.rev li3 35 | 36 | let is_numeric_char chr = 37 | match chr with 38 | | '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' -> true 39 | | _ -> false 40 | 41 | let rec list_of_string str = 42 | if String.length str == 0 then [] 43 | else (String.get str 0):: 44 | (list_of_string (String.sub str 1 ((String.length str) - 1))) 45 | 46 | let is_numeric str = 47 | let all_digits cs = 48 | List.fold_left (fun a b -> a && b) true 49 | (List.map is_numeric_char cs) in 50 | let chars = (list_of_string str) in 51 | match chars with 52 | | ('-'::cs) -> all_digits cs 53 | | _ -> all_digits chars 54 | 55 | 56 | module Error = struct 57 | 58 | exception Exit of int 59 | 60 | type info = FI of string * int * int | UNKNOWN 61 | type 'a withinfo = {i: info; v: 'a} 62 | 63 | let dummyinfo = UNKNOWN 64 | let create_info f l c = FI(f, l, c) 65 | 66 | let string_of_info fi = match fi with 67 | | FI(f, l, c) -> f ^ ":" ^ (string_of_int l) ^ "." ^ (string_of_int c) 68 | | UNKNOWN -> "" 69 | 70 | let filename_of_info fi = match fi with 71 | | FI(f, l, c) -> f 72 | | UNKNOWN -> "" 73 | 74 | let lineno_of_info fi = match fi with 75 | | FI(f, l, c) -> l 76 | | UNKNOWN -> -1 77 | 78 | let column_of_info fi = match fi with 79 | | FI(f, l, c) -> c 80 | | UNKNOWN -> -1 81 | 82 | let errf f = 83 | print_flush(); 84 | open_vbox 0; 85 | open_hvbox 0; f(); print_cut(); close_box(); print_newline(); 86 | raise (Exit 1) 87 | 88 | let print_info = 89 | (* In the text of the book, file positions in error messages are replaced 90 | with the string "Error:" *) 91 | function 92 | FI(f, l, c) -> 93 | force_newline(); 94 | print_string f; 95 | print_string ":"; 96 | print_int l; print_string "."; 97 | print_int c; print_string ":" 98 | | UNKNOWN -> 99 | force_newline(); 100 | print_string ": " 101 | 102 | let errf_at fi f = 103 | errf (fun () -> 104 | print_string "Error: "; 105 | print_info fi; 106 | print_space(); 107 | f()) 108 | 109 | let err s = 110 | errf (fun () -> print_string "Error: "; print_string s; print_newline()) 111 | 112 | let error fi s = errf_at fi (fun()-> print_string s; print_newline()) 113 | 114 | let warnings = ref 0 115 | 116 | let num_warnings() = !warnings 117 | 118 | let warnf f = 119 | warnings := !warnings + 1; 120 | print_flush(); 121 | open_vbox 0; 122 | open_hvbox 0; f(); print_cut(); close_box(); print_newline() 123 | 124 | let warnf_at fi f = 125 | warnf (fun () -> 126 | print_string "Warning: "; 127 | print_info fi; 128 | print_space(); 129 | f()) 130 | 131 | let warn s = 132 | warnf (fun()-> print_string "Warning: "; print_string s; print_newline()) 133 | 134 | let warning fi s = warnf_at fi (fun()-> print_string s; print_newline()) 135 | 136 | end 137 | 138 | (* ---------------------------------------------------------------------- *) 139 | 140 | module Pervasive = struct 141 | 142 | type 'a bool3 = True | False of 'a | Maybe 143 | type info = Error.info 144 | 145 | open Str 146 | let newline = regexp "\n" 147 | let pr s = 148 | let substrs = full_split newline s in 149 | List.iter 150 | (function Delim _ -> force_newline () | Text s -> Format.print_string s) 151 | substrs 152 | 153 | end (* module pervasive *) 154 | -------------------------------------------------------------------------------- /src/unittest.ml: -------------------------------------------------------------------------------- 1 | open Format 2 | open Support.Error 3 | open Support.Pervasive 4 | open Syntax 5 | open Print 6 | open Primitives 7 | open Prim_defs 8 | open Compile 9 | open Eval 10 | open Subtype 11 | open Basicalg 12 | open Options 13 | 14 | let () = assert (is_full_prim_app dummyinfo [] (tm_prim "true"));; 15 | 16 | let di = dummyinfo;; 17 | 18 | let ty_Int = tm_prim "Int";; 19 | let ty_Bool = tm_prim "Bool";; 20 | let ty_Unit = tm_prim "Unit";; 21 | let tm_unit = tm_prim "unit";; 22 | let tm_true = tm_prim "true";; 23 | 24 | (* Yes, this is a weird thing to do (because of the weird index in the 25 | * variable). But it may help find bugs. *) 26 | let tm = subst_top_tm_in_tm tm_true 27 | (TmFun(di, 28 | "x", 29 | ty_Bool, 30 | TmVar(di, 31 | 0, 32 | sanity_check_from_var_list ["?"; "x"]))) 33 | in assert (term_eq tm (TmFun(di, 34 | "x", 35 | ty_Bool, 36 | TmVar(di, 37 | 0, 38 | sanity_check_from_var_list ["x"]))));; 39 | let tm = subst_top_tm_in_tm tm_true (TmVar(di, 40 | 0, 41 | sanity_check_from_var_list ["x"])) 42 | in 43 | assert (term_eq tm tm_true);; 44 | 45 | let tm = make_prim_app_sequence di [] "cast" [string_of_info di] 46 | [ty_Bool; ty_Bool; tm_true] in 47 | let tm' = make_cast di [] ty_Bool ty_Bool tm_true in 48 | assert (term_eq tm tm');; 49 | 50 | assert (is_full_prim_app di [] (make_cast di [] ty_Bool ty_Bool tm_true));; 51 | 52 | let ty_star = primitive_ty di [] "*" [];; 53 | let ty_Unit = primitive_ty di [] "Unit" [];; 54 | let ty_unit = primitive_ty di [] "unit" [];; 55 | let ty_Bool = primitive_ty di [] "Bool" [];; 56 | let ty_true = primitive_ty di [] "true" [];; 57 | let ty_false = primitive_ty di [] "false" [];; 58 | let ty_not = primitive_ty di [] "not" [];; 59 | let ty_Int = primitive_ty di [] "Int" [];; 60 | let ty_add = primitive_ty di [] "add" [];; 61 | let ty_sub = primitive_ty di [] "sub" [];; 62 | let ty_IF = primitive_ty di [] "IF" [];; 63 | let ty_cast = primitive_ty di [] "cast" [];; 64 | let ty_Refine = primitive_ty di [] "Refine" [];; 65 | let ty_fix = primitive_ty di [] "fix" [];; 66 | 67 | let di = dummyinfo in 68 | let intTy = tm_prim "Int" in 69 | let pos = 70 | make_prim_app_sequence di [] "gt" [] 71 | [(TmVar(di, 0, sanity_check_from_var_list ["?"]));(tm_prim "0")] in 72 | let refinement = make_refinement di [] "x" intTy pos in 73 | assert(is_full_prim_app di [] refinement) 74 | -------------------------------------------------------------------------------- /tests/Makefile: -------------------------------------------------------------------------------- 1 | SAGE = ../sage 2 | 3 | LOGS = $(patsubst %.sage, %.out, $(wildcard *.sage)) 4 | NSLOGS = $(patsubst %.sage, %.nsout, $(wildcard *.sage)) 5 | BMLOGS = arith.out bst.out heap.out mergesort.out \ 6 | polylist.out printf.out regexp.out stlc.out 7 | BMBASES = $(patsubst %.out, %, $(BMLOGS)) 8 | BMNSLOGS = $(patsubst %.out, %.nsout, $(BMLOGS)) 9 | 10 | FAULTLOGS = arith.fault heap.fault mergesort.fault orderedtree.fault \ 11 | polylist.fault printf.fault quicksort.fault regexp.fault 12 | 13 | FAULTS = faults.tex 14 | 15 | STATS = stats.tex 16 | 17 | all: $(SAGE) $(LOGS) 18 | 19 | nosimplify: $(SAGE) $(NSLOGS) 20 | 21 | $(SAGE): 22 | cd ..; make 23 | 24 | %.out: %.sage $(SAGE) 25 | @- ./test_harness.pl 26 | 27 | %.nsout: %.sage $(SAGE) 28 | @- ./test_harness.pl 29 | 30 | %.fault: %.sage $(SAGE) 31 | @- ../scripts/fault_injection "$(SAGE)" $< | tee $@ 32 | 33 | hist: $(BMLOGS) 34 | ../scripts/make_hist $(BMLOGS) 35 | 36 | $(STATS): $(BMLOGS) $(BMNSLOGS) ../scripts/make_table.pl 37 | @ ../scripts/make_table.pl $(BMBASES) > $@ 38 | 39 | fault: $(FAULTLOGS) 40 | grep "XXX" $(FAULTLOGS) > faults.tex 41 | 42 | clean: 43 | rm -f $(LOGS) $(NSLOGS) $(FAULTLOGS) \ 44 | statwrap.aux statwrap.dvi statwrap.log stats.tex faults.tex \ 45 | hist.dat histall.dat hist.ps default.db 46 | -------------------------------------------------------------------------------- /tests/app.sage: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | fn (p:Int->Bool) (x:Int) => 5 | if p x 6 | then x as {y:Int|p y} 7 | else 0;; 8 | 9 | 10 | -------------------------------------------------------------------------------- /tests/arith.sage: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let min (a:Int) (b:Int) = 6 | if[c:Int.(a>=c) && (b>=c)] a >= b then 7 | b 8 | else 9 | a;; 10 | 11 | let max (a:Int) (b:Int) = 12 | if[c:Int.(c>=a) && (c>=b)] a >= b then 13 | a 14 | else 15 | b;; 16 | 17 | let abs (x:Int) = 18 | if[r:Int.r>=0] x >= 0 then 19 | x 20 | else 21 | (0 - x);; 22 | 23 | let Pos = (x:Int. x > 0);; 24 | 25 | let rec rem (n:Int) (d:Pos) : (r:Int.(r <= n) && (r < d)) = 26 | if[r:Int.(r <= n) && (r < d)] n < d then 27 | n 28 | else 29 | rem (n - d) d;; 30 | 31 | let pred (x:Int) : (r:Int.r < x) = x - 1;; 32 | 33 | let succ (x:Int) : (r:Int.r > x) = x + 1;; 34 | 35 | abs (0 - 5);; 36 | 37 | min 7 22;; 38 | 39 | max 12 41;; 40 | 41 | rem 6 4;; 42 | 43 | pred 18;; 44 | 45 | succ 9;; 46 | -------------------------------------------------------------------------------- /tests/assoc.sage: -------------------------------------------------------------------------------- 1 | (lambda x:Bool. lambda y:Bool. x) true false;; 2 | (lambda x:(z:Int->Int). lambda y:Int. x y) lambda x:Int. x;; 3 | -------------------------------------------------------------------------------- /tests/assume.sage: -------------------------------------------------------------------------------- 1 | let eq3 = x:Int.x = 3;; 2 | let g1 = x:Int.x >= 1;; 3 | let g0 = x:Int.x >= 0;; 4 | 5 | assume :- eq3 <: g1;; 6 | assume :- g1 <: g0;; 7 | 8 | assumenot :- eq3 <: x:Int.x >= 4;; 9 | 10 | (3 as g1) as g0;; 11 | 12 | assume x:(x:Int. x>=1), u:(u:Unit.(not (leq x 2))) 13 | :- (z:Int. z=x-1) <: (x:Int. x>=1);; 14 | 15 | -------------------------------------------------------------------------------- /tests/assumefail.sage: -------------------------------------------------------------------------------- 1 | let eq3 = x:Int.x = 3;; 2 | 3 | assumenot :- eq3 <: x:Int.x >= 4;; 4 | 5 | (3 as (x:Int.x >= 4));; 6 | -------------------------------------------------------------------------------- /tests/bad/arith.1.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let min (a:Int) (b:Int) = 6 | if[c:Int.(a>=c) && (b>=c)] a >= b then 7 | a 8 | else 9 | b;; 10 | 11 | let max (a:Int) (b:Int) = 12 | if[c:Int.(c>=a) && (c>=b)] a >= b then 13 | a 14 | else 15 | b;; 16 | 17 | let abs (x:Int) = 18 | if[r:Int.r>=0] x >= 0 then 19 | x 20 | else 21 | (0 - x);; 22 | 23 | let Pos = (x:Int. x > 0);; 24 | 25 | let rec rem (n:Int) (d:Pos) : (r:Int.(r <= n) && (r < d)) = 26 | if[r:Int.(r <= n) && (r < d)] n < d then 27 | n 28 | else 29 | rem (n - d) d;; 30 | 31 | let pred (x:Int) : (r:Int.r < x) = x - 1;; 32 | 33 | let succ (x:Int) : (r:Int.r > x) = x + 1;; 34 | 35 | abs (0 - 5);; 36 | 37 | min 7 22;; 38 | 39 | max 12 41;; 40 | 41 | rem 6 4;; 42 | 43 | pred 18;; 44 | 45 | succ 9;; 46 | -------------------------------------------------------------------------------- /tests/bad/arith.10.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let min (a:Int) (b:Int) = 6 | if[c:Int.(a>=c) && (b>=c)] a >= b then 7 | b 8 | else 9 | a;; 10 | 11 | let max (a:Int) (b:Int) = 12 | if[c:Int.(c>=a) && (c>=b)] a >= b then 13 | a 14 | else 15 | b;; 16 | 17 | let abs (x:Int) = 18 | if[r:Int.r>0] x >= 0 then 19 | x 20 | else 21 | (0 - x);; 22 | 23 | let Pos = (x:Int. x > 0);; 24 | 25 | let rec rem (n:Int) (d:Pos) : (r:Int.(r <= n) && (r < d)) = 26 | if[r:Int.(r <= n) && (r < d)] n < d then 27 | n 28 | else 29 | rem (n - d) d;; 30 | 31 | let pred (x:Int) : (r:Int.r < x) = x - 1;; 32 | 33 | let succ (x:Int) : (r:Int.r > x) = x + 1;; 34 | 35 | abs (0 - 5);; 36 | 37 | min 7 22;; 38 | 39 | max 12 41;; 40 | 41 | rem 6 4;; 42 | 43 | pred 18;; 44 | 45 | succ 9;; 46 | -------------------------------------------------------------------------------- /tests/bad/arith.2.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let min (a:Int) (b:Int) = 6 | if[c:Int.(a>=c) && (b>=c)] a >= b then 7 | b 8 | else 9 | a;; 10 | 11 | let max (a:Int) (b:Int) = 12 | if[c:Int.(c>=a) && (c>=b)] a >= b then 13 | b 14 | else 15 | a;; 16 | 17 | let abs (x:Int) = 18 | if[r:Int.r>=0] x >= 0 then 19 | x 20 | else 21 | (0 - x);; 22 | 23 | let Pos = (x:Int. x > 0);; 24 | 25 | let rec rem (n:Int) (d:Pos) : (r:Int.(r <= n) && (r < d)) = 26 | if[r:Int.(r <= n) && (r < d)] n < d then 27 | n 28 | else 29 | rem (n - d) d;; 30 | 31 | let pred (x:Int) : (r:Int.r < x) = x - 1;; 32 | 33 | let succ (x:Int) : (r:Int.r > x) = x + 1;; 34 | 35 | abs (0 - 5);; 36 | 37 | min 7 22;; 38 | 39 | max 12 41;; 40 | 41 | rem 6 4;; 42 | 43 | pred 18;; 44 | 45 | succ 9;; 46 | -------------------------------------------------------------------------------- /tests/bad/arith.3.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let min (a:Int) (b:Int) = 6 | if[c:Int.(a>=c) && (b>=c)] a <= b then 7 | b 8 | else 9 | a;; 10 | 11 | let max (a:Int) (b:Int) = 12 | if[c:Int.(c>=a) && (c>=b)] a >= b then 13 | a 14 | else 15 | b;; 16 | 17 | let abs (x:Int) = 18 | if[r:Int.r>=0] x >= 0 then 19 | x 20 | else 21 | (0 - x);; 22 | 23 | let Pos = (x:Int. x > 0);; 24 | 25 | let rec rem (n:Int) (d:Pos) : (r:Int.(r <= n) && (r < d)) = 26 | if[r:Int.(r <= n) && (r < d)] n < d then 27 | n 28 | else 29 | rem (n - d) d;; 30 | 31 | let pred (x:Int) : (r:Int.r < x) = x - 1;; 32 | 33 | let succ (x:Int) : (r:Int.r > x) = x + 1;; 34 | 35 | abs (0 - 5);; 36 | 37 | min 7 22;; 38 | 39 | max 12 41;; 40 | 41 | rem 6 4;; 42 | 43 | pred 18;; 44 | 45 | succ 9;; 46 | -------------------------------------------------------------------------------- /tests/bad/arith.4.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let min (a:Int) (b:Int) = 6 | if[c:Int.(a>=c) && (b>=c)] a >= b then 7 | b 8 | else 9 | a;; 10 | 11 | let max (a:Int) (b:Int) = 12 | if[c:Int.(c>=a) && (c>=b)] a <= b then 13 | a 14 | else 15 | b;; 16 | 17 | let abs (x:Int) = 18 | if[r:Int.r>=0] x >= 0 then 19 | x 20 | else 21 | (0 - x);; 22 | 23 | let Pos = (x:Int. x > 0);; 24 | 25 | let rec rem (n:Int) (d:Pos) : (r:Int.(r <= n) && (r < d)) = 26 | if[r:Int.(r <= n) && (r < d)] n < d then 27 | n 28 | else 29 | rem (n - d) d;; 30 | 31 | let pred (x:Int) : (r:Int.r < x) = x - 1;; 32 | 33 | let succ (x:Int) : (r:Int.r > x) = x + 1;; 34 | 35 | abs (0 - 5);; 36 | 37 | min 7 22;; 38 | 39 | max 12 41;; 40 | 41 | rem 6 4;; 42 | 43 | pred 18;; 44 | 45 | succ 9;; 46 | -------------------------------------------------------------------------------- /tests/bad/arith.5.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let min (a:Int) (b:Int) = 6 | if[c:Int.(a>=c) && (b>=c)] a >= b then 7 | b 8 | else 9 | a;; 10 | 11 | let max (a:Int) (b:Int) = 12 | if[c:Int.(c>=a) && (c>=b)] a >= b then 13 | a 14 | else 15 | b;; 16 | 17 | let abs (x:Int) = 18 | if[r:Int.r>=0] x <= 0 then 19 | x 20 | else 21 | (0 - x);; 22 | 23 | let Pos = (x:Int. x > 0);; 24 | 25 | let rec rem (n:Int) (d:Pos) : (r:Int.(r <= n) && (r < d)) = 26 | if[r:Int.(r <= n) && (r < d)] n < d then 27 | n 28 | else 29 | rem (n - d) d;; 30 | 31 | let pred (x:Int) : (r:Int.r < x) = x - 1;; 32 | 33 | let succ (x:Int) : (r:Int.r > x) = x + 1;; 34 | 35 | abs (0 - 5);; 36 | 37 | min 7 22;; 38 | 39 | max 12 41;; 40 | 41 | rem 6 4;; 42 | 43 | pred 18;; 44 | 45 | succ 9;; 46 | -------------------------------------------------------------------------------- /tests/bad/arith.6.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let min (a:Int) (b:Int) = 6 | if[c:Int.(a>=c) && (b>=c)] a >= b then 7 | b 8 | else 9 | a;; 10 | 11 | let max (a:Int) (b:Int) = 12 | if[c:Int.(c>=a) && (c>=b)] a >= b then 13 | a 14 | else 15 | b;; 16 | 17 | let abs (x:Int) = 18 | if[r:Int.r>=0] x >= 0 then 19 | x 20 | else 21 | (0 - x);; 22 | 23 | let Pos = (x:Int. x > 0);; 24 | 25 | let rec rem (n:Int) (d:Pos) : (r:Int.(r <= n) && (r < d)) = 26 | if[r:Int.(r <= n) && (r < d)] n > d then 27 | n 28 | else 29 | rem (n - d) d;; 30 | 31 | let pred (x:Int) : (r:Int.r < x) = x - 1;; 32 | 33 | let succ (x:Int) : (r:Int.r > x) = x + 1;; 34 | 35 | abs (0 - 5);; 36 | 37 | min 7 22;; 38 | 39 | max 12 41;; 40 | 41 | rem 6 4;; 42 | 43 | pred 18;; 44 | 45 | succ 9;; 46 | -------------------------------------------------------------------------------- /tests/bad/arith.7.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let min (a:Int) (b:Int) = 6 | if[c:Int.(a>=c) && (b>=c)] a >= b then 7 | b 8 | else 9 | a;; 10 | 11 | let max (a:Int) (b:Int) = 12 | if[c:Int.(c>=a) && (c>=b)] a >= b then 13 | a 14 | else 15 | b;; 16 | 17 | let abs (x:Int) = 18 | if[r:Int.r>=0] x >= 0 then 19 | x 20 | else 21 | (0 - x);; 22 | 23 | let Pos = (x:Int. x > 0);; 24 | 25 | let rec rem (n:Int) (d:Pos) : (r:Int.(r <= n) && (r < d)) = 26 | if[r:Int.(r <= n) && (r < d)] n < d then 27 | n 28 | else 29 | rem (n - d) n;; 30 | 31 | let pred (x:Int) : (r:Int.r < x) = x - 1;; 32 | 33 | let succ (x:Int) : (r:Int.r > x) = x + 1;; 34 | 35 | abs (0 - 5);; 36 | 37 | min 7 22;; 38 | 39 | max 12 41;; 40 | 41 | rem 6 4;; 42 | 43 | pred 18;; 44 | 45 | succ 9;; 46 | -------------------------------------------------------------------------------- /tests/bad/arith.8.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let min (a:Int) (b:Int) = 6 | if[c:Int.(a>=c) && (b>=c)] a >= b then 7 | b 8 | else 9 | a;; 10 | 11 | let max (a:Int) (b:Int) = 12 | if[c:Int.(c>=a) && (c>=b)] a >= b then 13 | a 14 | else 15 | b;; 16 | 17 | let abs (x:Int) = 18 | if[r:Int.r>=0] x >= 0 then 19 | x 20 | else 21 | (0 - x);; 22 | 23 | let Pos = (x:Int. x > 0);; 24 | 25 | let rec rem (n:Int) (d:Pos) : (r:Int.(r <= n) && (r < d)) = 26 | if[r:Int.(r <= n) && (r < d)] n < d then 27 | n 28 | else 29 | rem (n - d) d;; 30 | 31 | let pred (x:Int) : (r:Int.r > x) = x - 1;; 32 | 33 | let succ (x:Int) : (r:Int.r > x) = x + 1;; 34 | 35 | abs (0 - 5);; 36 | 37 | min 7 22;; 38 | 39 | max 12 41;; 40 | 41 | rem 6 4;; 42 | 43 | pred 18;; 44 | 45 | succ 9;; 46 | -------------------------------------------------------------------------------- /tests/bad/arith.9.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let min (a:Int) (b:Int) = 6 | if[c:Int.(a>=c) && (b>=c)] a >= b then 7 | b 8 | else 9 | a;; 10 | 11 | let max (a:Int) (b:Int) = 12 | if[c:Int.(c>=a) && (c>=b)] a >= b then 13 | a 14 | else 15 | b;; 16 | 17 | let abs (x:Int) = 18 | if[r:Int.r>=0] x >= 0 then 19 | x 20 | else 21 | (0 - x);; 22 | 23 | let Pos = (x:Int. x > 0);; 24 | 25 | let rec rem (n:Int) (d:Pos) : (r:Int.(r <= n) && (r < d)) = 26 | if[r:Int.(r <= n) && (r < d)] n < d then 27 | n 28 | else 29 | rem (n - d) d;; 30 | 31 | let pred (x:Int) : (r:Int.r < x) = x - 1;; 32 | 33 | let succ (x:Int) : (r:Int.r < x) = x + 1;; 34 | 35 | abs (0 - 5);; 36 | 37 | min 7 22;; 38 | 39 | max 12 41;; 40 | 41 | rem 6 4;; 42 | 43 | pred 18;; 44 | 45 | succ 9;; 46 | -------------------------------------------------------------------------------- /tests/bad/arith.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let min (a:Int) (b:Int) = 6 | if[c:Int.(a>=c) && (b>=c)] a >= b then 7 | b 8 | else 9 | a;; 10 | 11 | let max (a:Int) (b:Int) = 12 | if[c:Int.(c>=a) && (c>=b)] a >= b then 13 | a 14 | else 15 | b;; 16 | 17 | let abs (x:Int) = 18 | if[r:Int.r>=0] x >= 0 then 19 | x 20 | else 21 | (0 - x);; 22 | 23 | let Pos = (x:Int. x > 0);; 24 | 25 | let rec rem (n:Int) (d:Pos) : (r:Int.(r <= n) && (r < d)) = 26 | if[r:Int.(r <= n) && (r < d)] n < d then 27 | n 28 | else 29 | rem (n - d) d;; 30 | 31 | let pred (x:Int) : (r:Int.r < x) = x - 1;; 32 | 33 | let succ (x:Int) : (r:Int.r > x) = x + 1;; 34 | 35 | abs (0 - 5);; 36 | 37 | min 7 22;; 38 | 39 | max 12 41;; 40 | 41 | rem 6 4;; 42 | 43 | pred 18;; 44 | 45 | succ 9;; 46 | -------------------------------------------------------------------------------- /tests/bad/bst.1.f: -------------------------------------------------------------------------------- 1 | let Rint (lo:Int) (hi:Int) :* = (x:Int. (and (lo<=x) (x true) 11 | (fn i l r => 12 | (or (i=v) 13 | (if[Bool] v < i 14 | then search lo i l v 15 | else search i hi r v)));; 16 | 17 | let rec insert (lo:Int) (hi:Int) (t:BiTree lo hi) (v:Rint lo hi) : (BiTree lo hi) = 18 | caseBiTree lo hi t (BiTree lo hi) 19 | (fn u => 20 | Node lo hi v (Empty lo v) (Empty v hi)) 21 | (fn i l r => 22 | if[(BiTree lo hi)] v < i /* err if i <= v or v <= i*/ 23 | then Node lo hi i (insert lo i l /*err if r*/ (v/* err if i */+0)) r /* err if l */ 24 | else Node lo hi i l (insert i hi r (v+0)));; 25 | 26 | let rec sum (lo:Int) (hi:Int) (t:BiTree lo hi) : Int = 27 | caseBiTree lo hi t Int 28 | (fn u => 0) 29 | (fn i l r => 30 | (sum lo i l) + (sum i hi r));; 31 | 32 | 33 | 34 | let MININT : Int = 0-32767;; 35 | let MAXINT : Int = 32767;; 36 | 37 | let BTree = BiTree MININT MAXINT;; 38 | let Int16 = Rint MININT MAXINT;; 39 | let mt:BTree = Empty MININT MAXINT;; 40 | let ins (t:BTree) (v:Int16) : BTree = insert MININT MAXINT t v;; 41 | let get (t:BTree) (v:Int16) : Bool = search MININT MAXINT t v;; 42 | 43 | let t : BTree = (ins (ins (ins mt 1) 2) 3);; 44 | 45 | 46 | let Pos = Rint 1 MAXINT;; 47 | 48 | let PTree = BiTree 1 MAXINT;; 49 | 50 | let mtP:PTree = Empty 1 MAXINT;; 51 | let insP (t:PTree) (v:Pos) : PTree = insert 1 MAXINT t v;; 52 | let getP (t:PTree) (v:Pos) : Bool = search 1 MAXINT t v;; 53 | 54 | let tP : PTree = (insP (insP (insP mtP 1) 2) 3);; 55 | 56 | (getP tP 2);; /* true */ 57 | (getP tP 4);; /* false */ 58 | 59 | 60 | let sumAny = sum MININT MAXINT;; 61 | sumAny t;; 62 | /* sumAny tP;; */ 63 | -------------------------------------------------------------------------------- /tests/bad/bst.10.f: -------------------------------------------------------------------------------- 1 | let Rint (lo:Int) (hi:Int) :* = (x:Int. (and (lo<=x) (x false) 11 | (fn i l r => 12 | (or (i=v) 13 | (if[Bool] v < i 14 | then search lo i l v 15 | else search i hi r v)));; 16 | 17 | let rec insert (lo:Int) (hi:Int) (t:BiTree lo hi) (v:Rint lo hi) : (BiTree lo hi) = 18 | caseBiTree lo hi t (BiTree lo hi) 19 | (fn u => 20 | Node lo hi v (Empty lo v) (Empty v hi)) 21 | (fn i l r => 22 | if[(BiTree lo hi)] v < i /* err if i <= v or v <= i*/ 23 | then Node lo hi i (insert lo i l /*err if r*/ (v/* err if i */+0)) r /* err if l */ 24 | else Node lo hi i l (insert i hi r (v+0)));; 25 | 26 | let rec sum (lo:Int) (hi:Int) (t:BiTree lo hi) : Int = 27 | caseBiTree lo hi t Int 28 | (fn u => 0) 29 | (fn i l r => 30 | (sum lo i l) + (sum i hi r));; 31 | 32 | 33 | 34 | let MININT : Int = 0-32767;; 35 | let MAXINT : Int = 32767;; 36 | 37 | let BTree = BiTree MININT MAXINT;; 38 | let Int16 = Rint MININT MAXINT;; 39 | let mt:BTree = Empty MININT MAXINT;; 40 | let ins (t:BTree) (v:Int16) : BTree = insert MININT MAXINT t v;; 41 | let get (t:BTree) (v:Int16) : Bool = search MININT MAXINT t v;; 42 | 43 | let t : BTree = (ins (ins (ins mt 1) 2) 3);; 44 | 45 | 46 | let Pos = Rint 1 MAXINT;; 47 | 48 | let PTree = BiTree 1 MAXINT;; 49 | 50 | let mtP:PTree = Empty 1 MAXINT;; 51 | let insP (t:PTree) (v:Pos) : PTree = insert 1 MAXINT t v;; 52 | let getP (t:PTree) (v:Pos) : Bool = search 1 MAXINT t v;; 53 | 54 | let x = 0-3;; 55 | let tP : PTree = (insP (insP (insP mtP 1) 2) x);; 56 | 57 | (getP tP 2);; /* true */ 58 | (getP tP 4);; /* false */ 59 | 60 | 61 | let sumAny = sum MININT MAXINT;; 62 | sumAny t;; 63 | /* sumAny tP;; */ 64 | -------------------------------------------------------------------------------- /tests/bad/bst.2.f: -------------------------------------------------------------------------------- 1 | let Rint (lo:Int) (hi:Int) :* = (x:Int. (and (lo<=x) (x false) 11 | (fn i l r => 12 | (or (i=v) 13 | (if[Bool] v < i 14 | then search lo i l v 15 | else search i hi r v)));; 16 | 17 | let rec insert (lo:Int) (hi:Int) (t:BiTree lo hi) (v:Rint lo hi) : (BiTree lo hi) = 18 | caseBiTree lo hi t (BiTree lo hi) 19 | (fn u => 20 | Node lo hi v (Empty lo v) (Empty v hi)) 21 | (fn i l r => 22 | if[(BiTree lo hi)] v < i /* err if i <= v or v <= i*/ 23 | then Node lo hi i (insert lo i l /*err if r*/ (v/* err if i */+0)) r /* err if l */ 24 | else Node lo hi i l (insert i hi r (v+0)));; 25 | 26 | let rec sum (lo:Int) (hi:Int) (t:BiTree lo hi) : Int = 27 | caseBiTree lo hi t Int 28 | (fn u => 0) 29 | (fn i l r => 30 | (sum lo i l) + (sum i hi r));; 31 | 32 | 33 | 34 | let MININT : Int = 0-32767;; 35 | let MAXINT : Int = 32767;; 36 | 37 | let BTree = BiTree MININT MAXINT;; 38 | let Int16 = Rint MININT MAXINT;; 39 | let mt:BTree = Empty MININT MAXINT;; 40 | let ins (t:BTree) (v:Int16) : BTree = insert MININT MAXINT t v;; 41 | let get (t:BTree) (v:Int16) : Bool = search MININT MAXINT t v;; 42 | 43 | let t : BTree = (ins (ins (ins mt 1) 2) 3);; 44 | 45 | 46 | let Pos = Rint 1 MAXINT;; 47 | 48 | let PTree = BiTree 1 MAXINT;; 49 | 50 | let mtP:PTree = Empty 1 MAXINT;; 51 | let insP (t:PTree) (v:Pos) : PTree = insert 1 MAXINT t v;; 52 | let getP (t:PTree) (v:Pos) : Bool = search 1 MAXINT t v;; 53 | 54 | let tP : PTree = (insP (insP (insP mtP 1) 2) 3);; 55 | 56 | (getP tP 2);; /* true */ 57 | (getP tP 4);; /* false */ 58 | 59 | 60 | let sumAny = sum MININT MAXINT;; 61 | sumAny t;; 62 | /* sumAny tP;; */ 63 | -------------------------------------------------------------------------------- /tests/bad/bst.3.f: -------------------------------------------------------------------------------- 1 | let Rint (lo:Int) (hi:Int) :* = (x:Int. (and (lo<=x) (x false) 11 | (fn i l r => 12 | (or (i=v) 13 | (if[Bool] v > i 14 | then search lo i l v 15 | else search i hi r v)));; 16 | 17 | let rec insert (lo:Int) (hi:Int) (t:BiTree lo hi) (v:Rint lo hi) : (BiTree lo hi) = 18 | caseBiTree lo hi t (BiTree lo hi) 19 | (fn u => 20 | Node lo hi v (Empty lo v) (Empty v hi)) 21 | (fn i l r => 22 | if[(BiTree lo hi)] v < i /* err if i <= v or v <= i*/ 23 | then Node lo hi i (insert lo i l /*err if r*/ (v/* err if i */+0)) r /* err if l */ 24 | else Node lo hi i l (insert i hi r (v+0)));; 25 | 26 | let rec sum (lo:Int) (hi:Int) (t:BiTree lo hi) : Int = 27 | caseBiTree lo hi t Int 28 | (fn u => 0) 29 | (fn i l r => 30 | (sum lo i l) + (sum i hi r));; 31 | 32 | 33 | 34 | let MININT : Int = 0-32767;; 35 | let MAXINT : Int = 32767;; 36 | 37 | let BTree = BiTree MININT MAXINT;; 38 | let Int16 = Rint MININT MAXINT;; 39 | let mt:BTree = Empty MININT MAXINT;; 40 | let ins (t:BTree) (v:Int16) : BTree = insert MININT MAXINT t v;; 41 | let get (t:BTree) (v:Int16) : Bool = search MININT MAXINT t v;; 42 | 43 | let t : BTree = (ins (ins (ins mt 1) 2) 3);; 44 | 45 | 46 | let Pos = Rint 1 MAXINT;; 47 | 48 | let PTree = BiTree 1 MAXINT;; 49 | 50 | let mtP:PTree = Empty 1 MAXINT;; 51 | let insP (t:PTree) (v:Pos) : PTree = insert 1 MAXINT t v;; 52 | let getP (t:PTree) (v:Pos) : Bool = search 1 MAXINT t v;; 53 | 54 | let tP : PTree = (insP (insP (insP mtP 1) 2) 3);; 55 | 56 | (getP tP 2);; /* true */ 57 | (getP tP 4);; /* false */ 58 | 59 | 60 | let sumAny = sum MININT MAXINT;; 61 | sumAny t;; 62 | /* sumAny tP;; */ 63 | -------------------------------------------------------------------------------- /tests/bad/bst.4.f: -------------------------------------------------------------------------------- 1 | let Rint (lo:Int) (hi:Int) :* = (x:Int. (and (lo<=x) (x false) 11 | (fn i l r => 12 | (or (i=v) 13 | (if[Bool] v < i 14 | then search lo i r v 15 | else search i hi l v)));; 16 | 17 | let rec insert (lo:Int) (hi:Int) (t:BiTree lo hi) (v:Rint lo hi) : (BiTree lo hi) = 18 | caseBiTree lo hi t (BiTree lo hi) 19 | (fn u => 20 | Node lo hi v (Empty lo v) (Empty v hi)) 21 | (fn i l r => 22 | if[(BiTree lo hi)] v < i /* err if i <= v or v <= i*/ 23 | then Node lo hi i (insert lo i l /*err if r*/ (v/* err if i */+0)) r /* err if l */ 24 | else Node lo hi i l (insert i hi r (v+0)));; 25 | 26 | let rec sum (lo:Int) (hi:Int) (t:BiTree lo hi) : Int = 27 | caseBiTree lo hi t Int 28 | (fn u => 0) 29 | (fn i l r => 30 | (sum lo i l) + (sum i hi r));; 31 | 32 | 33 | 34 | let MININT : Int = 0-32767;; 35 | let MAXINT : Int = 32767;; 36 | 37 | let BTree = BiTree MININT MAXINT;; 38 | let Int16 = Rint MININT MAXINT;; 39 | let mt:BTree = Empty MININT MAXINT;; 40 | let ins (t:BTree) (v:Int16) : BTree = insert MININT MAXINT t v;; 41 | let get (t:BTree) (v:Int16) : Bool = search MININT MAXINT t v;; 42 | 43 | let t : BTree = (ins (ins (ins mt 1) 2) 3);; 44 | 45 | 46 | let Pos = Rint 1 MAXINT;; 47 | 48 | let PTree = BiTree 1 MAXINT;; 49 | 50 | let mtP:PTree = Empty 1 MAXINT;; 51 | let insP (t:PTree) (v:Pos) : PTree = insert 1 MAXINT t v;; 52 | let getP (t:PTree) (v:Pos) : Bool = search 1 MAXINT t v;; 53 | 54 | let tP : PTree = (insP (insP (insP mtP 1) 2) 3);; 55 | 56 | (getP tP 2);; /* true */ 57 | (getP tP 4);; /* false */ 58 | 59 | 60 | let sumAny = sum MININT MAXINT;; 61 | sumAny t;; 62 | /* sumAny tP;; */ 63 | -------------------------------------------------------------------------------- /tests/bad/bst.5.f: -------------------------------------------------------------------------------- 1 | let Rint (lo:Int) (hi:Int) :* = (x:Int. (and (lo<=x) (x false) 11 | (fn i l r => 12 | (or (i=v) 13 | (if[Bool] v < i 14 | then search lo i l v 15 | else search i hi r v)));; 16 | 17 | let rec insert (hi:Int) (lo:Int) (t:BiTree lo hi) (v:Rint lo hi) : (BiTree lo hi) = 18 | caseBiTree lo hi t (BiTree lo hi) 19 | (fn u => 20 | Node lo hi v (Empty lo v) (Empty v hi)) 21 | (fn i l r => 22 | if[(BiTree lo hi)] v < i /* err if i <= v or v <= i*/ 23 | then Node lo hi i (insert lo i l /*err if r*/ (v/* err if i */+0)) r /* err if l */ 24 | else Node lo hi i l (insert i hi r (v+0)));; 25 | 26 | let rec sum (lo:Int) (hi:Int) (t:BiTree lo hi) : Int = 27 | caseBiTree lo hi t Int 28 | (fn u => 0) 29 | (fn i l r => 30 | (sum lo i l) + (sum i hi r));; 31 | 32 | 33 | 34 | let MININT : Int = 0-32767;; 35 | let MAXINT : Int = 32767;; 36 | 37 | let BTree = BiTree MININT MAXINT;; 38 | let Int16 = Rint MININT MAXINT;; 39 | let mt:BTree = Empty MININT MAXINT;; 40 | let ins (t:BTree) (v:Int16) : BTree = insert MININT MAXINT t v;; 41 | let get (t:BTree) (v:Int16) : Bool = search MININT MAXINT t v;; 42 | 43 | let t : BTree = (ins (ins (ins mt 1) 2) 3);; 44 | 45 | 46 | let Pos = Rint 1 MAXINT;; 47 | 48 | let PTree = BiTree 1 MAXINT;; 49 | 50 | let mtP:PTree = Empty 1 MAXINT;; 51 | let insP (t:PTree) (v:Pos) : PTree = insert 1 MAXINT t v;; 52 | let getP (t:PTree) (v:Pos) : Bool = search 1 MAXINT t v;; 53 | 54 | let tP : PTree = (insP (insP (insP mtP 1) 2) 3);; 55 | 56 | (getP tP 2);; /* true */ 57 | (getP tP 4);; /* false */ 58 | 59 | 60 | let sumAny = sum MININT MAXINT;; 61 | sumAny t;; 62 | /* sumAny tP;; */ 63 | -------------------------------------------------------------------------------- /tests/bad/bst.6.f: -------------------------------------------------------------------------------- 1 | let Rint (lo:Int) (hi:Int) :* = (x:Int. (and (lo<=x) (x false) 11 | (fn i l r => 12 | (or (i=v) 13 | (if[Bool] v < i 14 | then search lo i l v 15 | else search i hi r v)));; 16 | 17 | let rec insert (lo:Int) (hi:Int) (t:BiTree lo hi) (v:Rint lo hi) : (BiTree lo hi) = 18 | caseBiTree lo hi t (BiTree lo hi) 19 | (fn u => 20 | Node lo hi v (Empty v hi) (Empty lo v) ) 21 | (fn i l r => 22 | if[(BiTree lo hi)] v < i /* err if i <= v or v <= i*/ 23 | then Node lo hi i (insert lo i l /*err if r*/ (v/* err if i */+0)) r /* err if l */ 24 | else Node lo hi i l (insert i hi r (v+0)));; 25 | 26 | let rec sum (lo:Int) (hi:Int) (t:BiTree lo hi) : Int = 27 | caseBiTree lo hi t Int 28 | (fn u => 0) 29 | (fn i l r => 30 | (sum lo i l) + (sum i hi r));; 31 | 32 | 33 | 34 | let MININT : Int = 0-32767;; 35 | let MAXINT : Int = 32767;; 36 | 37 | let BTree = BiTree MININT MAXINT;; 38 | let Int16 = Rint MININT MAXINT;; 39 | let mt:BTree = Empty MININT MAXINT;; 40 | let ins (t:BTree) (v:Int16) : BTree = insert MININT MAXINT t v;; 41 | let get (t:BTree) (v:Int16) : Bool = search MININT MAXINT t v;; 42 | 43 | let t : BTree = (ins (ins (ins mt 1) 2) 3);; 44 | 45 | 46 | let Pos = Rint 1 MAXINT;; 47 | 48 | let PTree = BiTree 1 MAXINT;; 49 | 50 | let mtP:PTree = Empty 1 MAXINT;; 51 | let insP (t:PTree) (v:Pos) : PTree = insert 1 MAXINT t v;; 52 | let getP (t:PTree) (v:Pos) : Bool = search 1 MAXINT t v;; 53 | 54 | let tP : PTree = (insP (insP (insP mtP 1) 2) 3);; 55 | 56 | (getP tP 2);; /* true */ 57 | (getP tP 4);; /* false */ 58 | 59 | 60 | let sumAny = sum MININT MAXINT;; 61 | sumAny t;; 62 | /* sumAny tP;; */ 63 | -------------------------------------------------------------------------------- /tests/bad/bst.7.f: -------------------------------------------------------------------------------- 1 | let Rint (lo:Int) (hi:Int) :* = (x:Int. (and (lo<=x) (x false) 11 | (fn i l r => 12 | (or (i=v) 13 | (if[Bool] v < i 14 | then search lo i l v 15 | else search i hi r v)));; 16 | 17 | let rec insert (lo:Int) (hi:Int) (t:BiTree lo hi) (v:Rint lo hi) : (BiTree lo hi) = 18 | caseBiTree lo hi t (BiTree lo hi) 19 | (fn u => 20 | Node lo hi v (Empty lo v) (Empty v hi)) 21 | (fn i l r => 22 | if[(BiTree lo hi)] v > i /* err if i <= v or v <= i*/ 23 | then Node lo hi i (insert lo i l /*err if r*/ (v/* err if i */+0)) r /* err if l */ 24 | else Node lo hi i l (insert i hi r (v+0)));; 25 | 26 | let rec sum (lo:Int) (hi:Int) (t:BiTree lo hi) : Int = 27 | caseBiTree lo hi t Int 28 | (fn u => 0) 29 | (fn i l r => 30 | (sum lo i l) + (sum i hi r));; 31 | 32 | 33 | 34 | let MININT : Int = 0-32767;; 35 | let MAXINT : Int = 32767;; 36 | 37 | let BTree = BiTree MININT MAXINT;; 38 | let Int16 = Rint MININT MAXINT;; 39 | let mt:BTree = Empty MININT MAXINT;; 40 | let ins (t:BTree) (v:Int16) : BTree = insert MININT MAXINT t v;; 41 | let get (t:BTree) (v:Int16) : Bool = search MININT MAXINT t v;; 42 | 43 | let t : BTree = (ins (ins (ins mt 1) 2) 3);; 44 | 45 | 46 | let Pos = Rint 1 MAXINT;; 47 | 48 | let PTree = BiTree 1 MAXINT;; 49 | 50 | let mtP:PTree = Empty 1 MAXINT;; 51 | let insP (t:PTree) (v:Pos) : PTree = insert 1 MAXINT t v;; 52 | let getP (t:PTree) (v:Pos) : Bool = search 1 MAXINT t v;; 53 | 54 | let tP : PTree = (insP (insP (insP mtP 1) 2) 3);; 55 | 56 | (getP tP 2);; /* true */ 57 | (getP tP 4);; /* false */ 58 | 59 | 60 | let sumAny = sum MININT MAXINT;; 61 | sumAny t;; 62 | /* sumAny tP;; */ 63 | -------------------------------------------------------------------------------- /tests/bad/bst.8.f: -------------------------------------------------------------------------------- 1 | let Rint (lo:Int) (hi:Int) :* = (x:Int. (and (lo<=x) (x false) 11 | (fn i l r => 12 | (or (i=v) 13 | (if[Bool] v < i 14 | then search lo i l v 15 | else search i hi r v)));; 16 | 17 | let rec insert (lo:Int) (hi:Int) (t:BiTree lo hi) (v:Rint lo hi) : (BiTree lo hi) = 18 | caseBiTree lo hi t (BiTree lo hi) 19 | (fn u => 20 | Node lo hi v (Empty lo v) (Empty v hi)) 21 | (fn i l r => 22 | if[(BiTree lo hi)] v < i /* err if i <= v or v <= i*/ 23 | then Node lo hi i (insert lo i l /*err if r*/ (v/* err if i */+0)) r /* err if l */ 24 | else Node lo hi i r (insert i hi r (v+0)));; 25 | 26 | let rec sum (lo:Int) (hi:Int) (t:BiTree lo hi) : Int = 27 | caseBiTree lo hi t Int 28 | (fn u => 0) 29 | (fn i l r => 30 | (sum lo i l) + (sum i hi r));; 31 | 32 | 33 | 34 | let MININT : Int = 0-32767;; 35 | let MAXINT : Int = 32767;; 36 | 37 | let BTree = BiTree MININT MAXINT;; 38 | let Int16 = Rint MININT MAXINT;; 39 | let mt:BTree = Empty MININT MAXINT;; 40 | let ins (t:BTree) (v:Int16) : BTree = insert MININT MAXINT t v;; 41 | let get (t:BTree) (v:Int16) : Bool = search MININT MAXINT t v;; 42 | 43 | let t : BTree = (ins (ins (ins mt 1) 2) 3);; 44 | 45 | 46 | let Pos = Rint 1 MAXINT;; 47 | 48 | let PTree = BiTree 1 MAXINT;; 49 | 50 | let mtP:PTree = Empty 1 MAXINT;; 51 | let insP (t:PTree) (v:Pos) : PTree = insert 1 MAXINT t v;; 52 | let getP (t:PTree) (v:Pos) : Bool = search 1 MAXINT t v;; 53 | 54 | let tP : PTree = (insP (insP (insP mtP 1) 2) 3);; 55 | 56 | (getP tP 2);; /* true */ 57 | (getP tP 4);; /* false */ 58 | 59 | 60 | let sumAny = sum MININT MAXINT;; 61 | sumAny t;; 62 | /* sumAny tP;; */ 63 | -------------------------------------------------------------------------------- /tests/bad/bst.9.f: -------------------------------------------------------------------------------- 1 | let Rint (lo:Int) (hi:Int) :* = (x:Int. (and (lo<=x) (x false) 11 | (fn i l r => 12 | (or (i=v) 13 | (if[Bool] v < i 14 | then search lo i l v 15 | else search i hi r v)));; 16 | 17 | let rec insert (lo:Int) (hi:Int) (t:BiTree lo hi) (v:Rint lo hi) : (BiTree lo hi) = 18 | caseBiTree lo hi t (BiTree lo hi) 19 | (fn u => 20 | Node lo hi v (Empty lo v) (Empty v hi)) 21 | (fn i l r => 22 | if[(BiTree lo hi)] v < i /* err if i <= v or v <= i*/ 23 | then Node lo hi i (insert lo i l /*err if r*/ (v/* err if i */+0)) r /* err if l */ 24 | else Node lo hi i l (insert i hi r (v+0)));; 25 | 26 | let rec sum (lo:Int) (hi:Int) (t:BiTree lo hi) : Int = 27 | caseBiTree lo hi t Int 28 | (fn u => 0) 29 | (fn i l r => 30 | (sum lo i r) + (sum i hi r));; 31 | 32 | 33 | 34 | let MININT : Int = 0-32767;; 35 | let MAXINT : Int = 32767;; 36 | 37 | let BTree = BiTree MININT MAXINT;; 38 | let Int16 = Rint MININT MAXINT;; 39 | let mt:BTree = Empty MININT MAXINT;; 40 | let ins (t:BTree) (v:Int16) : BTree = insert MININT MAXINT t v;; 41 | let get (t:BTree) (v:Int16) : Bool = search MININT MAXINT t v;; 42 | 43 | let t : BTree = (ins (ins (ins mt 1) 2) 3);; 44 | 45 | 46 | let Pos = Rint 1 MAXINT;; 47 | 48 | let PTree = BiTree 1 MAXINT;; 49 | 50 | let mtP:PTree = Empty 1 MAXINT;; 51 | let insP (t:PTree) (v:Pos) : PTree = insert 1 MAXINT t v;; 52 | let getP (t:PTree) (v:Pos) : Bool = search 1 MAXINT t v;; 53 | 54 | let tP : PTree = (insP (insP (insP mtP 1) 2) 3);; 55 | 56 | (getP tP 2);; /* true */ 57 | (getP tP 4);; /* false */ 58 | 59 | 60 | let sumAny = sum MININT MAXINT;; 61 | sumAny t;; 62 | /* sumAny tP;; */ 63 | -------------------------------------------------------------------------------- /tests/bad/bst.f: -------------------------------------------------------------------------------- 1 | let Rint (lo:Int) (hi:Int) :* = (x:Int. (and (lo<=x) (x false) 11 | (fn i l r => 12 | (or (i=v) 13 | (if[Bool] v < i 14 | then search lo i l v 15 | else search i hi r v)));; 16 | 17 | let rec insert (lo:Int) (hi:Int) (t:BiTree lo hi) (v:Rint lo hi) : (BiTree lo hi) = 18 | caseBiTree lo hi t (BiTree lo hi) 19 | (fn u => 20 | Node lo hi v (Empty lo v) (Empty v hi)) 21 | (fn i l r => 22 | if[(BiTree lo hi)] v < i /* err if i <= v or v <= i*/ 23 | then Node lo hi i (insert lo i l /*err if r*/ (v/* err if i */+0)) r /* err if l */ 24 | else Node lo hi i l (insert i hi r (v+0)));; 25 | 26 | let rec sum (lo:Int) (hi:Int) (t:BiTree lo hi) : Int = 27 | caseBiTree lo hi t Int 28 | (fn u => 0) 29 | (fn i l r => 30 | (sum lo i l) + (sum i hi r));; 31 | 32 | 33 | 34 | let MININT : Int = 0-32767;; 35 | let MAXINT : Int = 32767;; 36 | 37 | let BTree = BiTree MININT MAXINT;; 38 | let Int16 = Rint MININT MAXINT;; 39 | let mt:BTree = Empty MININT MAXINT;; 40 | let ins (t:BTree) (v:Int16) : BTree = insert MININT MAXINT t v;; 41 | let get (t:BTree) (v:Int16) : Bool = search MININT MAXINT t v;; 42 | 43 | let t : BTree = (ins (ins (ins mt 1) 2) 3);; 44 | 45 | 46 | let Pos = Rint 1 MAXINT;; 47 | 48 | let PTree = BiTree 1 MAXINT;; 49 | 50 | let mtP:PTree = Empty 1 MAXINT;; 51 | let insP (t:PTree) (v:Pos) : PTree = insert 1 MAXINT t v;; 52 | let getP (t:PTree) (v:Pos) : Bool = search 1 MAXINT t v;; 53 | 54 | let tP : PTree = (insP (insP (insP mtP 1) 2) 3);; 55 | 56 | (getP tP 2);; /* true */ 57 | (getP tP 4);; /* false */ 58 | 59 | 60 | let sumAny = sum MININT MAXINT;; 61 | sumAny t;; 62 | /* sumAny tP;; */ 63 | -------------------------------------------------------------------------------- /tests/bad/heap.1.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | /* (Heap m) <: (Heap n) iff n <= m */ 6 | datatype Heap (min:Int) = 7 | Empty 8 | | Node of (x:Int. min <= x) (c:Int) (l:(Heap x)) (r:(Heap x));; 9 | 10 | let n1 : (Heap 0) = (Empty 0);; 11 | let n2 : (Heap 1) = Node 1 1 6 12 | (Node 1 2 2 (Empty 2) (Empty 2)) 13 | (Node 1 4 2 (Empty 4) (Empty 4));; 14 | 15 | 16 | let foo (h:(Heap 0)) : Bool = true;; 17 | 18 | foo n2;; 19 | 20 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 21 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) then 22 | b 23 | else 24 | a;; 25 | 26 | let max = fn (a:Int) (b:Int) => 27 | if[c:Int.(c>=a) && (c>=b)] (a >= b) then 28 | a 29 | else 30 | b;; 31 | 32 | let heap_children (min:Int) (h:(Heap min)) : Int = 33 | caseHeap min h Int 34 | (fn u => 0) 35 | (fn x c l r => c);; 36 | 37 | let rec insert (hmin:Int) 38 | (h:(Heap hmin)) 39 | (v:Int) 40 | (rmin:Int.(rmin <= hmin) && (rmin <= v)) : 41 | (Heap rmin) = 42 | caseHeap hmin h (Heap rmin) 43 | (fn u => 44 | Node v v 2 (Empty v) (Empty v)) 45 | (fn x c l r => 46 | if[Heap rmin] x < v /* BUG: switched arguments */ 47 | then 48 | let newchildren : Int = (heap_children hmin h) + 1 in 49 | (Node rmin v newchildren (Node v x c l r) (Empty v)) 50 | else /* v >= x */ 51 | let lchildren : Int = heap_children x l in 52 | let rchildren : Int = heap_children x r in 53 | let newmin : (m:Int.(m <= x) && (m <= rmin)) = min x rmin in 54 | if[Heap rmin] lchildren < rchildren 55 | then 56 | Node rmin x (c + 1) (insert x l v x) r 57 | else 58 | Node rmin x (c + 1) l (insert x r v x)) 59 | ;; 60 | 61 | let extract_min (min:Int) (h:(Heap min)) : (r:Int.(min <= r)) = 62 | caseHeap min h (r:Int.(min <= r)) 63 | (fn u => min) /* This seems weird */ 64 | (fn x c l r => x) 65 | ;; 66 | 67 | let h1 = insert 0 (Empty 0) 1 0;; 68 | let h2 = insert 0 h1 2 0;; 69 | extract_min 0 h2;; 70 | -------------------------------------------------------------------------------- /tests/bad/heap.10.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | /* (Heap m) <: (Heap n) iff n <= m */ 6 | datatype Heap (min:Int) = 7 | Empty 8 | | Node of (x:Int. min <= x) (c:Int) (l:(Heap x)) (r:(Heap x));; 9 | 10 | let n1 : (Heap 0) = (Empty 0);; 11 | let n2 : (Heap 1) = Node 1 1 6 12 | (Node 1 2 2 (Empty 2) (Empty 2)) 13 | (Node 1 4 2 (Empty 4) (Empty 4));; 14 | 15 | 16 | let foo (h:(Heap 0)) : Bool = true;; 17 | 18 | foo n2;; 19 | 20 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 21 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) then 22 | b 23 | else 24 | a;; 25 | 26 | let max = fn (a:Int) (b:Int) => 27 | if[c:Int.(c>=a) && (c>=b)] (a >= b) then 28 | a 29 | else 30 | b;; 31 | 32 | let heap_children (min:Int) (h:(Heap min)) : Int = 33 | caseHeap min h Int 34 | (fn u => 0) 35 | (fn x c l r => c);; 36 | 37 | let rec insert (hmin:Int) 38 | (h:(Heap hmin)) 39 | (v:Int) 40 | (rmin:Int.(rmin <= hmin) && (rmin <= v)) : 41 | (Heap rmin) = 42 | caseHeap hmin h (Heap rmin) 43 | (fn u => 44 | Node v v 2 (Empty v) (Empty v)) 45 | (fn x c l r => 46 | if[Heap rmin] v < x 47 | then 48 | let newchildren : Int = (heap_children hmin h) + 1 in 49 | (Node rmin v newchildren (Node v x c l r) (Empty v)) 50 | else /* v >= x */ 51 | let lchildren : Int = heap_children x l in 52 | let rchildren : Int = heap_children x r in 53 | let newmin : (m:Int.(m <= x) && (m <= rmin)) = min x rmin in 54 | if[Heap rmin] lchildren < rchildren 55 | then 56 | Node rmin x (c + 1) (insert x l v x) r 57 | else 58 | Node rmin x (c + 1) l (insert x r x v)) /* BUG: flipped args */ 59 | ;; 60 | 61 | let extract_min (min:Int) (h:(Heap min)) : (r:Int.(min <= r)) = 62 | caseHeap min h (r:Int.(min <= r)) 63 | (fn u => min) /* This seems weird */ 64 | (fn x c l r => x) 65 | ;; 66 | 67 | let h1 = insert 0 (Empty 0) 1 0;; 68 | let h2 = insert 0 h1 2 0;; 69 | extract_min 0 h2;; 70 | -------------------------------------------------------------------------------- /tests/bad/heap.2.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | /* (Heap m) <: (Heap n) iff n <= m */ 6 | datatype Heap (min:Int) = 7 | Empty 8 | | Node of (x:Int. min <= x) (c:Int) (l:(Heap x)) (r:(Heap x));; 9 | 10 | let n1 : (Heap 0) = (Empty 0);; 11 | let n2 : (Heap 1) = Node 1 1 6 12 | (Node 1 2 2 (Empty 2) (Empty 2)) 13 | (Node 1 4 2 (Empty 4) (Empty 4));; 14 | 15 | 16 | let foo (h:(Heap 0)) : Bool = true;; 17 | 18 | foo n2;; 19 | 20 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 21 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) then 22 | b 23 | else 24 | a;; 25 | 26 | let max = fn (a:Int) (b:Int) => 27 | if[c:Int.(c>=a) && (c>=b)] (a >= b) then 28 | a 29 | else 30 | b;; 31 | 32 | let heap_children (min:Int) (h:(Heap min)) : Int = 33 | caseHeap min h Int 34 | (fn u => 0) 35 | (fn x c l r => c);; 36 | 37 | let rec insert (hmin:Int) 38 | (h:(Heap hmin)) 39 | (v:Int) 40 | (rmin:Int.(rmin <= hmin) && (rmin <= v)) : 41 | (Heap rmin) = 42 | caseHeap hmin h (Heap rmin) 43 | (fn u => 44 | Node v v 2 (Empty v) (Empty v)) 45 | (fn x c l r => 46 | if[Heap rmin] v < x 47 | then 48 | let newchildren : Int = (heap_children hmin h) + 1 in 49 | /* BUG: wrong arg */ 50 | (Node hmin v newchildren (Node v x c l r) (Empty v)) 51 | else /* v >= x */ 52 | let lchildren : Int = heap_children x l in 53 | let rchildren : Int = heap_children x r in 54 | let newmin : (m:Int.(m <= x) && (m <= rmin)) = min x rmin in 55 | if[Heap rmin] lchildren < rchildren 56 | then 57 | Node rmin x (c + 1) (insert x l v x) r 58 | else 59 | Node rmin x (c + 1) l (insert x r v x)) 60 | ;; 61 | 62 | let extract_min (min:Int) (h:(Heap min)) : (r:Int.(min <= r)) = 63 | caseHeap min h (r:Int.(min <= r)) 64 | (fn u => min) /* This seems weird */ 65 | (fn x c l r => x) 66 | ;; 67 | 68 | let h1 = insert 0 (Empty 0) 1 0;; 69 | let h2 = insert 0 h1 2 0;; 70 | extract_min 0 h2;; 71 | -------------------------------------------------------------------------------- /tests/bad/heap.3.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | /* (Heap m) <: (Heap n) iff n <= m */ 6 | datatype Heap (min:Int) = 7 | Empty 8 | | Node of (x:Int. min <= x) (c:Int) (l:(Heap x)) (r:(Heap x));; 9 | 10 | let n1 : (Heap 0) = (Empty 0);; 11 | let n2 : (Heap 1) = Node 1 1 6 12 | (Node 1 2 2 (Empty 2) (Empty 2)) 13 | (Node 1 4 2 (Empty 4) (Empty 4));; 14 | 15 | 16 | let foo (h:(Heap 0)) : Bool = true;; 17 | 18 | foo n2;; 19 | 20 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 21 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) then 22 | b 23 | else 24 | a;; 25 | 26 | let max = fn (a:Int) (b:Int) => 27 | if[c:Int.(c>=a) && (c>=b)] (a >= b) then 28 | a 29 | else 30 | b;; 31 | 32 | let heap_children (min:Int) (h:(Heap min)) : Int = 33 | caseHeap min h Int 34 | (fn u => 0) 35 | (fn x c l r => c);; 36 | 37 | let rec insert (hmin:Int) 38 | (h:(Heap hmin)) 39 | (v:Int) 40 | (rmin:Int.(rmin <= hmin) && (rmin <= v)) : 41 | (Heap rmin) = 42 | caseHeap hmin h (Heap rmin) 43 | (fn u => 44 | Node v v 2 (Empty v) (Empty v)) 45 | (fn x c l r => 46 | if[Heap rmin] v < x 47 | then 48 | let newchildren : Int = (heap_children hmin h) + 1 in 49 | /* BUG: wrong arg */ 50 | (Node hmin v newchildren (Node v x c l r) (Empty v)) 51 | else /* v >= x */ 52 | let lchildren : Int = heap_children x l in 53 | let rchildren : Int = heap_children x r in 54 | let newmin : (m:Int.(m <= x) && (m <= rmin)) = min x rmin in 55 | if[Heap rmin] lchildren < rchildren 56 | then 57 | Node rmin x (c + 1) (insert x l v x) r 58 | else 59 | Node rmin x (c + 1) l (insert x r v x)) 60 | ;; 61 | 62 | let extract_min (min:Int) (h:(Heap min)) : (r:Int.(min <= r)) = 63 | caseHeap min h (r:Int.(min <= r)) 64 | (fn u => min) /* This seems weird */ 65 | (fn x c l r => x) 66 | ;; 67 | 68 | let h1 = insert 0 (Empty 0) 1 0;; 69 | let h2 = insert 0 h1 2 0;; 70 | extract_min 0 h2;; 71 | -------------------------------------------------------------------------------- /tests/bad/heap.4.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | /* (Heap m) <: (Heap n) iff n <= m */ 6 | datatype Heap (min:Int) = 7 | Empty 8 | | Node of (x:Int. min <= x) (c:Int) (l:(Heap x)) (r:(Heap x));; 9 | 10 | let n1 : (Heap 0) = (Empty 0);; 11 | let n2 : (Heap 1) = Node 1 1 6 12 | (Node 1 2 2 (Empty 2) (Empty 2)) 13 | (Node 1 4 2 (Empty 4) (Empty 4));; 14 | 15 | 16 | let foo (h:(Heap 0)) : Bool = true;; 17 | 18 | foo n2;; 19 | 20 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 21 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) then 22 | b 23 | else 24 | a;; 25 | 26 | let max = fn (a:Int) (b:Int) => 27 | if[c:Int.(c>=a) && (c>=b)] (a >= b) then 28 | a 29 | else 30 | b;; 31 | 32 | let heap_children (min:Int) (h:(Heap min)) : Int = 33 | caseHeap min h Int 34 | (fn u => 0) 35 | (fn x c l r => c);; 36 | 37 | let rec insert (hmin:Int) 38 | (h:(Heap hmin)) 39 | (v:Int) 40 | (rmin:Int.(rmin <= hmin) && (rmin <= v)) : 41 | (Heap rmin) = 42 | caseHeap hmin h (Heap rmin) 43 | (fn u => 44 | /* BUG: wrong args */ 45 | Node hmin v 2 (Empty v) (Empty v)) 46 | (fn x c l r => 47 | if[Heap rmin] v < x 48 | then 49 | let newchildren : Int = (heap_children hmin h) + 1 in 50 | (Node rmin v newchildren (Node v x c l r) (Empty v)) 51 | else /* v >= x */ 52 | let lchildren : Int = heap_children x l in 53 | let rchildren : Int = heap_children x r in 54 | let newmin : (m:Int.(m <= x) && (m <= rmin)) = min x rmin in 55 | if[Heap rmin] lchildren < rchildren 56 | then 57 | Node rmin x (c + 1) (insert x l v x) r 58 | else 59 | Node rmin x (c + 1) l (insert x r v x)) 60 | ;; 61 | 62 | let extract_min (min:Int) (h:(Heap min)) : (r:Int.(min <= r)) = 63 | caseHeap min h (r:Int.(min <= r)) 64 | (fn u => min) /* This seems weird */ 65 | (fn x c l r => x) 66 | ;; 67 | 68 | let h1 = insert 0 (Empty 0) 1 0;; 69 | let h2 = insert 0 h1 2 0;; 70 | extract_min 0 h2;; 71 | -------------------------------------------------------------------------------- /tests/bad/heap.5.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | /* (Heap m) <: (Heap n) iff n <= m */ 6 | datatype Heap (min:Int) = 7 | Empty 8 | | Node of (x:Int. min <= x) (c:Int) (l:(Heap x)) (r:(Heap x));; 9 | 10 | let n1 : (Heap 1) = (Empty 0);; /* BUG: bad arg */ 11 | let n2 : (Heap 1) = Node 1 1 6 12 | (Node 1 2 2 (Empty 2) (Empty 2)) 13 | (Node 1 4 2 (Empty 4) (Empty 4));; 14 | 15 | 16 | let foo (h:(Heap 0)) : Bool = true;; 17 | 18 | foo n2;; 19 | 20 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 21 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) then 22 | b 23 | else 24 | a;; 25 | 26 | let max = fn (a:Int) (b:Int) => 27 | if[c:Int.(c>=a) && (c>=b)] (a >= b) then 28 | a 29 | else 30 | b;; 31 | 32 | let heap_children (min:Int) (h:(Heap min)) : Int = 33 | caseHeap min h Int 34 | (fn u => 0) 35 | (fn x c l r => c);; 36 | 37 | let rec insert (hmin:Int) 38 | (h:(Heap hmin)) 39 | (v:Int) 40 | (rmin:Int.(rmin <= hmin) && (rmin <= v)) : 41 | (Heap rmin) = 42 | caseHeap hmin h (Heap rmin) 43 | (fn u => 44 | Node v v 2 (Empty v) (Empty v)) 45 | (fn x c l r => 46 | if[Heap rmin] v < x 47 | then 48 | let newchildren : Int = (heap_children hmin h) + 1 in 49 | (Node rmin v newchildren (Node v x c l r) (Empty v)) 50 | else /* v >= x */ 51 | let lchildren : Int = heap_children x l in 52 | let rchildren : Int = heap_children x r in 53 | let newmin : (m:Int.(m <= x) && (m <= rmin)) = min x rmin in 54 | if[Heap rmin] lchildren < rchildren 55 | then 56 | Node rmin x (c + 1) (insert x l v x) r 57 | else 58 | Node rmin x (c + 1) l (insert x r v x)) 59 | ;; 60 | 61 | let extract_min (min:Int) (h:(Heap min)) : (r:Int.(min <= r)) = 62 | caseHeap min h (r:Int.(min <= r)) 63 | (fn u => min) /* This seems weird */ 64 | (fn x c l r => x) 65 | ;; 66 | 67 | let h1 = insert 0 (Empty 0) 1 0;; 68 | let h2 = insert 0 h1 2 0;; 69 | extract_min 0 h2;; 70 | -------------------------------------------------------------------------------- /tests/bad/heap.6.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | /* (Heap m) <: (Heap n) iff n <= m */ 6 | datatype Heap (min:Int) = 7 | Empty 8 | | Node of (x:Int. min <= x) (c:Int) (l:(Heap x)) (r:(Heap x));; 9 | 10 | let n1 : (Heap 0) = (Empty 0);; 11 | let n2 : (Heap 1) = Node 1 1 6 12 | (Node 1 2 2 (Empty 2) (Empty 2)) 13 | (Node 1 4 2 (Empty 4) (Empty 4));; 14 | 15 | 16 | let foo (h:(Heap 2)) : Bool = true;; /* BUG: bad arg */ 17 | 18 | foo n2;; 19 | 20 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 21 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) then 22 | b 23 | else 24 | a;; 25 | 26 | let max = fn (a:Int) (b:Int) => 27 | if[c:Int.(c>=a) && (c>=b)] (a >= b) then 28 | a 29 | else 30 | b;; 31 | 32 | let heap_children (min:Int) (h:(Heap min)) : Int = 33 | caseHeap min h Int 34 | (fn u => 0) 35 | (fn x c l r => c);; 36 | 37 | let rec insert (hmin:Int) 38 | (h:(Heap hmin)) 39 | (v:Int) 40 | (rmin:Int.(rmin <= hmin) && (rmin <= v)) : 41 | (Heap rmin) = 42 | caseHeap hmin h (Heap rmin) 43 | (fn u => 44 | Node v v 2 (Empty v) (Empty v)) 45 | (fn x c l r => 46 | if[Heap rmin] v < x 47 | then 48 | let newchildren : Int = (heap_children hmin h) + 1 in 49 | (Node rmin v newchildren (Node v x c l r) (Empty v)) 50 | else /* v >= x */ 51 | let lchildren : Int = heap_children x l in 52 | let rchildren : Int = heap_children x r in 53 | let newmin : (m:Int.(m <= x) && (m <= rmin)) = min x rmin in 54 | if[Heap rmin] lchildren < rchildren 55 | then 56 | Node rmin x (c + 1) (insert x l v x) r 57 | else 58 | Node rmin x (c + 1) l (insert x r v x)) 59 | ;; 60 | 61 | let extract_min (min:Int) (h:(Heap min)) : (r:Int.(min <= r)) = 62 | caseHeap min h (r:Int.(min <= r)) 63 | (fn u => min) /* This seems weird */ 64 | (fn x c l r => x) 65 | ;; 66 | 67 | let h1 = insert 0 (Empty 0) 1 0;; 68 | let h2 = insert 0 h1 2 0;; 69 | extract_min 0 h2;; 70 | -------------------------------------------------------------------------------- /tests/bad/heap.7.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | /* (Heap m) <: (Heap n) iff n <= m */ 6 | datatype Heap (min:Int) = 7 | Empty 8 | | Node of (x:Int. min <= x) (c:Int) (l:(Heap x)) (r:(Heap x));; 9 | 10 | let n1 : (Heap 0) = (Empty 0);; 11 | let n2 : (Heap 1) = Node 1 1 6 12 | (Node 1 2 2 (Empty 2) (Empty 2)) 13 | (Node 1 4 2 (Empty 4) (Empty 4));; 14 | 15 | 16 | let foo (h:(Heap 0)) : Bool = true;; 17 | 18 | foo n2;; 19 | 20 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 21 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) then 22 | b 23 | else 24 | a;; 25 | 26 | let max = fn (a:Int) (b:Int) => 27 | if[c:Int.(c>=a) && (c>=b)] (a >= b) then 28 | a 29 | else 30 | b;; 31 | 32 | let heap_children (min:Int) (h:(Heap min)) : Int = 33 | caseHeap min h Int 34 | (fn u => 0) 35 | (fn x c l r => c);; 36 | 37 | let rec insert (hmin:Int) 38 | (h:(Heap hmin)) 39 | (v:Int) 40 | /* BUG: wrong operator */ 41 | (rmin:Int.(rmin < hmin) && (rmin < v)) : 42 | (Heap rmin) = 43 | caseHeap hmin h (Heap rmin) 44 | (fn u => 45 | Node v v 2 (Empty v) (Empty v)) 46 | (fn x c l r => 47 | if[Heap rmin] v < x 48 | then 49 | let newchildren : Int = (heap_children hmin h) + 1 in 50 | (Node rmin v newchildren (Node v x c l r) (Empty v)) 51 | else /* v >= x */ 52 | let lchildren : Int = heap_children x l in 53 | let rchildren : Int = heap_children x r in 54 | let newmin : (m:Int.(m <= x) && (m <= rmin)) = min x rmin in 55 | if[Heap rmin] lchildren < rchildren 56 | then 57 | Node rmin x (c + 1) (insert x l v x) r 58 | else 59 | Node rmin x (c + 1) l (insert x r v x)) 60 | ;; 61 | 62 | let extract_min (min:Int) (h:(Heap min)) : (r:Int.(min <= r)) = 63 | caseHeap min h (r:Int.(min <= r)) 64 | (fn u => min) /* This seems weird */ 65 | (fn x c l r => x) 66 | ;; 67 | 68 | let h1 = insert 0 (Empty 0) 1 0;; 69 | let h2 = insert 0 h1 2 0;; 70 | extract_min 0 h2;; 71 | -------------------------------------------------------------------------------- /tests/bad/heap.8.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | /* (Heap m) <: (Heap n) iff n <= m */ 6 | datatype Heap (min:Int) = 7 | Empty 8 | | Node of (x:Int. min <= x) (c:Int) (l:(Heap x)) (r:(Heap x));; 9 | 10 | let n1 : (Heap 0) = (Empty 0);; 11 | let n2 : (Heap 1) = Node 1 1 6 12 | (Node 1 2 2 (Empty 2) (Empty 2)) 13 | (Node 1 4 2 (Empty 4) (Empty 4));; 14 | 15 | 16 | let foo (h:(Heap 0)) : Bool = true;; 17 | 18 | foo n2;; 19 | 20 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 21 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) then 22 | b 23 | else 24 | a;; 25 | 26 | let max = fn (a:Int) (b:Int) => 27 | if[c:Int.(c>=a) && (c>=b)] (a >= b) then 28 | a 29 | else 30 | b;; 31 | 32 | let heap_children (min:Int) (h:(Heap min)) : Int = 33 | caseHeap min h Int 34 | (fn u => 0) 35 | (fn x c l r => c);; 36 | 37 | let rec insert (hmin:Int) 38 | (h:(Heap hmin)) 39 | (v:Int) 40 | (rmin:Int.(rmin <= hmin) && (rmin <= v)) : 41 | (Heap rmin) = 42 | caseHeap hmin h (Heap rmin) 43 | (fn u => 44 | Node v v 2 (Empty v) (Empty v)) 45 | (fn x c l r => 46 | if[Heap rmin] v < x 47 | then 48 | let newchildren : Int = (heap_children hmin h) + 1 in 49 | /* BUG: bad args */ 50 | (Node rmin x newchildren (Node v v c l r) (Empty v)) 51 | else /* v >= x */ 52 | let lchildren : Int = heap_children x l in 53 | let rchildren : Int = heap_children x r in 54 | let newmin : (m:Int.(m <= x) && (m <= rmin)) = min x rmin in 55 | if[Heap rmin] lchildren < rchildren 56 | then 57 | Node rmin x (c + 1) (insert x l v x) r 58 | else 59 | Node rmin x (c + 1) l (insert x r v x)) 60 | ;; 61 | 62 | let extract_min (min:Int) (h:(Heap min)) : (r:Int.(min <= r)) = 63 | caseHeap min h (r:Int.(min <= r)) 64 | (fn u => min) /* This seems weird */ 65 | (fn x c l r => x) 66 | ;; 67 | 68 | let h1 = insert 0 (Empty 0) 1 0;; 69 | let h2 = insert 0 h1 2 0;; 70 | extract_min 0 h2;; 71 | -------------------------------------------------------------------------------- /tests/bad/heap.9.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | /* (Heap m) <: (Heap n) iff n <= m */ 6 | datatype Heap (min:Int) = 7 | Empty 8 | | Node of (x:Int. min <= x) (c:Int) (l:(Heap x)) (r:(Heap x));; 9 | 10 | let n1 : (Heap 0) = (Empty 0);; 11 | let n2 : (Heap 1) = Node 1 1 6 12 | (Node 1 2 2 (Empty 2) (Empty 2)) 13 | (Node 1 4 2 (Empty 4) (Empty 4));; 14 | 15 | 16 | let foo (h:(Heap 0)) : Bool = true;; 17 | 18 | foo n2;; 19 | 20 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 21 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) then 22 | b 23 | else 24 | a;; 25 | 26 | let max = fn (a:Int) (b:Int) => 27 | if[c:Int.(c>=a) && (c>=b)] (a >= b) then 28 | a 29 | else 30 | b;; 31 | 32 | let heap_children (min:Int) (h:(Heap min)) : Int = 33 | caseHeap min h Int 34 | (fn u => 0) 35 | (fn x c l r => c);; 36 | 37 | let rec insert (hmin:Int) 38 | (h:(Heap hmin)) 39 | (v:Int) 40 | (rmin:Int.(rmin <= hmin) && (rmin <= v)) : 41 | (Heap rmin) = 42 | caseHeap hmin h (Heap rmin) 43 | (fn u => 44 | Node v v 2 (Empty v) (Empty v)) 45 | (fn x c l r => 46 | if[Heap rmin] v < x 47 | then 48 | let newchildren : Int = (heap_children hmin h) + 1 in 49 | (Node rmin v newchildren (Node v x c l r) (Empty v)) 50 | else /* v >= x */ 51 | let lchildren : Int = heap_children x l in 52 | let rchildren : Int = heap_children x r in 53 | let newmin : (m:Int.(m <= x) && (m <= rmin)) = min x rmin in 54 | if[Heap rmin] lchildren < rchildren 55 | then 56 | Node rmin (c + 1) x (insert x l v x) r /* BUG: flipped args */ 57 | else 58 | Node rmin x (c + 1) l (insert x r v x)) 59 | ;; 60 | 61 | let extract_min (min:Int) (h:(Heap min)) : (r:Int.(min <= r)) = 62 | caseHeap min h (r:Int.(min <= r)) 63 | (fn u => min) /* This seems weird */ 64 | (fn x c l r => x) 65 | ;; 66 | 67 | let h1 = insert 0 (Empty 0) 1 0;; 68 | let h2 = insert 0 h1 2 0;; 69 | extract_min 0 h2;; 70 | -------------------------------------------------------------------------------- /tests/bad/heap.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | /* (Heap m) <: (Heap n) iff n <= m */ 6 | datatype Heap (min:Int) = 7 | Empty 8 | | Node of (x:Int. min <= x) (c:Int) (l:(Heap x)) (r:(Heap x));; 9 | 10 | let n1 : (Heap 0) = (Empty 0);; 11 | let n2 : (Heap 1) = Node 1 1 6 12 | (Node 1 2 2 (Empty 2) (Empty 2)) 13 | (Node 1 4 2 (Empty 4) (Empty 4));; 14 | 15 | 16 | let foo (h:(Heap 0)) : Bool = true;; 17 | 18 | foo n2;; 19 | 20 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 21 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) then 22 | b 23 | else 24 | a;; 25 | 26 | let max = fn (a:Int) (b:Int) => 27 | if[c:Int.(c>=a) && (c>=b)] (a >= b) then 28 | a 29 | else 30 | b;; 31 | 32 | let heap_children (min:Int) (h:(Heap min)) : Int = 33 | caseHeap min h Int 34 | (fn u => 0) 35 | (fn x c l r => c);; 36 | 37 | let rec insert (hmin:Int) 38 | (h:(Heap hmin)) 39 | (v:Int) 40 | (rmin:Int.(rmin <= hmin) && (rmin <= v)) : 41 | (Heap rmin) = 42 | caseHeap hmin h (Heap rmin) 43 | (fn u => 44 | Node v v 2 (Empty v) (Empty v)) 45 | (fn x c l r => 46 | if[Heap rmin] v < x 47 | then 48 | let newchildren : Int = (heap_children hmin h) + 1 in 49 | (Node rmin v newchildren (Node v x c l r) (Empty v)) 50 | else /* v >= x */ 51 | let lchildren : Int = heap_children x l in 52 | let rchildren : Int = heap_children x r in 53 | let newmin : (m:Int.(m <= x) && (m <= rmin)) = min x rmin in 54 | if[Heap rmin] lchildren < rchildren 55 | then 56 | Node rmin x (c + 1) (insert x l v x) r 57 | else 58 | Node rmin x (c + 1) l (insert x r v x)) 59 | ;; 60 | 61 | let extract_min (min:Int) (h:(Heap min)) : (r:Int.(min <= r)) = 62 | caseHeap min h (r:Int.(min <= r)) 63 | (fn u => min) /* This seems weird */ 64 | (fn x c l r => x) 65 | ;; 66 | 67 | let h1 = insert 0 (Empty 0) 1 0;; 68 | let h2 = insert 0 h1 2 0;; 69 | extract_min 0 h2;; 70 | -------------------------------------------------------------------------------- /tests/bad/mergesort.1.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let MININT = 0 - 32768;; 6 | let MAXINT = 32767;; 7 | 8 | datatype List (lo:Int) = 9 | Null 10 | | Cons of (h:Int) (t:(List lo));; 11 | 12 | datatype Pair (S:*) (T:*) = 13 | MkPair of (fst:S) (snd:T);; 14 | 15 | /* (OrderedList n) <: (OrderedList m) iff n >= m */ 16 | datatype OrderedList (lo:Int) = 17 | ONull 18 | | OCons of (h:Int.(lo <= h)) (t:(OrderedList h));; 19 | 20 | let l : (OrderedList 0) = OCons 0 0 (OCons 1 1 (ONull 2));; 21 | 22 | let exact (d:Int) : (e:Int.e=d) = d+0;; 23 | 24 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 25 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) 26 | then exact b 27 | else exact a;; 28 | 29 | let Above (x:Int):* = (y:Int.x<=y);; 30 | 31 | let rec merge (lo:Int) 32 | (lo1:Above lo) 33 | (l1:OrderedList lo1) 34 | (lo2:Above lo) 35 | (l2:OrderedList lo2) : 36 | (OrderedList lo) = 37 | caseOrderedList lo1 l1 (OrderedList lo) 38 | (fn u => l2) 39 | (fn h1 t1 => 40 | caseOrderedList lo2 l2 (OrderedList lo) 41 | (fn u => l1) 42 | (fn h2 t2 => 43 | if[OrderedList lo] h1 > h2 then /* BUG: reversed comparison */ 44 | (OCons lo h1 45 | (merge h1 h1 t1 h2 (OCons h2 h2 t2))) 46 | else 47 | (OCons lo h2 48 | (merge h2 h2 t2 h1 (OCons h1 h1 t1))) 49 | ) 50 | ) 51 | ;; 52 | 53 | let rec length (lo:Int) (l:(List lo)) : Int = 54 | caseList lo l Int 55 | (fn u => 0) 56 | (fn h t => 1 + (length lo t));; 57 | 58 | let partition (lo:Int) (l:(List lo)) : (Pair (List lo) (List lo)) = 59 | let rec helper (firsthalf:(List lo)) (secondhalf:(List lo)) : 60 | (Pair (List lo) (List lo)) = 61 | caseList lo firsthalf (Pair (List lo) (List lo)) 62 | (fn u => (MkPair (List lo) (List lo) firsthalf secondhalf)) 63 | (fn h t => 64 | if[Pair (List lo) (List lo)] 65 | ((length lo t) >= ((length lo secondhalf) + 1)) 66 | then 67 | helper t (Cons lo h secondhalf) 68 | else 69 | MkPair (List lo) (List lo) firsthalf secondhalf) 70 | in 71 | helper l (Null lo) 72 | ;; 73 | 74 | 75 | let rec merge_sort (lmin:Int) (l:(List lmin)) : (OrderedList lmin) = 76 | casePair (List lmin) (List lmin) (partition lmin l) (OrderedList lmin) 77 | (fn fst snd => 78 | let sorted1 = merge_sort lmin fst in 79 | let sorted2 = merge_sort lmin snd in 80 | merge lmin lmin sorted1 lmin sorted2);; 81 | -------------------------------------------------------------------------------- /tests/bad/mergesort.10.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let MININT = 0 - 32768;; 6 | let MAXINT = 32767;; 7 | 8 | datatype List (lo:Int) = 9 | Null 10 | | Cons of (h:Int) (t:(List lo));; 11 | 12 | datatype Pair (S:*) (T:*) = 13 | MkPair of (fst:S) (snd:T);; 14 | 15 | /* (OrderedList n) <: (OrderedList m) iff n >= m */ 16 | datatype OrderedList (lo:Int) = 17 | ONull 18 | | OCons of (h:Int.(lo <= h)) (t:(OrderedList h));; 19 | 20 | let l : (OrderedList 0) = OCons 0 0 (OCons 1 1 (ONull 2));; 21 | 22 | let exact (d:Int) : (e:Int.e=d) = d+0;; 23 | 24 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 25 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) 26 | then exact b 27 | else exact a;; 28 | 29 | let Above (x:Int):* = (y:Int.x<=y);; 30 | 31 | let rec merge (lo:Int) 32 | (lo1:Above lo) 33 | (l1:OrderedList lo1) 34 | (lo2:Above lo) 35 | (l2:OrderedList lo2) : 36 | (OrderedList lo) = 37 | caseOrderedList lo1 l1 (OrderedList lo) 38 | (fn u => l2) 39 | (fn h1 t1 => 40 | caseOrderedList lo2 l2 (OrderedList lo) 41 | (fn u => l1) 42 | (fn h2 t2 => 43 | if[OrderedList lo] h1 < h2 then 44 | (OCons lo h1 45 | (merge h1 h1 t1 h2 (OCons h2 h2 t2))) 46 | else 47 | (OCons lo h2 48 | (merge h2 h2 t2 h1 (OCons h2 h1 t1))) /* BUG: wrong arg */ 49 | ) 50 | ) 51 | ;; 52 | 53 | let rec length (lo:Int) (l:(List lo)) : Int = 54 | caseList lo l Int 55 | (fn u => 0) 56 | (fn h t => 1 + (length lo t));; 57 | 58 | let partition (lo:Int) (l:(List lo)) : (Pair (List lo) (List lo)) = 59 | let rec helper (firsthalf:(List lo)) (secondhalf:(List lo)) : 60 | (Pair (List lo) (List lo)) = 61 | caseList lo firsthalf (Pair (List lo) (List lo)) 62 | (fn u => (MkPair (List lo) (List lo) firsthalf secondhalf)) 63 | (fn h t => 64 | if[Pair (List lo) (List lo)] 65 | ((length lo t) >= ((length lo secondhalf) + 1)) 66 | then 67 | helper t (Cons lo h secondhalf) 68 | else 69 | MkPair (List lo) (List lo) firsthalf secondhalf) 70 | in 71 | helper l (Null lo) 72 | ;; 73 | 74 | 75 | let rec merge_sort (lmin:Int) (l:(List lmin)) : (OrderedList lmin) = 76 | casePair (List lmin) (List lmin) (partition lmin l) (OrderedList lmin) 77 | (fn fst snd => 78 | let sorted1 = merge_sort lmin fst in 79 | let sorted2 = merge_sort lmin snd in 80 | merge lmin lmin sorted1 lmin sorted2);; 81 | -------------------------------------------------------------------------------- /tests/bad/mergesort.2.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let MININT = 0 - 32768;; 6 | let MAXINT = 32767;; 7 | 8 | datatype List (lo:Int) = 9 | Null 10 | | Cons of (h:Int) (t:(List lo));; 11 | 12 | datatype Pair (S:*) (T:*) = 13 | MkPair of (fst:S) (snd:T);; 14 | 15 | /* (OrderedList n) <: (OrderedList m) iff n >= m */ 16 | datatype OrderedList (lo:Int) = 17 | ONull 18 | | OCons of (h:Int.(lo <= h)) (t:(OrderedList h));; 19 | 20 | let l : (OrderedList 0) = OCons 0 0 (OCons 1 1 (ONull 2));; 21 | 22 | let exact (d:Int) : (e:Int.e=d) = d+0;; 23 | 24 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 25 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) 26 | then exact b 27 | else exact a;; 28 | 29 | let Above (x:Int):* = (y:Int.x<=y);; 30 | 31 | let rec merge (lo:Int) 32 | (lo1:Above lo) 33 | (l1:OrderedList lo1) 34 | (lo2:Above lo) 35 | (l2:OrderedList lo2) : 36 | (OrderedList lo) = 37 | caseOrderedList lo1 l1 (OrderedList lo) 38 | (fn u => l2) 39 | (fn h1 t1 => 40 | caseOrderedList lo2 l2 (OrderedList lo) 41 | (fn u => l1) 42 | (fn h2 t2 => 43 | if[OrderedList lo] h1 < h2 then 44 | (OCons lo h1 45 | (merge h1 h1 t1 h2 (OCons h2 h1 t2))) /* BUG: flipped args */ 46 | else 47 | (OCons lo h2 48 | (merge h2 h2 t2 h1 (OCons h1 h1 t1))) 49 | ) 50 | ) 51 | ;; 52 | 53 | let rec length (lo:Int) (l:(List lo)) : Int = 54 | caseList lo l Int 55 | (fn u => 0) 56 | (fn h t => 1 + (length lo t));; 57 | 58 | let partition (lo:Int) (l:(List lo)) : (Pair (List lo) (List lo)) = 59 | let rec helper (firsthalf:(List lo)) (secondhalf:(List lo)) : 60 | (Pair (List lo) (List lo)) = 61 | caseList lo firsthalf (Pair (List lo) (List lo)) 62 | (fn u => (MkPair (List lo) (List lo) firsthalf secondhalf)) 63 | (fn h t => 64 | if[Pair (List lo) (List lo)] 65 | ((length lo t) >= ((length lo secondhalf) + 1)) 66 | then 67 | helper t (Cons lo h secondhalf) 68 | else 69 | MkPair (List lo) (List lo) firsthalf secondhalf) 70 | in 71 | helper l (Null lo) 72 | ;; 73 | 74 | 75 | let rec merge_sort (lmin:Int) (l:(List lmin)) : (OrderedList lmin) = 76 | casePair (List lmin) (List lmin) (partition lmin l) (OrderedList lmin) 77 | (fn fst snd => 78 | let sorted1 = merge_sort lmin fst in 79 | let sorted2 = merge_sort lmin snd in 80 | merge lmin lmin sorted1 lmin sorted2);; 81 | -------------------------------------------------------------------------------- /tests/bad/mergesort.3.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let MININT = 0 - 32768;; 6 | let MAXINT = 32767;; 7 | 8 | datatype List (lo:Int) = 9 | Null 10 | | Cons of (h:Int) (t:(List lo));; 11 | 12 | datatype Pair (S:*) (T:*) = 13 | MkPair of (fst:S) (snd:T);; 14 | 15 | /* (OrderedList n) <: (OrderedList m) iff n >= m */ 16 | datatype OrderedList (lo:Int) = 17 | ONull 18 | | OCons of (h:Int.(lo <= h)) (t:(OrderedList h));; 19 | 20 | let l : (OrderedList 0) = OCons 0 0 (OCons 1 1 (ONull 2));; 21 | 22 | let exact (d:Int) : (e:Int.e=d) = d+0;; 23 | 24 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 25 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) 26 | then exact b 27 | else exact a;; 28 | 29 | let Above (x:Int):* = (y:Int.x<=y);; 30 | 31 | let rec merge (lo:Int) 32 | (lo1:Above lo) 33 | (l1:OrderedList lo1) 34 | (lo2:Above lo) 35 | (l2:OrderedList lo2) : 36 | (OrderedList lo) = 37 | caseOrderedList lo1 l1 (OrderedList lo) 38 | (fn u => l2) 39 | (fn h1 t1 => 40 | caseOrderedList lo2 l2 (OrderedList lo) 41 | (fn u => l1) 42 | (fn h2 t2 => 43 | if[OrderedList lo] h1 < h2 then 44 | (OCons lo h1 45 | (merge h1 h1 t1 h2 (OCons h2 h2 t2))) 46 | else 47 | (OCons lo h2 48 | (merge h1 h2 t2 h1 (OCons h1 h1 t1))) /* BUG: flipped args */ 49 | ) 50 | ) 51 | ;; 52 | 53 | let rec length (lo:Int) (l:(List lo)) : Int = 54 | caseList lo l Int 55 | (fn u => 0) 56 | (fn h t => 1 + (length lo t));; 57 | 58 | let partition (lo:Int) (l:(List lo)) : (Pair (List lo) (List lo)) = 59 | let rec helper (firsthalf:(List lo)) (secondhalf:(List lo)) : 60 | (Pair (List lo) (List lo)) = 61 | caseList lo firsthalf (Pair (List lo) (List lo)) 62 | (fn u => (MkPair (List lo) (List lo) firsthalf secondhalf)) 63 | (fn h t => 64 | if[Pair (List lo) (List lo)] 65 | ((length lo t) >= ((length lo secondhalf) + 1)) 66 | then 67 | helper t (Cons lo h secondhalf) 68 | else 69 | MkPair (List lo) (List lo) firsthalf secondhalf) 70 | in 71 | helper l (Null lo) 72 | ;; 73 | 74 | 75 | let rec merge_sort (lmin:Int) (l:(List lmin)) : (OrderedList lmin) = 76 | casePair (List lmin) (List lmin) (partition lmin l) (OrderedList lmin) 77 | (fn fst snd => 78 | let sorted1 = merge_sort lmin fst in 79 | let sorted2 = merge_sort lmin snd in 80 | merge lmin lmin sorted1 lmin sorted2);; 81 | -------------------------------------------------------------------------------- /tests/bad/mergesort.4.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let MININT = 0 - 32768;; 6 | let MAXINT = 32767;; 7 | 8 | datatype List (lo:Int) = 9 | Null 10 | | Cons of (h:Int) (t:(List lo));; 11 | 12 | datatype Pair (S:*) (T:*) = 13 | MkPair of (fst:S) (snd:T);; 14 | 15 | /* (OrderedList n) <: (OrderedList m) iff n >= m */ 16 | datatype OrderedList (lo:Int) = 17 | ONull 18 | | OCons of (h:Int.(lo <= h)) (t:(OrderedList h));; 19 | 20 | let l : (OrderedList 0) = OCons 0 0 (OCons 1 1 (ONull 2));; 21 | 22 | let exact (d:Int) : (e:Int.e=d) = d+0;; 23 | 24 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 25 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) 26 | then exact b 27 | else exact a;; 28 | 29 | let Above (x:Int):* = (y:Int.x l2) 39 | (fn h1 t1 => 40 | caseOrderedList lo2 l2 (OrderedList lo) 41 | (fn u => l1) 42 | (fn h2 t2 => 43 | if[OrderedList lo] h1 < h2 then 44 | (OCons lo h1 45 | (merge h1 h1 t1 h2 (OCons h2 h2 t2))) 46 | else 47 | (OCons lo h2 48 | (merge h2 h2 t2 h1 (OCons h1 h1 t1))) 49 | ) 50 | ) 51 | ;; 52 | 53 | let rec length (lo:Int) (l:(List lo)) : Int = 54 | caseList lo l Int 55 | (fn u => 0) 56 | (fn h t => 1 + (length lo t));; 57 | 58 | let partition (lo:Int) (l:(List lo)) : (Pair (List lo) (List lo)) = 59 | let rec helper (firsthalf:(List lo)) (secondhalf:(List lo)) : 60 | (Pair (List lo) (List lo)) = 61 | caseList lo firsthalf (Pair (List lo) (List lo)) 62 | (fn u => (MkPair (List lo) (List lo) firsthalf secondhalf)) 63 | (fn h t => 64 | if[Pair (List lo) (List lo)] 65 | ((length lo t) >= ((length lo secondhalf) + 1)) 66 | then 67 | helper t (Cons lo h secondhalf) 68 | else 69 | MkPair (List lo) (List lo) firsthalf secondhalf) 70 | in 71 | helper l (Null lo) 72 | ;; 73 | 74 | 75 | let rec merge_sort (lmin:Int) (l:(List lmin)) : (OrderedList lmin) = 76 | casePair (List lmin) (List lmin) (partition lmin l) (OrderedList lmin) 77 | (fn fst snd => 78 | let sorted1 = merge_sort lmin fst in 79 | let sorted2 = merge_sort lmin snd in 80 | merge lmin lmin sorted1 lmin sorted2);; 81 | -------------------------------------------------------------------------------- /tests/bad/mergesort.5.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let MININT = 0 - 32768;; 6 | let MAXINT = 32767;; 7 | 8 | datatype List (lo:Int) = 9 | Null 10 | | Cons of (h:Int) (t:(List lo));; 11 | 12 | datatype Pair (S:*) (T:*) = 13 | MkPair of (fst:S) (snd:T);; 14 | 15 | /* (OrderedList n) <: (OrderedList m) iff n >= m */ 16 | datatype OrderedList (lo:Int) = 17 | ONull 18 | | OCons of (h:Int.(lo < h)) (t:(OrderedList h));; /* BUG: wrong operator */ 19 | 20 | let l : (OrderedList 0) = OCons 0 0 (OCons 1 1 (ONull 2));; 21 | 22 | let exact (d:Int) : (e:Int.e=d) = d+0;; 23 | 24 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 25 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) 26 | then exact b 27 | else exact a;; 28 | 29 | let Above (x:Int):* = (y:Int.x<=y);; 30 | 31 | let rec merge (lo:Int) 32 | (lo1:Above lo) 33 | (l1:OrderedList lo1) 34 | (lo2:Above lo) 35 | (l2:OrderedList lo2) : 36 | (OrderedList lo) = 37 | caseOrderedList lo1 l1 (OrderedList lo) 38 | (fn u => l2) 39 | (fn h1 t1 => 40 | caseOrderedList lo2 l2 (OrderedList lo) 41 | (fn u => l1) 42 | (fn h2 t2 => 43 | if[OrderedList lo] h1 < h2 then 44 | (OCons lo h1 45 | (merge h1 h1 t1 h2 (OCons h2 h2 t2))) 46 | else 47 | (OCons lo h2 48 | (merge h2 h2 t2 h1 (OCons h1 h1 t1))) 49 | ) 50 | ) 51 | ;; 52 | 53 | let rec length (lo:Int) (l:(List lo)) : Int = 54 | caseList lo l Int 55 | (fn u => 0) 56 | (fn h t => 1 + (length lo t));; 57 | 58 | let partition (lo:Int) (l:(List lo)) : (Pair (List lo) (List lo)) = 59 | let rec helper (firsthalf:(List lo)) (secondhalf:(List lo)) : 60 | (Pair (List lo) (List lo)) = 61 | caseList lo firsthalf (Pair (List lo) (List lo)) 62 | (fn u => (MkPair (List lo) (List lo) firsthalf secondhalf)) 63 | (fn h t => 64 | if[Pair (List lo) (List lo)] 65 | ((length lo t) >= ((length lo secondhalf) + 1)) 66 | then 67 | helper t (Cons lo h secondhalf) 68 | else 69 | MkPair (List lo) (List lo) firsthalf secondhalf) 70 | in 71 | helper l (Null lo) 72 | ;; 73 | 74 | 75 | let rec merge_sort (lmin:Int) (l:(List lmin)) : (OrderedList lmin) = 76 | casePair (List lmin) (List lmin) (partition lmin l) (OrderedList lmin) 77 | (fn fst snd => 78 | let sorted1 = merge_sort lmin fst in 79 | let sorted2 = merge_sort lmin snd in 80 | merge lmin lmin sorted1 lmin sorted2);; 81 | -------------------------------------------------------------------------------- /tests/bad/mergesort.6.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let MININT = 0 - 32768;; 6 | let MAXINT = 32767;; 7 | 8 | datatype List (lo:Int) = 9 | Null 10 | | Cons of (h:Int) (t:(List lo));; 11 | 12 | datatype Pair (S:*) (T:*) = 13 | MkPair of (fst:S) (snd:T);; 14 | 15 | /* (OrderedList n) <: (OrderedList m) iff n >= m */ 16 | datatype OrderedList (lo:Int) = 17 | ONull 18 | | OCons of (h:Int.(lo <= h)) (t:(OrderedList h));; 19 | 20 | let l : (OrderedList 0) = OCons 0 0 (OCons 1 1 (ONull 2));; 21 | 22 | let exact (d:Int) : (e:Int.e=d) = d+0;; 23 | 24 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 25 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) 26 | then exact b 27 | else exact a;; 28 | 29 | let Above (x:Int):* = (y:Int.x<=y);; 30 | 31 | let rec merge (lo:Int) 32 | (lo1:Above lo) 33 | (l1:OrderedList lo1) 34 | (lo2:Above lo) 35 | (l2:OrderedList lo2) : 36 | (OrderedList lo) = 37 | caseOrderedList lo1 l1 (OrderedList lo) 38 | (fn u => l2) 39 | (fn h1 t1 => 40 | caseOrderedList lo2 l2 (OrderedList lo) 41 | (fn u => l1) 42 | (fn h2 t2 => 43 | if[OrderedList lo] h1 < h2 then 44 | (OCons h1 lo /* BUG: flipped args */ 45 | (merge h1 h1 t1 h2 (OCons h2 h2 t2))) 46 | else 47 | (OCons lo h2 48 | (merge h2 h2 t2 h1 (OCons h1 h1 t1))) 49 | ) 50 | ) 51 | ;; 52 | 53 | let rec length (lo:Int) (l:(List lo)) : Int = 54 | caseList lo l Int 55 | (fn u => 0) 56 | (fn h t => 1 + (length lo t));; 57 | 58 | let partition (lo:Int) (l:(List lo)) : (Pair (List lo) (List lo)) = 59 | let rec helper (firsthalf:(List lo)) (secondhalf:(List lo)) : 60 | (Pair (List lo) (List lo)) = 61 | caseList lo firsthalf (Pair (List lo) (List lo)) 62 | (fn u => (MkPair (List lo) (List lo) firsthalf secondhalf)) 63 | (fn h t => 64 | if[Pair (List lo) (List lo)] 65 | ((length lo t) >= ((length lo secondhalf) + 1)) 66 | then 67 | helper t (Cons lo h secondhalf) 68 | else 69 | MkPair (List lo) (List lo) firsthalf secondhalf) 70 | in 71 | helper l (Null lo) 72 | ;; 73 | 74 | 75 | let rec merge_sort (lmin:Int) (l:(List lmin)) : (OrderedList lmin) = 76 | casePair (List lmin) (List lmin) (partition lmin l) (OrderedList lmin) 77 | (fn fst snd => 78 | let sorted1 = merge_sort lmin fst in 79 | let sorted2 = merge_sort lmin snd in 80 | merge lmin lmin sorted1 lmin sorted2);; 81 | -------------------------------------------------------------------------------- /tests/bad/mergesort.7.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let MININT = 0 - 32768;; 6 | let MAXINT = 32767;; 7 | 8 | datatype List (lo:Int) = 9 | Null 10 | | Cons of (h:Int) (t:(List lo));; 11 | 12 | datatype Pair (S:*) (T:*) = 13 | MkPair of (fst:S) (snd:T);; 14 | 15 | /* (OrderedList n) <: (OrderedList m) iff n >= m */ 16 | datatype OrderedList (lo:Int) = 17 | ONull 18 | | OCons of (h:Int.(lo <= h)) (t:(OrderedList h));; 19 | 20 | let l : (OrderedList 0) = OCons 0 0 (OCons 1 1 (ONull 2));; 21 | 22 | let exact (d:Int) : (e:Int.e=d) = d+0;; 23 | 24 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 25 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) 26 | then exact b 27 | else exact a;; 28 | 29 | let Above (x:Int):* = (y:Int.x<=y);; 30 | 31 | let rec merge (lo:Int) 32 | (lo1:Above lo) 33 | (l1:OrderedList lo1) 34 | (lo2:Above lo) 35 | (l2:OrderedList lo2) : 36 | (OrderedList lo) = 37 | caseOrderedList lo1 l1 (OrderedList lo) 38 | (fn u => l2) 39 | (fn h1 t1 => 40 | caseOrderedList lo2 l2 (OrderedList lo) 41 | (fn u => l1) 42 | (fn h2 t2 => 43 | if[OrderedList lo] h1 < h2 then 44 | (OCons lo h1 45 | (merge h1 h1 t1 h2 (OCons h2 h2 t2))) 46 | else 47 | (OCons lo h2 48 | (merge h1 h2 t2 h1 (OCons h1 h1 t1))) /* BUG: wrong arg */ 49 | ) 50 | ) 51 | ;; 52 | 53 | let rec length (lo:Int) (l:(List lo)) : Int = 54 | caseList lo l Int 55 | (fn u => 0) 56 | (fn h t => 1 + (length lo t));; 57 | 58 | let partition (lo:Int) (l:(List lo)) : (Pair (List lo) (List lo)) = 59 | let rec helper (firsthalf:(List lo)) (secondhalf:(List lo)) : 60 | (Pair (List lo) (List lo)) = 61 | caseList lo firsthalf (Pair (List lo) (List lo)) 62 | (fn u => (MkPair (List lo) (List lo) firsthalf secondhalf)) 63 | (fn h t => 64 | if[Pair (List lo) (List lo)] 65 | ((length lo t) >= ((length lo secondhalf) + 1)) 66 | then 67 | helper t (Cons lo h secondhalf) 68 | else 69 | MkPair (List lo) (List lo) firsthalf secondhalf) 70 | in 71 | helper l (Null lo) 72 | ;; 73 | 74 | 75 | let rec merge_sort (lmin:Int) (l:(List lmin)) : (OrderedList lmin) = 76 | casePair (List lmin) (List lmin) (partition lmin l) (OrderedList lmin) 77 | (fn fst snd => 78 | let sorted1 = merge_sort lmin fst in 79 | let sorted2 = merge_sort lmin snd in 80 | merge lmin lmin sorted1 lmin sorted2);; 81 | -------------------------------------------------------------------------------- /tests/bad/mergesort.8.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let MININT = 0 - 32768;; 6 | let MAXINT = 32767;; 7 | 8 | datatype List (lo:Int) = 9 | Null 10 | | Cons of (h:Int) (t:(List lo));; 11 | 12 | datatype Pair (S:*) (T:*) = 13 | MkPair of (fst:S) (snd:T);; 14 | 15 | /* (OrderedList n) <: (OrderedList m) iff n >= m */ 16 | datatype OrderedList (lo:Int) = 17 | ONull 18 | | OCons of (h:Int.(lo <= h)) (t:(OrderedList h));; 19 | 20 | let l : (OrderedList 0) = OCons 0 0 (OCons 1 1 (ONull 2));; 21 | 22 | let exact (d:Int) : (e:Int.e=d) = d+0;; 23 | 24 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 25 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) 26 | then exact b 27 | else exact a;; 28 | 29 | let Above (x:Int):* = (y:Int.x<=y);; 30 | 31 | let rec merge (lo:Int) 32 | (lo1:Above lo) 33 | (l1:OrderedList lo1) 34 | (lo2:Above lo) 35 | (l2:OrderedList lo2) : 36 | (OrderedList lo) = 37 | caseOrderedList lo1 l1 (OrderedList lo) 38 | (fn u => l2) 39 | (fn h1 t1 => 40 | caseOrderedList lo2 l2 (OrderedList lo) 41 | (fn u => l1) 42 | (fn h2 t2 => 43 | if[OrderedList lo] h1 < h2 then 44 | (OCons lo h1 45 | (merge h1 h1 t1 h2 (OCons h2 h2 t2))) 46 | else 47 | (OCons lo h2 48 | (merge h2 h2 t2 h1 (OCons h1 h1 t1))) 49 | ) 50 | ) 51 | ;; 52 | 53 | let rec length (lo:Int) (l:(List lo)) : Int = 54 | caseList lo l Int 55 | (fn u => 0) 56 | (fn h t => 1 + (length h t));; /* BUG: wrong args */ 57 | 58 | let partition (lo:Int) (l:(List lo)) : (Pair (List lo) (List lo)) = 59 | let rec helper (firsthalf:(List lo)) (secondhalf:(List lo)) : 60 | (Pair (List lo) (List lo)) = 61 | caseList lo firsthalf (Pair (List lo) (List lo)) 62 | (fn u => (MkPair (List lo) (List lo) firsthalf secondhalf)) 63 | (fn h t => 64 | if[Pair (List lo) (List lo)] 65 | ((length lo t) >= ((length lo secondhalf) + 1)) 66 | then 67 | helper t (Cons lo h secondhalf) 68 | else 69 | MkPair (List lo) (List lo) firsthalf secondhalf) 70 | in 71 | helper l (Null lo) 72 | ;; 73 | 74 | 75 | let rec merge_sort (lmin:Int) (l:(List lmin)) : (OrderedList lmin) = 76 | casePair (List lmin) (List lmin) (partition lmin l) (OrderedList lmin) 77 | (fn fst snd => 78 | let sorted1 = merge_sort lmin fst in 79 | let sorted2 = merge_sort lmin snd in 80 | merge lmin lmin sorted1 lmin sorted2);; 81 | -------------------------------------------------------------------------------- /tests/bad/mergesort.9.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let MININT = 0 - 32768;; 6 | let MAXINT = 32767;; 7 | 8 | datatype List (lo:Int) = 9 | Null 10 | | Cons of (h:Int) (t:(List lo));; 11 | 12 | datatype Pair (S:*) (T:*) = 13 | MkPair of (fst:S) (snd:T);; 14 | 15 | /* (OrderedList n) <: (OrderedList m) iff n >= m */ 16 | datatype OrderedList (lo:Int) = 17 | ONull 18 | | OCons of (h:Int.(lo <= h)) (t:(OrderedList h));; 19 | 20 | let l : (OrderedList 0) = OCons 0 0 (OCons 1 1 (ONull 2));; 21 | 22 | let exact (d:Int) : (e:Int.e=d) = d+0;; 23 | 24 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 25 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) 26 | then exact b 27 | else exact a;; 28 | 29 | let Above (x:Int):* = (y:Int.x<=y);; 30 | 31 | let rec merge (lo:Int) 32 | (lo1:Above lo) 33 | (l1:OrderedList lo1) 34 | (lo2:Above lo) 35 | (l2:OrderedList lo2) : 36 | (OrderedList lo) = 37 | caseOrderedList lo1 l1 (OrderedList lo) 38 | (fn u => l2) 39 | (fn h1 t1 => 40 | caseOrderedList lo2 l2 (OrderedList lo) 41 | (fn u => l1) 42 | (fn h2 t2 => 43 | if[OrderedList lo] h1 < h2 then 44 | (OCons lo h1 45 | (merge h1 h1 t1 h2 (OCons lo h2 t2))) /* BUG: wrong arg */ 46 | else 47 | (OCons lo h2 48 | (merge h2 h2 t2 h1 (OCons h1 h1 t1))) 49 | ) 50 | ) 51 | ;; 52 | 53 | let rec length (lo:Int) (l:(List lo)) : Int = 54 | caseList lo l Int 55 | (fn u => 0) 56 | (fn h t => 1 + (length lo t));; 57 | 58 | let partition (lo:Int) (l:(List lo)) : (Pair (List lo) (List lo)) = 59 | let rec helper (firsthalf:(List lo)) (secondhalf:(List lo)) : 60 | (Pair (List lo) (List lo)) = 61 | caseList lo firsthalf (Pair (List lo) (List lo)) 62 | (fn u => (MkPair (List lo) (List lo) firsthalf secondhalf)) 63 | (fn h t => 64 | if[Pair (List lo) (List lo)] 65 | ((length lo t) >= ((length lo secondhalf) + 1)) 66 | then 67 | helper t (Cons lo h secondhalf) 68 | else 69 | MkPair (List lo) (List lo) firsthalf secondhalf) 70 | in 71 | helper l (Null lo) 72 | ;; 73 | 74 | 75 | let rec merge_sort (lmin:Int) (l:(List lmin)) : (OrderedList lmin) = 76 | casePair (List lmin) (List lmin) (partition lmin l) (OrderedList lmin) 77 | (fn fst snd => 78 | let sorted1 = merge_sort lmin fst in 79 | let sorted2 = merge_sort lmin snd in 80 | merge lmin lmin sorted1 lmin sorted2);; 81 | -------------------------------------------------------------------------------- /tests/bad/mergesort.f: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let MININT = 0 - 32768;; 6 | let MAXINT = 32767;; 7 | 8 | datatype List (lo:Int) = 9 | Null 10 | | Cons of (h:Int) (t:(List lo));; 11 | 12 | datatype Pair (S:*) (T:*) = 13 | MkPair of (fst:S) (snd:T);; 14 | 15 | /* (OrderedList n) <: (OrderedList m) iff n >= m */ 16 | datatype OrderedList (lo:Int) = 17 | ONull 18 | | OCons of (h:Int.(lo <= h)) (t:(OrderedList h));; 19 | 20 | let l : (OrderedList 0) = OCons 0 0 (OCons 1 1 (ONull 2));; 21 | 22 | let exact (d:Int) : (e:Int.e=d) = d+0;; 23 | 24 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 25 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) 26 | then exact b 27 | else exact a;; 28 | 29 | let Above (x:Int):* = (y:Int.x<=y);; 30 | 31 | let rec merge (lo:Int) 32 | (lo1:Above lo) 33 | (l1:OrderedList lo1) 34 | (lo2:Above lo) 35 | (l2:OrderedList lo2) : 36 | (OrderedList lo) = 37 | caseOrderedList lo1 l1 (OrderedList lo) 38 | (fn u => l2) 39 | (fn h1 t1 => 40 | caseOrderedList lo2 l2 (OrderedList lo) 41 | (fn u => l1) 42 | (fn h2 t2 => 43 | if[OrderedList lo] h1 < h2 then 44 | (OCons lo h1 45 | (merge h1 h1 t1 h2 (OCons h2 h2 t2))) 46 | else 47 | (OCons lo h2 48 | (merge h2 h2 t2 h1 (OCons h1 h1 t1))) 49 | ) 50 | ) 51 | ;; 52 | 53 | let rec length (lo:Int) (l:(List lo)) : Int = 54 | caseList lo l Int 55 | (fn u => 0) 56 | (fn h t => 1 + (length lo t));; 57 | 58 | let partition (lo:Int) (l:(List lo)) : (Pair (List lo) (List lo)) = 59 | let rec helper (firsthalf:(List lo)) (secondhalf:(List lo)) : 60 | (Pair (List lo) (List lo)) = 61 | caseList lo firsthalf (Pair (List lo) (List lo)) 62 | (fn u => (MkPair (List lo) (List lo) firsthalf secondhalf)) 63 | (fn h t => 64 | if[Pair (List lo) (List lo)] 65 | ((length lo t) >= ((length lo secondhalf) + 1)) 66 | then 67 | helper t (Cons lo h secondhalf) 68 | else 69 | MkPair (List lo) (List lo) firsthalf secondhalf) 70 | in 71 | helper l (Null lo) 72 | ;; 73 | 74 | 75 | let rec merge_sort (lmin:Int) (l:(List lmin)) : (OrderedList lmin) = 76 | casePair (List lmin) (List lmin) (partition lmin l) (OrderedList lmin) 77 | (fn fst snd => 78 | let sorted1 = merge_sort lmin fst in 79 | let sorted2 = merge_sort lmin snd in 80 | merge lmin lmin sorted1 lmin sorted2);; 81 | -------------------------------------------------------------------------------- /tests/bad/quicksort.1.f: -------------------------------------------------------------------------------- 1 | datatype Pair (X:*) (Y:*) = 2 | Pcons of (x:X) (y:Y);; 3 | 4 | let LTInt (hi:Int) :* = (x:Int. (x < hi));; /* BUG: wrong operator */ 5 | 6 | let RInt (hi:Int) (lo:(LTInt hi)):* = (x:Int. (and (lo<=x) (x l2) 24 | (fn x y => SCons ub lb x (sortAppend ub mid x y l2));; 25 | 26 | let rec partition (ub:Int) (lb:(LTInt ub)) (pivot:(RInt ub lb)) 27 | (l:(RangeList ub lb)) (l1:(RangeList pivot (lb+0))) 28 | (l2:(RangeList ub pivot)): 29 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) = 30 | caseRangeList ub lb l 31 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) 32 | (fn u => (Pcons (RangeList pivot (lb+0)) (RangeList ub pivot) l1 l2)) 33 | (fn x y => 34 | if [(Pair (RangeList pivot (lb+0)) (RangeList ub pivot))] x >= pivot 35 | then (partition ub lb pivot y l1 (RCons ub pivot (x+0) l2)) 36 | else (partition ub lb pivot y (RCons pivot (lb+0) (x+0) l1) l2));; 37 | 38 | let rec quicksort (ub:Int) (lb:(LTInt ub)) (l:(RangeList ub lb)): 39 | (SortedList ub lb) = 40 | caseRangeList ub lb l (SortedList ub lb) 41 | (fn u1 => (SNull ub lb unit)) 42 | (fn x1 y1 => 43 | (caseRangeList ub lb y1 (SortedList ub lb) 44 | (fn u2 => (SCons ub lb x1 (SNull ub x1 unit))) 45 | (fn x2 y2 => 46 | (let pivot = x1 in 47 | (let pairLists = 48 | (partition ub lb pivot y1 49 | (RNull pivot (lb+0) unit) (RNull ub pivot unit)) in 50 | (casePair (RangeList pivot (lb+0)) (RangeList ub pivot) 51 | pairLists (SortedList ub lb) 52 | (fn x y => (sortAppend ub pivot (lb+0) 53 | (quicksort pivot (lb+0) x) 54 | (SCons ub pivot (pivot+0) (quicksort ub pivot y)))) 55 | ))))));; 56 | 57 | -------------------------------------------------------------------------------- /tests/bad/quicksort.10.f: -------------------------------------------------------------------------------- 1 | datatype Pair (X:*) (Y:*) = 2 | Pcons of (x:X) (y:Y);; 3 | 4 | let LTInt (hi:Int) :* = (x:Int. (x <= hi));; 5 | 6 | let RInt (hi:Int) (lo:(LTInt hi)):* = (x:Int. (and (lo<=x) (x l2) 24 | /* BUG: replaced x by y */ 25 | (fn x y => SCons ub lb y (sortAppend ub mid x y l2));; 26 | 27 | let rec partition (ub:Int) (lb:(LTInt ub)) (pivot:(RInt ub lb)) 28 | (l:(RangeList ub lb)) (l1:(RangeList pivot (lb+0))) 29 | (l2:(RangeList ub pivot)): 30 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) = 31 | caseRangeList ub lb l 32 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) 33 | (fn u => (Pcons (RangeList pivot (lb+0)) (RangeList ub pivot) l1 l2)) 34 | (fn x y => 35 | if [(Pair (RangeList pivot (lb+0)) (RangeList ub pivot))] x >= pivot 36 | then (partition ub lb pivot y l1 (RCons ub pivot (x+0) l2)) 37 | else (partition ub lb pivot y (RCons pivot (lb+0) (x+0) l1) l2));; 38 | 39 | let rec quicksort (ub:Int) (lb:(LTInt ub)) (l:(RangeList ub lb)): 40 | (SortedList ub lb) = 41 | caseRangeList ub lb l (SortedList ub lb) 42 | (fn u1 => (SNull ub lb unit)) 43 | (fn x1 y1 => 44 | (caseRangeList ub lb y1 (SortedList ub lb) 45 | (fn u2 => (SCons ub lb x1 (SNull ub x1 unit))) 46 | (fn x2 y2 => 47 | (let pivot = x1 in 48 | (let pairLists = 49 | (partition ub lb pivot y1 50 | (RNull pivot (lb+0) unit) (RNull ub pivot unit)) in 51 | (casePair (RangeList pivot (lb+0)) (RangeList ub pivot) 52 | pairLists (SortedList ub lb) 53 | (fn x y => (sortAppend ub pivot (lb+0) 54 | (quicksort pivot (lb+0) x) 55 | (SCons ub pivot (pivot+0) (quicksort ub pivot y)))) 56 | ))))));; 57 | 58 | -------------------------------------------------------------------------------- /tests/bad/quicksort.2.f: -------------------------------------------------------------------------------- 1 | datatype Pair (X:*) (Y:*) = 2 | Pcons of (x:X) (y:Y);; 3 | 4 | let LTInt (hi:Int) :* = (x:Int. (x <= hi));; 5 | 6 | let RInt (hi:Int) (lo:(LTInt hi)):* = (x:Int. (and (lo<=x) (x l2) 24 | /* BUG: flipped ub and lb */ 25 | (fn x y => SCons lb ub x (sortAppend ub mid x y l2));; 26 | 27 | let rec partition (ub:Int) (lb:(LTInt ub)) (pivot:(RInt ub lb)) 28 | (l:(RangeList ub lb)) (l1:(RangeList pivot (lb+0))) 29 | (l2:(RangeList ub pivot)): 30 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) = 31 | caseRangeList ub lb l 32 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) 33 | (fn u => (Pcons (RangeList pivot (lb+0)) (RangeList ub pivot) l1 l2)) 34 | (fn x y => 35 | if [(Pair (RangeList pivot (lb+0)) (RangeList ub pivot))] x >= pivot 36 | then (partition ub lb pivot y l1 (RCons ub pivot (x+0) l2)) 37 | else (partition ub lb pivot y (RCons pivot (lb+0) (x+0) l1) l2));; 38 | 39 | let rec quicksort (ub:Int) (lb:(LTInt ub)) (l:(RangeList ub lb)): 40 | (SortedList ub lb) = 41 | caseRangeList ub lb l (SortedList ub lb) 42 | (fn u1 => (SNull ub lb unit)) 43 | (fn x1 y1 => 44 | (caseRangeList ub lb y1 (SortedList ub lb) 45 | (fn u2 => (SCons ub lb x1 (SNull ub x1 unit))) 46 | (fn x2 y2 => 47 | (let pivot = x1 in 48 | (let pairLists = 49 | (partition ub lb pivot y1 50 | (RNull pivot (lb+0) unit) (RNull ub pivot unit)) in 51 | (casePair (RangeList pivot (lb+0)) (RangeList ub pivot) 52 | pairLists (SortedList ub lb) 53 | (fn x y => (sortAppend ub pivot (lb+0) 54 | (quicksort pivot (lb+0) x) 55 | (SCons ub pivot (pivot+0) (quicksort ub pivot y)))) 56 | ))))));; 57 | 58 | -------------------------------------------------------------------------------- /tests/bad/quicksort.3.f: -------------------------------------------------------------------------------- 1 | datatype Pair (X:*) (Y:*) = 2 | Pcons of (x:X) (y:Y);; 3 | 4 | let LTInt (hi:Int) :* = (x:Int. (x <= hi));; 5 | 6 | let RInt (hi:Int) (lo:(LTInt hi)):* = (x:Int. (and (lo<=x) (x l2) 24 | (fn x y => SCons ub lb x (sortAppend ub mid x y l2));; 25 | 26 | let rec partition (ub:Int) (lb:(LTInt ub)) (pivot:(RInt ub lb)) 27 | (l:(RangeList ub lb)) (l1:(RangeList pivot (lb+0))) 28 | (l2:(RangeList ub pivot)): 29 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) = 30 | caseRangeList ub lb l 31 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) 32 | (fn u => (Pcons (RangeList pivot (lb+0)) (RangeList ub pivot) l1 l2)) 33 | (fn x y => 34 | /* BUG: wrong operator */ 35 | if [(Pair (RangeList pivot (lb+0)) (RangeList ub pivot))] x > pivot 36 | then (partition ub lb pivot y l1 (RCons ub pivot (x+0) l2)) 37 | else (partition ub lb pivot y (RCons pivot (lb+0) (x+0) l1) l2));; 38 | 39 | let rec quicksort (ub:Int) (lb:(LTInt ub)) (l:(RangeList ub lb)): 40 | (SortedList ub lb) = 41 | caseRangeList ub lb l (SortedList ub lb) 42 | (fn u1 => (SNull ub lb unit)) 43 | (fn x1 y1 => 44 | (caseRangeList ub lb y1 (SortedList ub lb) 45 | (fn u2 => (SCons ub lb x1 (SNull ub x1 unit))) 46 | (fn x2 y2 => 47 | (let pivot = x1 in 48 | (let pairLists = 49 | (partition ub lb pivot y1 50 | (RNull pivot (lb+0) unit) (RNull ub pivot unit)) in 51 | (casePair (RangeList pivot (lb+0)) (RangeList ub pivot) 52 | pairLists (SortedList ub lb) 53 | (fn x y => (sortAppend ub pivot (lb+0) 54 | (quicksort pivot (lb+0) x) 55 | (SCons ub pivot (pivot+0) (quicksort ub pivot y)))) 56 | ))))));; 57 | 58 | -------------------------------------------------------------------------------- /tests/bad/quicksort.4.f: -------------------------------------------------------------------------------- 1 | datatype Pair (X:*) (Y:*) = 2 | Pcons of (x:X) (y:Y);; 3 | 4 | let LTInt (hi:Int) :* = (x:Int. (x <= hi));; 5 | 6 | /* BUG: <= changed to < */ 7 | let RInt (hi:Int) (lo:(LTInt hi)):* = (x:Int. (and (lo l2) 25 | (fn x y => SCons ub lb x (sortAppend ub mid x y l2));; 26 | 27 | let rec partition (ub:Int) (lb:(LTInt ub)) (pivot:(RInt ub lb)) 28 | (l:(RangeList ub lb)) (l1:(RangeList pivot (lb+0))) 29 | (l2:(RangeList ub pivot)): 30 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) = 31 | caseRangeList ub lb l 32 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) 33 | (fn u => (Pcons (RangeList pivot (lb+0)) (RangeList ub pivot) l1 l2)) 34 | (fn x y => 35 | if [(Pair (RangeList pivot (lb+0)) (RangeList ub pivot))] x >= pivot 36 | then (partition ub lb pivot y l1 (RCons ub pivot (x+0) l2)) 37 | else (partition ub lb pivot y (RCons pivot (lb+0) (x+0) l1) l2));; 38 | 39 | let rec quicksort (ub:Int) (lb:(LTInt ub)) (l:(RangeList ub lb)): 40 | (SortedList ub lb) = 41 | caseRangeList ub lb l (SortedList ub lb) 42 | (fn u1 => (SNull ub lb unit)) 43 | (fn x1 y1 => 44 | (caseRangeList ub lb y1 (SortedList ub lb) 45 | (fn u2 => (SCons ub lb x1 (SNull ub x1 unit))) 46 | (fn x2 y2 => 47 | (let pivot = x1 in 48 | (let pairLists = 49 | (partition ub lb pivot y1 50 | (RNull pivot (lb+0) unit) (RNull ub pivot unit)) in 51 | (casePair (RangeList pivot (lb+0)) (RangeList ub pivot) 52 | pairLists (SortedList ub lb) 53 | (fn x y => (sortAppend ub pivot (lb+0) 54 | (quicksort pivot (lb+0) x) 55 | (SCons ub pivot (pivot+0) (quicksort ub pivot y)))) 56 | ))))));; 57 | 58 | -------------------------------------------------------------------------------- /tests/bad/quicksort.5.f: -------------------------------------------------------------------------------- 1 | datatype Pair (X:*) (Y:*) = 2 | Pcons of (x:X) (y:Y);; 3 | 4 | let LTInt (hi:Int) :* = (x:Int. (x <= hi));; 5 | 6 | let RInt (hi:Int) (lo:(LTInt hi)):* = (x:Int. (and (lo<=x) (x l2) 25 | (fn x y => SCons ub lb x (sortAppend ub mid x y l2));; 26 | 27 | let rec partition (ub:Int) (lb:(LTInt ub)) (pivot:(RInt ub lb)) 28 | (l:(RangeList ub lb)) (l1:(RangeList pivot (lb+0))) 29 | (l2:(RangeList ub pivot)): 30 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) = 31 | caseRangeList ub lb l 32 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) 33 | (fn u => (Pcons (RangeList pivot (lb+0)) (RangeList ub pivot) l1 l2)) 34 | (fn x y => 35 | if [(Pair (RangeList pivot (lb+0)) (RangeList ub pivot))] x >= pivot 36 | then (partition ub lb pivot y l1 (RCons ub pivot (x+0) l2)) 37 | else (partition ub lb pivot y (RCons pivot (lb+0) (x+0) l1) l2));; 38 | 39 | let rec quicksort (ub:Int) (lb:(LTInt ub)) (l:(RangeList ub lb)): 40 | (SortedList ub lb) = 41 | caseRangeList ub lb l (SortedList ub lb) 42 | (fn u1 => (SNull ub lb unit)) 43 | (fn x1 y1 => 44 | (caseRangeList ub lb y1 (SortedList ub lb) 45 | (fn u2 => (SCons ub lb x1 (SNull ub x1 unit))) 46 | (fn x2 y2 => 47 | (let pivot = x1 in 48 | (let pairLists = 49 | (partition ub lb pivot y1 50 | (RNull pivot (lb+0) unit) (RNull ub pivot unit)) in 51 | (casePair (RangeList pivot (lb+0)) (RangeList ub pivot) 52 | pairLists (SortedList ub lb) 53 | (fn x y => (sortAppend ub pivot (lb+0) 54 | (quicksort pivot (lb+0) x) 55 | (SCons ub pivot (pivot+0) (quicksort ub pivot y)))) 56 | ))))));; 57 | 58 | -------------------------------------------------------------------------------- /tests/bad/quicksort.6.f: -------------------------------------------------------------------------------- 1 | datatype Pair (X:*) (Y:*) = 2 | Pcons of (x:X) (y:Y);; 3 | 4 | let LTInt (hi:Int) :* = (x:Int. (x <= hi));; 5 | 6 | let RInt (hi:Int) (lo:(LTInt hi)):* = (x:Int. (and (lo<=x) (x l2) 24 | /* BUG: switched ub and mid */ 25 | (fn x y => SCons ub lb x (sortAppend mid ub x y l2));; 26 | 27 | let rec partition (ub:Int) (lb:(LTInt ub)) (pivot:(RInt ub lb)) 28 | (l:(RangeList ub lb)) (l1:(RangeList pivot (lb+0))) 29 | (l2:(RangeList ub pivot)): 30 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) = 31 | caseRangeList ub lb l 32 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) 33 | (fn u => (Pcons (RangeList pivot (lb+0)) (RangeList ub pivot) l1 l2)) 34 | (fn x y => 35 | if [(Pair (RangeList pivot (lb+0)) (RangeList ub pivot))] x >= pivot 36 | then (partition ub lb pivot y l1 (RCons ub pivot (x+0) l2)) 37 | else (partition ub lb pivot y (RCons pivot (lb+0) (x+0) l1) l2));; 38 | 39 | let rec quicksort (ub:Int) (lb:(LTInt ub)) (l:(RangeList ub lb)): 40 | (SortedList ub lb) = 41 | caseRangeList ub lb l (SortedList ub lb) 42 | (fn u1 => (SNull ub lb unit)) 43 | (fn x1 y1 => 44 | (caseRangeList ub lb y1 (SortedList ub lb) 45 | (fn u2 => (SCons ub lb x1 (SNull ub x1 unit))) 46 | (fn x2 y2 => 47 | (let pivot = x1 in 48 | (let pairLists = 49 | (partition ub lb pivot y1 50 | (RNull pivot (lb+0) unit) (RNull ub pivot unit)) in 51 | (casePair (RangeList pivot (lb+0)) (RangeList ub pivot) 52 | pairLists (SortedList ub lb) 53 | (fn x y => (sortAppend ub pivot (lb+0) 54 | (quicksort pivot (lb+0) x) 55 | (SCons ub pivot (pivot+0) (quicksort ub pivot y)))) 56 | ))))));; 57 | 58 | -------------------------------------------------------------------------------- /tests/bad/quicksort.7.f: -------------------------------------------------------------------------------- 1 | datatype Pair (X:*) (Y:*) = 2 | Pcons of (x:X) (y:Y);; 3 | 4 | let LTInt (hi:Int) :* = (x:Int. (x <= hi));; 5 | 6 | let RInt (hi:Int) (lo:(LTInt hi)):* = (x:Int. (and (lo<=x) (x l2) 24 | (fn x y => SCons ub lb x (sortAppend ub mid x y l2));; 25 | 26 | let rec partition (ub:Int) (lb:(LTInt ub)) (pivot:(RInt ub lb)) 27 | (l:(RangeList ub lb)) (l1:(RangeList pivot (lb+0))) 28 | (l2:(RangeList ub pivot)): 29 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) = 30 | caseRangeList ub lb l 31 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) 32 | (fn u => (Pcons (RangeList pivot (lb+0)) (RangeList ub pivot) l1 l2)) 33 | (fn x y => 34 | if [(Pair (RangeList pivot (lb+0)) (RangeList ub pivot))] x >= pivot 35 | then (partition ub lb pivot y l1 (RCons ub pivot (x+0) l2)) 36 | else (partition ub lb pivot y (RCons pivot (lb+0) (x+0) l1) l2));; 37 | 38 | let rec quicksort (ub:Int) (lb:(LTInt ub)) (l:(RangeList ub lb)): 39 | (SortedList ub lb) = 40 | caseRangeList ub lb l (SortedList ub lb) 41 | (fn u1 => (SNull ub lb unit)) 42 | (fn x1 y1 => 43 | (caseRangeList ub lb y1 (SortedList ub lb) 44 | (fn u2 => (SCons ub lb x1 (SNull ub x1 unit))) 45 | (fn x2 y2 => 46 | (let pivot = x1 in 47 | (let pairLists = 48 | (partition ub lb pivot y1 49 | (RNull pivot (lb+0) unit) (RNull ub pivot unit)) in 50 | (casePair (RangeList pivot (lb+0)) (RangeList ub pivot) 51 | pairLists (SortedList ub lb) 52 | (fn x y => (sortAppend ub pivot (lb+0) 53 | /* BUG: switched lb and pivot */ 54 | (quicksort (lb+0) pivot x) 55 | (SCons ub pivot (pivot+0) (quicksort ub pivot y)))) 56 | ))))));; 57 | 58 | -------------------------------------------------------------------------------- /tests/bad/quicksort.8.f: -------------------------------------------------------------------------------- 1 | datatype Pair (X:*) (Y:*) = 2 | Pcons of (x:X) (y:Y);; 3 | 4 | let LTInt (hi:Int) :* = (x:Int. (x <= hi));; 5 | 6 | let RInt (hi:Int) (lo:(LTInt hi)):* = (x:Int. (and (lo<=x) (x l2) 24 | (fn x y => SCons ub lb x (sortAppend ub mid x y l2));; 25 | 26 | let rec partition (ub:Int) (lb:(LTInt ub)) (pivot:(RInt ub lb)) 27 | (l:(RangeList ub lb)) (l1:(RangeList pivot (lb+0))) 28 | (l2:(RangeList ub pivot)): 29 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) = 30 | caseRangeList ub lb l 31 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) 32 | (fn u => (Pcons (RangeList pivot (lb+0)) (RangeList ub pivot) l1 l2)) 33 | (fn x y => 34 | if [(Pair (RangeList pivot (lb+0)) (RangeList ub pivot))] x >= pivot 35 | then (partition ub lb pivot y l1 (RCons ub pivot (x+0) l2)) 36 | else (partition ub lb pivot y (RCons pivot (lb+0) (x+0) l1) l2));; 37 | 38 | let rec quicksort (ub:Int) (lb:(LTInt ub)) (l:(RangeList ub lb)): 39 | (SortedList ub lb) = 40 | caseRangeList ub lb l (SortedList ub lb) 41 | (fn u1 => (SNull ub lb unit)) 42 | (fn x1 y1 => 43 | (caseRangeList ub lb y1 (SortedList ub lb) 44 | (fn u2 => (SCons ub lb x1 (SNull ub x1 unit))) 45 | (fn x2 y2 => 46 | (let pivot = x1 in 47 | (let pairLists = 48 | (partition ub lb pivot y1 49 | (RNull pivot (lb+0) unit) (RNull ub pivot unit)) in 50 | (casePair (RangeList pivot (lb+0)) (RangeList ub pivot) 51 | pairLists (SortedList ub lb) 52 | (fn x y => (sortAppend ub pivot (lb+0) 53 | (quicksort pivot (lb+0) x) 54 | /* BUG: replaced ub by lb */ 55 | (SCons lb pivot (pivot+0) (quicksort ub pivot y)))) 56 | ))))));; 57 | 58 | -------------------------------------------------------------------------------- /tests/bad/quicksort.9.f: -------------------------------------------------------------------------------- 1 | datatype Pair (X:*) (Y:*) = 2 | Pcons of (x:X) (y:Y);; 3 | 4 | let LTInt (hi:Int) :* = (x:Int. (x <= hi));; 5 | 6 | let RInt (hi:Int) (lo:(LTInt hi)):* = (x:Int. (and (lo<=x) (x l2) 24 | (fn x y => SCons ub lb x (sortAppend ub mid x y l2));; 25 | 26 | let rec partition (ub:Int) (lb:(LTInt ub)) (pivot:(RInt ub lb)) 27 | (l:(RangeList ub lb)) (l1:(RangeList pivot (lb+0))) 28 | (l2:(RangeList ub pivot)): 29 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) = 30 | caseRangeList ub lb l 31 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) 32 | /* BUG: swapped l2 and l1 */ 33 | (fn u => (Pcons (RangeList pivot (lb+0)) (RangeList ub pivot) l2 l1)) 34 | (fn x y => 35 | if [(Pair (RangeList pivot (lb+0)) (RangeList ub pivot))] x >= pivot 36 | then (partition ub lb pivot y l1 (RCons ub pivot (x+0) l2)) 37 | else (partition ub lb pivot y (RCons pivot (lb+0) (x+0) l1) l2));; 38 | 39 | let rec quicksort (ub:Int) (lb:(LTInt ub)) (l:(RangeList ub lb)): 40 | (SortedList ub lb) = 41 | caseRangeList ub lb l (SortedList ub lb) 42 | (fn u1 => (SNull ub lb unit)) 43 | (fn x1 y1 => 44 | (caseRangeList ub lb y1 (SortedList ub lb) 45 | (fn u2 => (SCons ub lb x1 (SNull ub x1 unit))) 46 | (fn x2 y2 => 47 | (let pivot = x1 in 48 | (let pairLists = 49 | (partition ub lb pivot y1 50 | (RNull pivot (lb+0) unit) (RNull ub pivot unit)) in 51 | (casePair (RangeList pivot (lb+0)) (RangeList ub pivot) 52 | pairLists (SortedList ub lb) 53 | (fn x y => (sortAppend ub pivot (lb+0) 54 | (quicksort pivot (lb+0) x) 55 | (SCons ub pivot (pivot+0) (quicksort ub pivot y)))) 56 | ))))));; 57 | 58 | -------------------------------------------------------------------------------- /tests/bad/quicksort.f: -------------------------------------------------------------------------------- 1 | datatype Pair (X:*) (Y:*) = 2 | Pcons of (x:X) (y:Y);; 3 | 4 | let LTInt (hi:Int) :* = (x:Int. (x <= hi));; 5 | 6 | let RInt (hi:Int) (lo:(LTInt hi)):* = (x:Int. (and (lo<=x) (x l2) 24 | (fn x y => SCons ub lb x (sortAppend ub mid x y l2));; 25 | 26 | let rec partition (ub:Int) (lb:(LTInt ub)) (pivot:(RInt ub lb)) 27 | (l:(RangeList ub lb)) (l1:(RangeList pivot (lb+0))) 28 | (l2:(RangeList ub pivot)): 29 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) = 30 | caseRangeList ub lb l 31 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) 32 | (fn u => (Pcons (RangeList pivot (lb+0)) (RangeList ub pivot) l1 l2)) 33 | (fn x y => 34 | if [(Pair (RangeList pivot (lb+0)) (RangeList ub pivot))] x >= pivot 35 | then (partition ub lb pivot y l1 (RCons ub pivot (x+0) l2)) 36 | else (partition ub lb pivot y (RCons pivot (lb+0) (x+0) l1) l2));; 37 | 38 | let rec quicksort (ub:Int) (lb:(LTInt ub)) (l:(RangeList ub lb)): 39 | (SortedList ub lb) = 40 | caseRangeList ub lb l (SortedList ub lb) 41 | (fn u1 => (SNull ub lb unit)) 42 | (fn x1 y1 => 43 | (caseRangeList ub lb y1 (SortedList ub lb) 44 | (fn u2 => (SCons ub lb x1 (SNull ub x1 unit))) 45 | (fn x2 y2 => 46 | (let pivot = x1 in 47 | (let pairLists = 48 | (partition ub lb pivot y1 49 | (RNull pivot (lb+0) unit) (RNull ub pivot unit)) in 50 | (casePair (RangeList pivot (lb+0)) (RangeList ub pivot) 51 | pairLists (SortedList ub lb) 52 | (fn x y => (sortAppend ub pivot (lb+0) 53 | (quicksort pivot (lb+0) x) 54 | (SCons ub pivot (pivot+0) (quicksort ub pivot y)))) 55 | ))))));; 56 | 57 | -------------------------------------------------------------------------------- /tests/bad/regexp.1.f: -------------------------------------------------------------------------------- 1 | let Char :* = Int;; /* unicode */ 2 | 3 | datatype String = 4 | Null of (u:Unit) 5 | | Cons of (x:Char) (r:String) 6 | ;; 7 | 8 | datatype Regexp = 9 | AnyChar of (u:Unit) 10 | | Alphanum of (u:Unit) 11 | | Kleene of (r:Regexp) 12 | | Concat of (x:Regexp) (y:Regexp) 13 | | Or of (x:Regexp) (y:Regexp) 14 | | Empty of (u:Unit) 15 | ;; 16 | 17 | let isAlphaNum (c:Char) = (and (65 <= c) (c <= 92));; 18 | 19 | let rec isEmpty (x:Regexp) : Bool = 20 | caseRegexp x Bool 21 | /* AnyChar */ (fn u => false) 22 | /* Alphanum */ (fn u => false) 23 | /* Kleene */ (fn r => false) 24 | /* Concat */ (fn x y => false) 25 | /* Or */ (fn x y => false) 26 | /* Empty */ (fn u => true) 27 | ;; 28 | 29 | let rec match_regexp (x:Regexp) (k:Regexp) (s:String) : Bool = 30 | (caseRegexp x Bool 31 | /* AnyChar */ 32 | (fn u => 33 | caseString s Bool 34 | /* Null */ 35 | (fn u => false) 36 | (fn a d => match_regexp (Empty unit) d k)) /* BUG: swap d and k */ 37 | /* Alphanum */ 38 | (fn u => 39 | caseString s Bool 40 | /* Null */ 41 | (fn u => false) 42 | (fn a d => 43 | if[Bool] (isAlphaNum a) 44 | then match_regexp (Empty unit) k d 45 | else false)) 46 | /* Kleene */ 47 | (fn r => match_regexp (Or (Empty unit) (Concat r (Kleene r))) k s) 48 | /* Concat */ 49 | (fn x y => match_regexp x (Concat y k) s) 50 | /* Or */ 51 | (fn x y => 52 | if[Bool] (match_regexp x k s) 53 | then true 54 | else match_regexp y k s) 55 | /* Empty */ 56 | (fn u => 57 | if[Bool] (isEmpty k) 58 | then (caseString s Bool 59 | (fn u => true) 60 | (fn a d => false)) 61 | else match_regexp k (Empty unit) s));; 62 | 63 | let readString (u:Unit) : String = Cons 4 (Null unit);; /* not alphanum */ 64 | 65 | let executeSQLquery(query:String) : Int = /* ... */ 0;; 66 | 67 | /********** Client Code **********************/ 68 | 69 | let valid_name_regexp = Kleene (Alphanum unit);; 70 | let isValidName (s:String) : Bool = 71 | match_regexp valid_name_regexp (Empty unit) s;; 72 | let Name = (x:String.isValidName x);; 73 | 74 | 75 | /* Following specification foils attacks such as: 76 | Attacks: 77 | user gives pwd: foo or true 78 | user gives name: admin -- (-- starts comment) 79 | */ 80 | 81 | let authenticate(username:Name) (password:Name) : Bool = 82 | let query = Null unit in 83 | /* "SELECT count(*) FROM client WHERE name ="^username^" and pwd="^password */ 84 | executeSQLquery(query) >0 85 | ;; 86 | 87 | 88 | /* 89 | let fixed_authenticate (username:String) (password:String) = 90 | if[Bool] (and (isValidName username) (isValidName password)) 91 | then authenticate username password 92 | else false 93 | ;; 94 | */ 95 | 96 | let fixed_authenticate (username:String) (password:String) = 97 | if[Bool] (isValidName username) 98 | then 99 | (if[Bool] (isValidName password) 100 | then authenticate username password 101 | else false) 102 | else false 103 | ;; 104 | 105 | let username = readString unit in 106 | let password = readString unit in 107 | fixed_authenticate username password;; 108 | 109 | 110 | 111 | /* 112 | authenticate (readString unit) (readString unit);; 113 | */ 114 | -------------------------------------------------------------------------------- /tests/bad/regexp.10.f: -------------------------------------------------------------------------------- 1 | let Char :* = Int;; /* unicode */ 2 | 3 | datatype String = 4 | Null of (u:Unit) 5 | | Cons of (x:Char) (r:String) 6 | ;; 7 | 8 | datatype Regexp = 9 | AnyChar of (u:Unit) 10 | | Alphanum of (u:Unit) 11 | | Kleene of (r:Regexp) 12 | | Concat of (x:Regexp) (y:Regexp) 13 | | Or of (x:Regexp) (y:Regexp) 14 | | Empty of (u:Unit) 15 | ;; 16 | 17 | let isAlphaNum (c:Char) = (and (65 <= c) (c <= 92));; 18 | 19 | let rec isEmpty (x:Regexp) : Bool = 20 | caseRegexp x Bool 21 | /* AnyChar */ (fn u => false) 22 | /* Alphanum */ (fn u => false) 23 | /* Kleene */ (fn r => false) 24 | /* Concat */ (fn x y => false) 25 | /* Or */ (fn x y => false) 26 | /* Empty */ (fn u => true) 27 | ;; 28 | 29 | let rec match_regexp (x:Regexp) (k:Regexp) (s:String) : Bool = 30 | (caseRegexp x Bool 31 | /* AnyChar */ 32 | (fn u => 33 | caseString s Bool 34 | /* Null */ 35 | (fn u => false) 36 | (fn a d => match_regexp (Empty unit) k d)) 37 | /* Alphanum */ 38 | (fn u => 39 | caseString s Bool 40 | /* Null */ 41 | (fn u => false) 42 | (fn a d => 43 | if[Bool] (isAlphaNum a) 44 | then match_regexp (Empty unit) k d 45 | else false)) 46 | /* Kleene */ 47 | (fn r => match_regexp (Or (Empty unit) (Concat r (Kleene r))) k s) 48 | /* Concat */ 49 | (fn x y => match_regexp x (Concat y k) s) 50 | /* Or */ 51 | (fn x y => 52 | if[Bool] (match_regexp x k s) 53 | then true 54 | else match_regexp s y k) /* BUG: s from last arg to first */ 55 | /* Empty */ 56 | (fn u => 57 | if[Bool] (isEmpty k) 58 | then (caseString s Bool 59 | (fn u => true) 60 | (fn a d => false)) 61 | else match_regexp k (Empty unit) s));; 62 | 63 | let readString (u:Unit) : String = Cons 4 (Null unit);; /* not alphanum */ 64 | 65 | let executeSQLquery(query:String) : Int = /* ... */ 0;; 66 | 67 | /********** Client Code **********************/ 68 | 69 | let valid_name_regexp = Kleene (Alphanum unit);; 70 | let isValidName (s:String) : Bool = 71 | match_regexp valid_name_regexp (Empty unit) s;; 72 | let Name = (x:String.isValidName x);; 73 | 74 | 75 | /* Following specification foils attacks such as: 76 | Attacks: 77 | user gives pwd: foo or true 78 | user gives name: admin -- (-- starts comment) 79 | */ 80 | 81 | let authenticate(username:Name) (password:Name) : Bool = 82 | let query = Null unit in 83 | /* "SELECT count(*) FROM client WHERE name ="^username^" and pwd="^password */ 84 | executeSQLquery(query) >0 85 | ;; 86 | 87 | 88 | /* 89 | let fixed_authenticate (username:String) (password:String) = 90 | if[Bool] (and (isValidName username) (isValidName password)) 91 | then authenticate username password 92 | else false 93 | ;; 94 | */ 95 | 96 | let fixed_authenticate (username:String) (password:String) = 97 | if[Bool] (isValidName username) 98 | then 99 | (if[Bool] (isValidName password) 100 | then authenticate username password 101 | else false) 102 | else false 103 | ;; 104 | 105 | let username = readString unit in 106 | let password = readString unit in 107 | fixed_authenticate username password;; 108 | 109 | 110 | 111 | /* 112 | authenticate (readString unit) (readString unit);; 113 | */ 114 | -------------------------------------------------------------------------------- /tests/bad/regexp.2.f: -------------------------------------------------------------------------------- 1 | let Char :* = Int;; /* unicode */ 2 | 3 | datatype String = 4 | Null of (u:Unit) 5 | | Cons of (x:Char) (r:String) 6 | ;; 7 | 8 | datatype Regexp = 9 | AnyChar of (u:Unit) 10 | | Alphanum of (u:Unit) 11 | | Kleene of (r:Regexp) 12 | | Concat of (x:Regexp) (y:Regexp) 13 | | Or of (x:Regexp) (y:Regexp) 14 | | Empty of (u:Unit) 15 | ;; 16 | 17 | let isAlphaNum (c:Char) = (and (65 <= c) (c <= 92));; 18 | 19 | let rec isEmpty (x:Regexp) : Bool = 20 | caseRegexp x Bool 21 | /* AnyChar */ (fn u => false) 22 | /* Alphanum */ (fn u => true) /* BUG: should be false */ 23 | /* Kleene */ (fn r => false) 24 | /* Concat */ (fn x y => false) 25 | /* Or */ (fn x y => false) 26 | /* Empty */ (fn u => true) 27 | ;; 28 | 29 | let rec match_regexp (x:Regexp) (k:Regexp) (s:String) : Bool = 30 | (caseRegexp x Bool 31 | /* AnyChar */ 32 | (fn u => 33 | caseString s Bool 34 | /* Null */ 35 | (fn u => false) 36 | (fn a d => match_regexp (Empty unit) k d)) 37 | /* Alphanum */ 38 | (fn u => 39 | caseString s Bool 40 | /* Null */ 41 | (fn u => false) 42 | (fn a d => 43 | if[Bool] (isAlphaNum a) 44 | then match_regexp (Empty unit) k d 45 | else false)) 46 | /* Kleene */ 47 | (fn r => match_regexp (Or (Empty unit) (Concat r (Kleene r))) k s) 48 | /* Concat */ 49 | (fn x y => match_regexp x (Concat y k) s) 50 | /* Or */ 51 | (fn x y => 52 | if[Bool] (match_regexp x k s) 53 | then true 54 | else match_regexp y k s) 55 | /* Empty */ 56 | (fn u => 57 | if[Bool] (isEmpty k) 58 | then (caseString s Bool 59 | (fn u => true) 60 | (fn a d => false)) 61 | else match_regexp k (Empty unit) s));; 62 | 63 | let readString (u:Unit) : String = Cons 4 (Null unit);; /* not alphanum */ 64 | 65 | let executeSQLquery(query:String) : Int = /* ... */ 0;; 66 | 67 | /********** Client Code **********************/ 68 | 69 | let valid_name_regexp = Kleene (Alphanum unit);; 70 | let isValidName (s:String) : Bool = 71 | match_regexp valid_name_regexp (Empty unit) s;; 72 | let Name = (x:String.isValidName x);; 73 | 74 | 75 | /* Following specification foils attacks such as: 76 | Attacks: 77 | user gives pwd: foo or true 78 | user gives name: admin -- (-- starts comment) 79 | */ 80 | 81 | let authenticate(username:Name) (password:Name) : Bool = 82 | let query = Null unit in 83 | /* "SELECT count(*) FROM client WHERE name ="^username^" and pwd="^password */ 84 | executeSQLquery(query) >0 85 | ;; 86 | 87 | 88 | /* 89 | let fixed_authenticate (username:String) (password:String) = 90 | if[Bool] (and (isValidName username) (isValidName password)) 91 | then authenticate username password 92 | else false 93 | ;; 94 | */ 95 | 96 | let fixed_authenticate (username:String) (password:String) = 97 | if[Bool] (isValidName username) 98 | then 99 | (if[Bool] (isValidName password) 100 | then authenticate username password 101 | else false) 102 | else false 103 | ;; 104 | 105 | let username = readString unit in 106 | let password = readString unit in 107 | fixed_authenticate username password;; 108 | 109 | 110 | 111 | /* 112 | authenticate (readString unit) (readString unit);; 113 | */ 114 | -------------------------------------------------------------------------------- /tests/bad/regexp.3.f: -------------------------------------------------------------------------------- 1 | let Char :* = Int;; /* unicode */ 2 | 3 | datatype String = 4 | Null of (u:Unit) 5 | | Cons of (x:Char) (r:String) 6 | ;; 7 | 8 | datatype Regexp = 9 | AnyChar of (u:Unit) 10 | | Alphanum of (u:Unit) 11 | | Kleene of (r:Regexp) 12 | | Concat of (x:Regexp) (y:Regexp) 13 | | Or of (x:Regexp) (y:Regexp) 14 | | Empty of (u:Unit) 15 | ;; 16 | 17 | let isAlphaNum (c:Char) = (and (65 <= c) (c <= 92));; 18 | 19 | let rec isEmpty (x:Regexp) : Bool = 20 | caseRegexp x Bool 21 | /* AnyChar */ (fn u => false) 22 | /* Alphanum */ (fn u => false) 23 | /* Kleene */ (fn r => false) 24 | /* Concat */ (fn x y => false) 25 | /* Or */ (fn x y => false) 26 | /* Empty */ (fn u => true) 27 | ;; 28 | 29 | let rec match_regexp (x:Regexp) (k:Regexp) (s:String) : Bool = 30 | (caseRegexp x Bool 31 | /* AnyChar */ 32 | (fn u => 33 | caseString s Bool 34 | /* Null */ 35 | (fn u => false) 36 | (fn a d => match_regexp (Empty unit) k d)) 37 | /* Alphanum */ 38 | (fn u => 39 | caseString s Bool 40 | /* Null */ 41 | (fn u => false) 42 | (fn a d => 43 | if[Bool] (isAlphaNum a) 44 | then match_regexp (Empty unit) k d 45 | else false)) 46 | /* Kleene */ 47 | (fn r => match_regexp (Or (Empty unit) (Concat r (Kleene r))) k s) 48 | /* Concat */ 49 | (fn x y => match_regexp x (Concat y k) s) 50 | /* Or */ 51 | (fn x y => 52 | if[Bool] (match_regexp x k s) 53 | then true 54 | else match_regexp k y s) /* BUG: swapped k and y */ 55 | /* Empty */ 56 | (fn u => 57 | if[Bool] (isEmpty k) 58 | then (caseString s Bool 59 | (fn u => true) 60 | (fn a d => false)) 61 | else match_regexp k (Empty unit) s));; 62 | 63 | let readString (u:Unit) : String = Cons 4 (Null unit);; /* not alphanum */ 64 | 65 | let executeSQLquery(query:String) : Int = /* ... */ 0;; 66 | 67 | /********** Client Code **********************/ 68 | 69 | let valid_name_regexp = Kleene (Alphanum unit);; 70 | let isValidName (s:String) : Bool = 71 | match_regexp valid_name_regexp (Empty unit) s;; 72 | let Name = (x:String.isValidName x);; 73 | 74 | 75 | /* Following specification foils attacks such as: 76 | Attacks: 77 | user gives pwd: foo or true 78 | user gives name: admin -- (-- starts comment) 79 | */ 80 | 81 | let authenticate(username:Name) (password:Name) : Bool = 82 | let query = Null unit in 83 | /* "SELECT count(*) FROM client WHERE name ="^username^" and pwd="^password */ 84 | executeSQLquery(query) >0 85 | ;; 86 | 87 | 88 | /* 89 | let fixed_authenticate (username:String) (password:String) = 90 | if[Bool] (and (isValidName username) (isValidName password)) 91 | then authenticate username password 92 | else false 93 | ;; 94 | */ 95 | 96 | let fixed_authenticate (username:String) (password:String) = 97 | if[Bool] (isValidName username) 98 | then 99 | (if[Bool] (isValidName password) 100 | then authenticate username password 101 | else false) 102 | else false 103 | ;; 104 | 105 | let username = readString unit in 106 | let password = readString unit in 107 | fixed_authenticate username password;; 108 | 109 | 110 | 111 | /* 112 | authenticate (readString unit) (readString unit);; 113 | */ 114 | -------------------------------------------------------------------------------- /tests/bad/regexp.4.f: -------------------------------------------------------------------------------- 1 | let Char :* = Int;; /* unicode */ 2 | 3 | datatype String = 4 | Null of (u:Unit) 5 | | Cons of (x:Char) (r:String) 6 | ;; 7 | 8 | datatype Regexp = 9 | AnyChar of (u:Unit) 10 | | Alphanum of (u:Unit) 11 | | Kleene of (r:Regexp) 12 | | Concat of (x:Regexp) (y:Regexp) 13 | | Or of (x:Regexp) (y:Regexp) 14 | | Empty of (u:Unit) 15 | ;; 16 | 17 | let isAlphaNum (c:Char) = (and (65 <= c) (c <= 92));; 18 | 19 | let rec isEmpty (x:Regexp) : Bool = 20 | caseRegexp x Bool 21 | /* AnyChar */ (fn u => false) 22 | /* Alphanum */ (fn u => false) 23 | /* Kleene */ (fn r => false) 24 | /* Concat */ (fn x y => false) 25 | /* Or */ (fn x y => false) 26 | /* Empty */ (fn u => true) 27 | ;; 28 | 29 | let rec match_regexp (x:Regexp) (k:Regexp) (s:String) : Bool = 30 | (caseRegexp x Bool 31 | /* AnyChar */ 32 | (fn u => 33 | caseString s Bool 34 | /* Null */ 35 | (fn u => false) 36 | (fn a d => match_regexp (Empty unit) k a)) /* BUG: replaced d by a */ 37 | /* Alphanum */ 38 | (fn u => 39 | caseString s Bool 40 | /* Null */ 41 | (fn u => false) 42 | (fn a d => 43 | if[Bool] (isAlphaNum a) 44 | then match_regexp (Empty unit) k d 45 | else false)) 46 | /* Kleene */ 47 | (fn r => match_regexp (Or (Empty unit) (Concat r (Kleene r))) k s) 48 | /* Concat */ 49 | (fn x y => match_regexp x (Concat y k) s) 50 | /* Or */ 51 | (fn x y => 52 | if[Bool] (match_regexp x k s) 53 | then true 54 | else match_regexp y k s) 55 | /* Empty */ 56 | (fn u => 57 | if[Bool] (isEmpty k) 58 | then (caseString s Bool 59 | (fn u => true) 60 | (fn a d => false)) 61 | else match_regexp k (Empty unit) s));; 62 | 63 | let readString (u:Unit) : String = Cons 4 (Null unit);; /* not alphanum */ 64 | 65 | let executeSQLquery(query:String) : Int = /* ... */ 0;; 66 | 67 | /********** Client Code **********************/ 68 | 69 | let valid_name_regexp = Kleene (Alphanum unit);; 70 | let isValidName (s:String) : Bool = 71 | match_regexp valid_name_regexp (Empty unit) s;; 72 | let Name = (x:String.isValidName x);; 73 | 74 | 75 | /* Following specification foils attacks such as: 76 | Attacks: 77 | user gives pwd: foo or true 78 | user gives name: admin -- (-- starts comment) 79 | */ 80 | 81 | let authenticate(username:Name) (password:Name) : Bool = 82 | let query = Null unit in 83 | /* "SELECT count(*) FROM client WHERE name ="^username^" and pwd="^password */ 84 | executeSQLquery(query) >0 85 | ;; 86 | 87 | 88 | /* 89 | let fixed_authenticate (username:String) (password:String) = 90 | if[Bool] (and (isValidName username) (isValidName password)) 91 | then authenticate username password 92 | else false 93 | ;; 94 | */ 95 | 96 | let fixed_authenticate (username:String) (password:String) = 97 | if[Bool] (isValidName username) 98 | then 99 | (if[Bool] (isValidName password) 100 | then authenticate username password 101 | else false) 102 | else false 103 | ;; 104 | 105 | let username = readString unit in 106 | let password = readString unit in 107 | fixed_authenticate username password;; 108 | 109 | 110 | 111 | /* 112 | authenticate (readString unit) (readString unit);; 113 | */ 114 | -------------------------------------------------------------------------------- /tests/bad/regexp.5.f: -------------------------------------------------------------------------------- 1 | let Char :* = Int;; /* unicode */ 2 | 3 | datatype String = 4 | Null of (u:Unit) 5 | | Cons of (x:Char) (r:String) 6 | ;; 7 | 8 | datatype Regexp = 9 | AnyChar of (u:Unit) 10 | | Alphanum of (u:Unit) 11 | | Kleene of (r:Regexp) 12 | | Concat of (x:Regexp) (y:Regexp) 13 | | Or of (x:Regexp) (y:Regexp) 14 | | Empty of (u:Unit) 15 | ;; 16 | 17 | let isAlphaNum (c:Char) = (and (65 <= c) (c <= 92));; 18 | 19 | let rec isEmpty (x:Regexp) : Bool = 20 | caseRegexp x Bool 21 | /* AnyChar */ (fn u => false) 22 | /* Alphanum */ (fn u => false) 23 | /* Kleene */ (fn r => false) 24 | /* Concat */ (fn x y => false) 25 | /* Or */ (fn x y => false) 26 | /* Empty */ (fn u => true) 27 | ;; 28 | 29 | let rec match_regexp (x:Regexp) (k:Regexp) (s:String) : Bool = 30 | (caseRegexp x Bool 31 | /* AnyChar */ 32 | (fn u => 33 | caseString s Bool 34 | /* Null */ 35 | (fn u => false) 36 | (fn a d => match_regexp (Empty unit) k d)) 37 | /* Alphanum */ 38 | (fn u => 39 | caseString s Bool 40 | /* Null */ 41 | (fn u => false) 42 | (fn a d => 43 | if[Bool] (isAlphaNum d) /* BUG: replaced a by d */ 44 | then match_regexp (Empty unit) k d 45 | else false)) 46 | /* Kleene */ 47 | (fn r => match_regexp (Or (Empty unit) (Concat r (Kleene r))) k s) 48 | /* Concat */ 49 | (fn x y => match_regexp x (Concat y k) s) 50 | /* Or */ 51 | (fn x y => 52 | if[Bool] (match_regexp x k s) 53 | then true 54 | else match_regexp y k s) 55 | /* Empty */ 56 | (fn u => 57 | if[Bool] (isEmpty k) 58 | then (caseString s Bool 59 | (fn u => true) 60 | (fn a d => false)) 61 | else match_regexp k (Empty unit) s));; 62 | 63 | let readString (u:Unit) : String = Cons 4 (Null unit);; /* not alphanum */ 64 | 65 | let executeSQLquery(query:String) : Int = /* ... */ 0;; 66 | 67 | /********** Client Code **********************/ 68 | 69 | let valid_name_regexp = Kleene (Alphanum unit);; 70 | let isValidName (s:String) : Bool = 71 | match_regexp valid_name_regexp (Empty unit) s;; 72 | let Name = (x:String.isValidName x);; 73 | 74 | 75 | /* Following specification foils attacks such as: 76 | Attacks: 77 | user gives pwd: foo or true 78 | user gives name: admin -- (-- starts comment) 79 | */ 80 | 81 | let authenticate(username:Name) (password:Name) : Bool = 82 | let query = Null unit in 83 | /* "SELECT count(*) FROM client WHERE name ="^username^" and pwd="^password */ 84 | executeSQLquery(query) >0 85 | ;; 86 | 87 | 88 | /* 89 | let fixed_authenticate (username:String) (password:String) = 90 | if[Bool] (and (isValidName username) (isValidName password)) 91 | then authenticate username password 92 | else false 93 | ;; 94 | */ 95 | 96 | let fixed_authenticate (username:String) (password:String) = 97 | if[Bool] (isValidName username) 98 | then 99 | (if[Bool] (isValidName password) 100 | then authenticate username password 101 | else false) 102 | else false 103 | ;; 104 | 105 | let username = readString unit in 106 | let password = readString unit in 107 | fixed_authenticate username password;; 108 | 109 | 110 | 111 | /* 112 | authenticate (readString unit) (readString unit);; 113 | */ 114 | -------------------------------------------------------------------------------- /tests/bad/regexp.6.f: -------------------------------------------------------------------------------- 1 | let Char :* = Int;; /* unicode */ 2 | 3 | datatype String = 4 | Null of (u:Unit) 5 | | Cons of (x:Char) (r:String) 6 | ;; 7 | 8 | datatype Regexp = 9 | AnyChar of (u:Unit) 10 | | Alphanum of (u:Unit) 11 | | Kleene of (r:Regexp) 12 | | Concat of (x:Regexp) (y:Regexp) 13 | | Or of (x:Regexp) (y:Regexp) 14 | | Empty of (u:Unit) 15 | ;; 16 | 17 | let isAlphaNum (c:Char) = (and (65 <= c) (c <= 92));; 18 | 19 | let rec isEmpty (x:Regexp) : Bool = 20 | caseRegexp x Bool 21 | /* AnyChar */ (fn u => false) 22 | /* Alphanum */ (fn u => false) 23 | /* Kleene */ (fn r => false) 24 | /* Concat */ (fn x y => false) 25 | /* Or */ (fn x y => false) 26 | /* Empty */ (fn u => true) 27 | ;; 28 | 29 | let rec match_regexp (x:Regexp) (k:Regexp) (s:String) : Bool = 30 | (caseRegexp x Bool 31 | /* AnyChar */ 32 | (fn u => 33 | caseString s Bool 34 | /* Null */ 35 | (fn u => false) 36 | (fn a d => match_regexp (Empty unit) k d)) 37 | /* Alphanum */ 38 | (fn u => 39 | caseString s Bool 40 | /* Null */ 41 | (fn u => false) 42 | (fn a d => 43 | if[Bool] (isAlphaNum a) 44 | then match_regexp (Empty unit) k d 45 | else false)) 46 | /* Kleene */ 47 | (fn r => match_regexp (Or (Empty unit) (Concat r (Kleene r))) k s) 48 | /* Concat */ 49 | (fn x y => match_regexp x (Concat y k) s) 50 | /* Or */ 51 | (fn x y => 52 | if[Bool] (match_regexp x k s) 53 | then true 54 | else match_regexp y k s) 55 | /* Empty */ 56 | (fn u => 57 | if[Bool] (isEmpty k) 58 | then (caseString s Bool 59 | (fn a d => false)) /* BUG: swapped this line and the following */ 60 | (fn u => true) 61 | else match_regexp k (Empty unit) s));; 62 | 63 | let readString (u:Unit) : String = Cons 4 (Null unit);; /* not alphanum */ 64 | 65 | let executeSQLquery(query:String) : Int = /* ... */ 0;; 66 | 67 | /********** Client Code **********************/ 68 | 69 | let valid_name_regexp = Kleene (Alphanum unit);; 70 | let isValidName (s:String) : Bool = 71 | match_regexp valid_name_regexp (Empty unit) s;; 72 | let Name = (x:String.isValidName x);; 73 | 74 | 75 | /* Following specification foils attacks such as: 76 | Attacks: 77 | user gives pwd: foo or true 78 | user gives name: admin -- (-- starts comment) 79 | */ 80 | 81 | let authenticate(username:Name) (password:Name) : Bool = 82 | let query = Null unit in 83 | /* "SELECT count(*) FROM client WHERE name ="^username^" and pwd="^password */ 84 | executeSQLquery(query) >0 85 | ;; 86 | 87 | 88 | /* 89 | let fixed_authenticate (username:String) (password:String) = 90 | if[Bool] (and (isValidName username) (isValidName password)) 91 | then authenticate username password 92 | else false 93 | ;; 94 | */ 95 | 96 | let fixed_authenticate (username:String) (password:String) = 97 | if[Bool] (isValidName username) 98 | then 99 | (if[Bool] (isValidName password) 100 | then authenticate username password 101 | else false) 102 | else false 103 | ;; 104 | 105 | let username = readString unit in 106 | let password = readString unit in 107 | fixed_authenticate username password;; 108 | 109 | 110 | 111 | /* 112 | authenticate (readString unit) (readString unit);; 113 | */ 114 | -------------------------------------------------------------------------------- /tests/bad/regexp.7.f: -------------------------------------------------------------------------------- 1 | let Char :* = Int;; /* unicode */ 2 | 3 | datatype String = 4 | Null of (u:Unit) 5 | | Cons of (x:Char) (r:String) 6 | ;; 7 | 8 | datatype Regexp = 9 | AnyChar of (u:Unit) 10 | | Alphanum of (u:Unit) 11 | | Kleene of (r:Regexp) 12 | | Concat of (x:Regexp) (y:Regexp) 13 | | Or of (x:Regexp) (y:Regexp) 14 | | Empty of (u:Unit) 15 | ;; 16 | 17 | let isAlphaNum (c:Char) = (and (65 <= c) (c <= 92));; 18 | 19 | let rec isEmpty (x:Regexp) : Bool = 20 | caseRegexp x Bool 21 | /* AnyChar */ (fn u => false) 22 | /* Alphanum */ (fn u => false) 23 | /* Kleene */ (fn r => false) 24 | /* Concat */ (fn x y => false) 25 | /* Or */ (fn x y => false) 26 | /* Empty */ (fn u => true) 27 | ;; 28 | 29 | let rec match_regexp (x:Regexp) (k:Regexp) (s:String) : Bool = 30 | (caseRegexp x Bool 31 | /* AnyChar */ 32 | (fn u => 33 | caseString s Bool 34 | /* Null */ 35 | (fn u => false) 36 | (fn a d => match_regexp (Empty unit) k d)) 37 | /* Alphanum */ 38 | (fn u => 39 | caseString s Bool 40 | /* Null */ 41 | (fn u => false) 42 | (fn a d => 43 | if[Bool] (isAlphaNum a) 44 | then match_regexp (Empty unit) k d 45 | else false)) 46 | /* Kleene */ 47 | (fn r => match_regexp (Or (Empty unit) (Concat r (Kleene r))) k s) 48 | /* Concat */ 49 | (fn x y => match_regexp x (Concat y k) x) /* BUG: replaced s by x */ 50 | /* Or */ 51 | (fn x y => 52 | if[Bool] (match_regexp x k s) 53 | then true 54 | else match_regexp y k s) 55 | /* Empty */ 56 | (fn u => 57 | if[Bool] (isEmpty k) 58 | then (caseString s Bool 59 | (fn u => true) 60 | (fn a d => false)) 61 | else match_regexp k (Empty unit) s));; 62 | 63 | let readString (u:Unit) : String = Cons 4 (Null unit);; /* not alphanum */ 64 | 65 | let executeSQLquery(query:String) : Int = /* ... */ 0;; 66 | 67 | /********** Client Code **********************/ 68 | 69 | let valid_name_regexp = Kleene (Alphanum unit);; 70 | let isValidName (s:String) : Bool = 71 | match_regexp valid_name_regexp (Empty unit) s;; 72 | let Name = (x:String.isValidName x);; 73 | 74 | 75 | /* Following specification foils attacks such as: 76 | Attacks: 77 | user gives pwd: foo or true 78 | user gives name: admin -- (-- starts comment) 79 | */ 80 | 81 | let authenticate(username:Name) (password:Name) : Bool = 82 | let query = Null unit in 83 | /* "SELECT count(*) FROM client WHERE name ="^username^" and pwd="^password */ 84 | executeSQLquery(query) >0 85 | ;; 86 | 87 | 88 | /* 89 | let fixed_authenticate (username:String) (password:String) = 90 | if[Bool] (and (isValidName username) (isValidName password)) 91 | then authenticate username password 92 | else false 93 | ;; 94 | */ 95 | 96 | let fixed_authenticate (username:String) (password:String) = 97 | if[Bool] (isValidName username) 98 | then 99 | (if[Bool] (isValidName password) 100 | then authenticate username password 101 | else false) 102 | else false 103 | ;; 104 | 105 | let username = readString unit in 106 | let password = readString unit in 107 | fixed_authenticate username password;; 108 | 109 | 110 | 111 | /* 112 | authenticate (readString unit) (readString unit);; 113 | */ 114 | -------------------------------------------------------------------------------- /tests/bad/regexp.8.f: -------------------------------------------------------------------------------- 1 | let Char :* = Int;; /* unicode */ 2 | 3 | datatype String = 4 | Null of (u:Unit) 5 | | Cons of (x:Char) (r:String) 6 | ;; 7 | 8 | datatype Regexp = 9 | AnyChar of (u:Unit) 10 | | Alphanum of (u:Unit) 11 | | Kleene of (r:Regexp) 12 | | Concat of (x:Regexp) (y:Regexp) 13 | | Or of (x:Regexp) (y:Regexp) 14 | | Empty of (u:Unit) 15 | ;; 16 | 17 | let isAlphaNum (c:Char) = (and (65 <= c) (c <= 92));; 18 | 19 | let rec isEmpty (x:Regexp) : Bool = 20 | caseRegexp x Bool 21 | /* AnyChar */ (fn u => false) 22 | /* Alphanum */ (fn u => false) 23 | /* Kleene */ (fn r => false) 24 | /* Concat */ (fn x y => false) 25 | /* Or */ (fn x y => false) 26 | /* Empty */ (fn u => true) 27 | ;; 28 | 29 | let rec match_regexp (x:Regexp) (k:Regexp) (s:String) : Bool = 30 | (caseRegexp x Bool 31 | /* AnyChar */ 32 | (fn u => 33 | caseString s Bool 34 | /* Null */ 35 | (fn u => false) 36 | (fn a d => match_regexp (Empty unit) k d)) 37 | /* Alphanum */ 38 | (fn u => 39 | caseString s Bool 40 | /* Null */ 41 | (fn u => false) 42 | (fn a d => 43 | if[Bool] (isAlphaNum a) 44 | then match_regexp (Empty unit) k d 45 | else false)) 46 | /* Kleene */ 47 | /* BUG: r -> s */ 48 | (fn r => match_regexp (Or (Empty unit) (Concat r (Kleene s))) k s) 49 | /* Concat */ 50 | (fn x y => match_regexp x (Concat y k) s) 51 | /* Or */ 52 | (fn x y => 53 | if[Bool] (match_regexp x k s) 54 | then true 55 | else match_regexp y k s) 56 | /* Empty */ 57 | (fn u => 58 | if[Bool] (isEmpty k) 59 | then (caseString s Bool 60 | (fn u => true) 61 | (fn a d => false)) 62 | else match_regexp k (Empty unit) s));; 63 | 64 | let readString (u:Unit) : String = Cons 4 (Null unit);; /* not alphanum */ 65 | 66 | let executeSQLquery(query:String) : Int = /* ... */ 0;; 67 | 68 | /********** Client Code **********************/ 69 | 70 | let valid_name_regexp = Kleene (Alphanum unit);; 71 | let isValidName (s:String) : Bool = 72 | match_regexp valid_name_regexp (Empty unit) s;; 73 | let Name = (x:String.isValidName x);; 74 | 75 | 76 | /* Following specification foils attacks such as: 77 | Attacks: 78 | user gives pwd: foo or true 79 | user gives name: admin -- (-- starts comment) 80 | */ 81 | 82 | let authenticate(username:Name) (password:Name) : Bool = 83 | let query = Null unit in 84 | /* "SELECT count(*) FROM client WHERE name ="^username^" and pwd="^password */ 85 | executeSQLquery(query) >0 86 | ;; 87 | 88 | 89 | /* 90 | let fixed_authenticate (username:String) (password:String) = 91 | if[Bool] (and (isValidName username) (isValidName password)) 92 | then authenticate username password 93 | else false 94 | ;; 95 | */ 96 | 97 | let fixed_authenticate (username:String) (password:String) = 98 | if[Bool] (isValidName username) 99 | then 100 | (if[Bool] (isValidName password) 101 | then authenticate username password 102 | else false) 103 | else false 104 | ;; 105 | 106 | let username = readString unit in 107 | let password = readString unit in 108 | fixed_authenticate username password;; 109 | 110 | 111 | 112 | /* 113 | authenticate (readString unit) (readString unit);; 114 | */ 115 | -------------------------------------------------------------------------------- /tests/bad/regexp.9.f: -------------------------------------------------------------------------------- 1 | let Char :* = Int;; /* unicode */ 2 | 3 | datatype String = 4 | Null of (u:Unit) 5 | | Cons of (x:Char) (r:String) 6 | ;; 7 | 8 | datatype Regexp = 9 | AnyChar of (u:Unit) 10 | | Alphanum of (u:Unit) 11 | | Kleene of (r:Regexp) 12 | | Concat of (x:Regexp) (y:Regexp) 13 | | Or of (x:Regexp) (y:Regexp) 14 | | Empty of (u:Unit) 15 | ;; 16 | 17 | let isAlphaNum (c:Char) = (and (65 <= c) (c <= 92));; 18 | 19 | let rec isEmpty (x:Regexp) : Bool = 20 | caseRegexp x Bool 21 | /* AnyChar */ (fn u => false) 22 | /* Alphanum */ (fn u => false) 23 | /* Kleene */ (fn r => false) 24 | /* Concat */ (fn x y => false) 25 | /* Or */ (fn x y => false) 26 | /* Empty */ (fn u => true) 27 | ;; 28 | 29 | let rec match_regexp (x:Regexp) (k:Regexp) (s:String) : Bool = 30 | (caseRegexp x Bool 31 | /* AnyChar */ 32 | (fn u => 33 | caseString s Bool 34 | /* Null */ 35 | (fn u => false) 36 | (fn a d => match_regexp (Empty unit) k d)) 37 | /* Alphanum */ 38 | (fn u => 39 | caseString s Bool 40 | /* Null */ 41 | (fn u => false) 42 | (fn a d => 43 | if[Bool] (isAlphaNum a) 44 | then match_regexp (Empty unit) k d 45 | else false)) 46 | /* Kleene */ 47 | (fn r => match_regexp (Or (Empty unit) (Concat r (Kleene r))) k s) 48 | /* Concat */ 49 | (fn x y => match_regexp x (Concat y k) s) 50 | /* Or */ 51 | (fn x y => 52 | if[Bool] (match_regexp x k s) 53 | then true 54 | else match_regexp y k s) 55 | /* Empty */ 56 | (fn u => 57 | if[Bool] (isEmpty k) 58 | then (caseString s Bool 59 | (fn u => true) 60 | (fn a d => false)) 61 | else match_regexp k s (Empty unit)));; /* BUG: s <-> (Empty unit) */ 62 | 63 | let readString (u:Unit) : String = Cons 4 (Null unit);; /* not alphanum */ 64 | 65 | let executeSQLquery(query:String) : Int = /* ... */ 0;; 66 | 67 | /********** Client Code **********************/ 68 | 69 | let valid_name_regexp = Kleene (Alphanum unit);; 70 | let isValidName (s:String) : Bool = 71 | match_regexp valid_name_regexp (Empty unit) s;; 72 | let Name = (x:String.isValidName x);; 73 | 74 | 75 | /* Following specification foils attacks such as: 76 | Attacks: 77 | user gives pwd: foo or true 78 | user gives name: admin -- (-- starts comment) 79 | */ 80 | 81 | let authenticate(username:Name) (password:Name) : Bool = 82 | let query = Null unit in 83 | /* "SELECT count(*) FROM client WHERE name ="^username^" and pwd="^password */ 84 | executeSQLquery(query) >0 85 | ;; 86 | 87 | 88 | /* 89 | let fixed_authenticate (username:String) (password:String) = 90 | if[Bool] (and (isValidName username) (isValidName password)) 91 | then authenticate username password 92 | else false 93 | ;; 94 | */ 95 | 96 | let fixed_authenticate (username:String) (password:String) = 97 | if[Bool] (isValidName username) 98 | then 99 | (if[Bool] (isValidName password) 100 | then authenticate username password 101 | else false) 102 | else false 103 | ;; 104 | 105 | let username = readString unit in 106 | let password = readString unit in 107 | fixed_authenticate username password;; 108 | 109 | 110 | 111 | /* 112 | authenticate (readString unit) (readString unit);; 113 | */ 114 | -------------------------------------------------------------------------------- /tests/bad/regexp.f: -------------------------------------------------------------------------------- 1 | let Char :* = Int;; /* unicode */ 2 | 3 | datatype String = 4 | Null of (u:Unit) 5 | | Cons of (x:Char) (r:String) 6 | ;; 7 | 8 | datatype Regexp = 9 | AnyChar of (u:Unit) 10 | | Alphanum of (u:Unit) 11 | | Kleene of (r:Regexp) 12 | | Concat of (x:Regexp) (y:Regexp) 13 | | Or of (x:Regexp) (y:Regexp) 14 | | Empty of (u:Unit) 15 | ;; 16 | 17 | let isAlphaNum (c:Char) = (and (65 <= c) (c <= 92));; 18 | 19 | let rec isEmpty (x:Regexp) : Bool = 20 | caseRegexp x Bool 21 | /* AnyChar */ (fn u => false) 22 | /* Alphanum */ (fn u => false) 23 | /* Kleene */ (fn r => false) 24 | /* Concat */ (fn x y => false) 25 | /* Or */ (fn x y => false) 26 | /* Empty */ (fn u => true) 27 | ;; 28 | 29 | let rec match_regexp (x:Regexp) (k:Regexp) (s:String) : Bool = 30 | (caseRegexp x Bool 31 | /* AnyChar */ 32 | (fn u => 33 | caseString s Bool 34 | /* Null */ 35 | (fn u => false) 36 | (fn a d => match_regexp (Empty unit) k d)) 37 | /* Alphanum */ 38 | (fn u => 39 | caseString s Bool 40 | /* Null */ 41 | (fn u => false) 42 | (fn a d => 43 | if[Bool] (isAlphaNum a) 44 | then match_regexp (Empty unit) k d 45 | else false)) 46 | /* Kleene */ 47 | (fn r => match_regexp (Or (Empty unit) (Concat r (Kleene r))) k s) 48 | /* Concat */ 49 | (fn x y => match_regexp x (Concat y k) s) 50 | /* Or */ 51 | (fn x y => 52 | if[Bool] (match_regexp x k s) 53 | then true 54 | else match_regexp y k s) 55 | /* Empty */ 56 | (fn u => 57 | if[Bool] (isEmpty k) 58 | then (caseString s Bool 59 | (fn u => true) 60 | (fn a d => false)) 61 | else match_regexp k (Empty unit) s));; 62 | 63 | let readString (u:Unit) : String = Cons 4 (Null unit);; /* not alphanum */ 64 | 65 | let executeSQLquery(query:String) : Int = /* ... */ 0;; 66 | 67 | /********** Client Code **********************/ 68 | 69 | let valid_name_regexp = Kleene (Alphanum unit);; 70 | let isValidName (s:String) : Bool = 71 | match_regexp valid_name_regexp (Empty unit) s;; 72 | let Name = (x:String.isValidName x);; 73 | 74 | 75 | /* Following specification foils attacks such as: 76 | Attacks: 77 | user gives pwd: foo or true 78 | user gives name: admin -- (-- starts comment) 79 | */ 80 | 81 | let authenticate(username:Name) (password:Name) : Bool = 82 | let query = Null unit in 83 | /* "SELECT count(*) FROM client WHERE name ="^username^" and pwd="^password */ 84 | executeSQLquery(query) >0 85 | ;; 86 | 87 | 88 | /* 89 | let fixed_authenticate (username:String) (password:String) = 90 | if[Bool] (and (isValidName username) (isValidName password)) 91 | then authenticate username password 92 | else false 93 | ;; 94 | */ 95 | 96 | let fixed_authenticate (username:String) (password:String) = 97 | if[Bool] (isValidName username) 98 | then 99 | (if[Bool] (isValidName password) 100 | then authenticate username password 101 | else false) 102 | else false 103 | ;; 104 | 105 | let username = readString unit in 106 | let password = readString unit in 107 | fixed_authenticate username password;; 108 | 109 | 110 | 111 | /* 112 | authenticate (readString unit) (readString unit);; 113 | */ 114 | -------------------------------------------------------------------------------- /tests/bst.sage: -------------------------------------------------------------------------------- 1 | let Rint (lo:Int) (hi:Int) :* = (x:Int. (and (lo<=x) (x false) 11 | (fn i l r => 12 | (or (i=v) 13 | (if[Bool] v < i 14 | then search lo i l (v + 0) 15 | else search i hi r (v + 0))));; 16 | 17 | let rec insert (lo:Int) (hi:Int) (t:BiTree lo hi) (v:Rint lo hi) : (BiTree lo hi) = 18 | caseBiTree lo hi t (BiTree lo hi) 19 | (fn u => 20 | Node lo hi v (Empty lo v) (Empty v hi)) 21 | (fn i l r => 22 | if[(BiTree lo hi)] v < i /* err if i <= v or v <= i*/ 23 | then Node lo hi i (insert lo i l /*err if r*/ (v/* err if i */)) r /* err if l */ 24 | else Node lo hi i l (insert i hi r (v)));; 25 | 26 | let rec sum (lo:Int) (hi:Int) (t:BiTree lo hi) : Int = 27 | caseBiTree lo hi t Int 28 | (fn u => 0) 29 | (fn i l r => 30 | (sum lo i l) + (sum i hi r));; 31 | 32 | 33 | 34 | let MININT : Int = 0-32767;; 35 | let MAXINT : Int = 32767;; 36 | 37 | let BTree = BiTree MININT MAXINT;; 38 | let Int16 = Rint MININT MAXINT;; 39 | let mt:BTree = Empty MININT MAXINT;; 40 | let ins (t:BTree) (v:Int16) : BTree = insert MININT MAXINT t v;; 41 | let get (t:BTree) (v:Int16) : Bool = search MININT MAXINT t v;; 42 | 43 | let t : BTree = (ins (ins (ins mt 1) 2) 3);; 44 | 45 | 46 | let Pos = Rint 1 MAXINT;; 47 | 48 | let PTree = BiTree 1 MAXINT;; 49 | 50 | let mtP:PTree = Empty 1 MAXINT;; 51 | let insP (t:PTree) (v:Pos) : PTree = insert 1 MAXINT t v;; 52 | let getP (t:PTree) (v:Pos) : Bool = search 1 MAXINT t v;; 53 | 54 | let tP : PTree = (insP (insP (insP mtP 1) 2) 3);; 55 | 56 | (getP tP 2);; /* true */ 57 | (getP tP 4);; /* false */ 58 | 59 | 60 | let sumAny = sum MININT MAXINT;; 61 | sumAny t;; 62 | /* sumAny tP;; */ 63 | -------------------------------------------------------------------------------- /tests/cast.sage: -------------------------------------------------------------------------------- 1 | cast Bool Bool true;; 2 | -------------------------------------------------------------------------------- /tests/church_pairs.sage: -------------------------------------------------------------------------------- 1 | /* Creating data types without using syntactic sugar */ 2 | let Pair = fn (X:*) (Y:*) => (Z:*->(X->Y->Z)->Z);; 3 | let pair = fn (X:*) (Y:*) => fn (x:X) (y:Y) (Z:*) => fn (f:X->Y->Z) => f x y;; 4 | let fst = fn (X:*) (Y:*) => fn (p:Pair X Y) => p X (fn (x:X) (y:Y) => x);; 5 | let snd = fn (X:*) (Y:*) => fn (p:Pair X Y) => p Y (fn (x:X) (y:Y) => y);; 6 | 7 | -------------------------------------------------------------------------------- /tests/commands.sage: -------------------------------------------------------------------------------- 1 | true;; 2 | let x = true;; 3 | x;; 4 | -------------------------------------------------------------------------------- /tests/datatype1.sage: -------------------------------------------------------------------------------- 1 | datatype D = 2 | Moo of (y:Bool) (z:Bool) 3 | | Cow of (z:Int);; 4 | 5 | /* This should be equivalent to the following: */ 6 | 7 | /* let rec W : * = (Z:* -> (Bool->Z) -> (Int -> Z) -> (Unit -> Z) -> Z);; */ 8 | 9 | /* let rec DC (x:Unit) :* = (Z:* -> (Bool->Z) -> (Int -> Z) -> (Unit -> Z) -> Z);; 10 | let D = (DC unit);; */ 11 | 12 | /* 13 | let rec D : * = (Z:* -> (Bool->Z) -> (Int -> Z) -> (Unit -> Z) -> Z);; 14 | 15 | let Moo = fn (d:Bool) : D => fn (Z:*) (f1:Bool->Z) (f2:Int->Z) (f3:Unit->Z) => f1 d;; 16 | let Cow = fn (d:Int): D => fn (Z:*) (f1:Bool->Z) (f2:Int->Z) (f3:Unit->Z) => f2 d;; 17 | let Moose : D = fn (Z:*) (f1:Bool->Z) (f2:Int->Z) (f3:Unit->Z) => f3 unit;; 18 | 19 | let caseD = fn (Z:*) (v:D) (f1:Bool->Z) (f2:Int->Z) (f3:Unit->Z) => (v Z) f1 f2 f3;; 20 | 21 | let moo = fn (d:D) : Int => 22 | caseD Int d (fn x => if[Int] x then 10 else 100) (fn x => x) (fn x => 2);; 23 | */ 24 | -------------------------------------------------------------------------------- /tests/fail1.sage: -------------------------------------------------------------------------------- 1 | x:Int->true;; 2 | -------------------------------------------------------------------------------- /tests/fail2.sage: -------------------------------------------------------------------------------- 1 | (lambda x:Int.x) true;; 2 | -------------------------------------------------------------------------------- /tests/fail4.sage: -------------------------------------------------------------------------------- 1 | (lambda Z:*. false true) Int;; 2 | -------------------------------------------------------------------------------- /tests/failrefine.sage: -------------------------------------------------------------------------------- 1 | assumenot :- (x:Int.x=1) <: (x:Int.x=0);; 2 | (fn (x:Int.x=0) => x) 1;; 3 | -------------------------------------------------------------------------------- /tests/fib_refine.sage: -------------------------------------------------------------------------------- 1 | let Pos = (x:Int. x>=0);; 2 | 3 | let rec fib (x:Pos) : Pos = 4 | if[Pos] x < 2 then 5 | 1 6 | else 7 | (fib (x-1)) + (fib (x-2));; 8 | 9 | fib 3;; 10 | 11 | -------------------------------------------------------------------------------- /tests/foo.sage: -------------------------------------------------------------------------------- 1 | cast Bool (x:Bool.x) false;; 2 | -------------------------------------------------------------------------------- /tests/gctest.sage: -------------------------------------------------------------------------------- 1 | let x : Int = 3;; 2 | let y : Int = 2;; 3 | let a : (b:Int.x>0) = 1;; 4 | let T = (c:Int.c>x);; 5 | let b = fn (w:Int) => x + w;; 6 | 7 | assume :- T <: Int;; 8 | 9 | -------------------------------------------------------------------------------- /tests/gctest2.sage: -------------------------------------------------------------------------------- 1 | 2 | assume X:*,Y:*,Z:X->Y :- X <: Y;; 3 | -------------------------------------------------------------------------------- /tests/gctest3.sage: -------------------------------------------------------------------------------- 1 | 2 | let w:Int = 0;; 3 | let x:Int = 0;; 4 | let m:Int = 2;; 5 | let X:* = Int -> Int;; 6 | let v:(u:Int.x = w) = 2;; 7 | let s : X = (fn (x:Int) : Int => x);; 8 | let u:(r:Int.w = 0) = 0;; 9 | 10 | assume :- (y:Int.y < x) <: (y:Int.y = 0);; 11 | -------------------------------------------------------------------------------- /tests/heap.sage: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | /* (Heap m) <: (Heap n) iff n <= m */ 6 | datatype Heap (min:Int) = 7 | Empty 8 | | Node of (x:Int. min <= x) (c:Int) (l:(Heap x)) (r:(Heap x));; 9 | 10 | let n1 : (Heap 0) = (Empty 0);; 11 | let n2 : (Heap 1) = Node 1 1 6 12 | (Node 1 2 2 (Empty 2) (Empty 2)) 13 | (Node 1 4 2 (Empty 4) (Empty 4));; 14 | 15 | 16 | let test1 (h:(Heap 0)) : Bool = true;; 17 | 18 | test1 n2;; 19 | 20 | let min (a:Int) (b:Int) : (c:Int.(a>=c) && (b>=c)) = 21 | if[(c:Int.(a>=c) && (b>=c))] (a >= b) then 22 | b 23 | else 24 | a;; 25 | 26 | let max = fn (a:Int) (b:Int) => 27 | if[c:Int.(c>=a) && (c>=b)] (a >= b) then 28 | a 29 | else 30 | b;; 31 | 32 | let heap_children (min:Int) (h:(Heap min)) : Int = 33 | caseHeap min h Int 34 | (fn u => 0) 35 | (fn x c l r => c);; 36 | 37 | let rec insert (hmin:Int) 38 | (h:(Heap hmin)) 39 | (v:Int) 40 | (rmin:Int.(rmin <= hmin) && (rmin <= v)) : 41 | (Heap rmin) = 42 | caseHeap hmin h (Heap rmin) 43 | (fn u => 44 | Node v v 2 (Empty v) (Empty v)) 45 | (fn x c l r => 46 | if[Heap rmin] v < x 47 | then 48 | let newchildren : Int = (heap_children hmin h) + 1 in 49 | (Node rmin v newchildren (Node v x c l r) (Empty v)) 50 | else /* v >= x */ 51 | let lchildren : Int = heap_children x l in 52 | let rchildren : Int = heap_children x r in 53 | let newmin : (m:Int.(m <= x) && (m <= rmin)) = min x rmin in 54 | if[Heap rmin] lchildren < rchildren 55 | then 56 | Node rmin x (c + 1) (insert x l v x) r 57 | else 58 | Node rmin x (c + 1) l (insert x r v x)) 59 | ;; 60 | 61 | let extract_min (min:Int) (h:(Heap min)) : (r:Int.(min <= r)) = 62 | caseHeap min h (r:Int.(min <= r)) 63 | (fn u => min) /* This seems weird */ 64 | (fn x c l r => x) 65 | ;; 66 | 67 | let h1 = insert 0 (Empty 0) 1 0;; 68 | let h2 = insert 0 h1 2 0;; 69 | extract_min 0 h2;; 70 | -------------------------------------------------------------------------------- /tests/if.sage: -------------------------------------------------------------------------------- 1 | if true then 0 else 1;; 2 | IF Int true (fn (u:Unit) => 1) (fn (u:Unit) => 2);; 3 | -------------------------------------------------------------------------------- /tests/mergesort.sage: -------------------------------------------------------------------------------- 1 | /* 2 | vim:syntax=sml 3 | */ 4 | 5 | let MININT = 0 - 32768;; 6 | let MAXINT = 32767;; 7 | 8 | datatype List (lo:Int) = 9 | Null 10 | | Cons of (h:Int) (t:(List lo));; 11 | 12 | datatype Pair (S:*) (T:*) = 13 | MkPair of (fst:S) (snd:T);; 14 | 15 | /* (OrderedList n) <: (OrderedList m) iff n >= m */ 16 | datatype OrderedList (lo:Int) = 17 | ONull 18 | | OCons of (h:Int.(lo <= h)) (t:(OrderedList h));; 19 | 20 | let l : (OrderedList 0) = OCons 0 0 (OCons 1 1 (ONull 2));; 21 | 22 | let Above (x:Int):* = (y:Int.x<=y);; 23 | 24 | let rec merge (lo:Int) 25 | (lo1:Above lo) 26 | (l1:OrderedList lo1) 27 | (lo2:Above lo) 28 | (l2:OrderedList lo2) : 29 | (OrderedList lo) = 30 | caseOrderedList lo1 l1 (OrderedList lo) 31 | (fn u => l2) 32 | (fn h1 t1 => 33 | caseOrderedList lo2 l2 (OrderedList lo) 34 | (fn u => l1) 35 | (fn h2 t2 => 36 | if[OrderedList lo] h1 < h2 then 37 | (OCons lo h1 38 | (merge h1 h1 t1 h2 (OCons h2 h2 t2))) 39 | else 40 | (OCons lo h2 41 | (merge h2 h2 t2 h1 (OCons h1 h1 t1))) 42 | ) 43 | ) 44 | ;; 45 | 46 | let rec length (lo:Int) (l:(List lo)) : Int = 47 | caseList lo l Int 48 | (fn u => 0) 49 | (fn h t => 1 + (length lo t));; 50 | 51 | let partition (lo:Int) (l:(List lo)) : (Pair (List lo) (List lo)) = 52 | let rec helper (firsthalf:(List lo)) (secondhalf:(List lo)) : 53 | (Pair (List lo) (List lo)) = 54 | caseList lo firsthalf (Pair (List lo) (List lo)) 55 | (fn u => (MkPair (List lo) (List lo) firsthalf secondhalf)) 56 | (fn h t => 57 | if[Pair (List lo) (List lo)] 58 | ((length lo t) >= ((length lo secondhalf) + 1)) 59 | then 60 | helper t (Cons lo h secondhalf) 61 | else 62 | MkPair (List lo) (List lo) firsthalf secondhalf) 63 | in 64 | helper l (Null lo) 65 | ;; 66 | 67 | 68 | let rec merge_sort (lmin:Int) (l:(List lmin)) : (OrderedList lmin) = 69 | casePair (List lmin) (List lmin) (partition lmin l) (OrderedList lmin) 70 | (fn fst snd => 71 | let sorted1 = merge_sort lmin fst in 72 | let sorted2 = merge_sort lmin snd in 73 | merge lmin lmin sorted1 lmin sorted2);; 74 | -------------------------------------------------------------------------------- /tests/polymorphic.sage: -------------------------------------------------------------------------------- 1 | fn (X:*) (x:X) => 1;; 2 | -------------------------------------------------------------------------------- /tests/primitives.sage: -------------------------------------------------------------------------------- 1 | *;; 2 | 3 | unit;; 4 | Unit;; 5 | 6 | Top;; 7 | 8 | Bool;; 9 | true;; 10 | false;; 11 | not;; 12 | 13 | Int;; 14 | 3;; 15 | 4;; 16 | 0;; 17 | 18 | 19 | -------------------------------------------------------------------------------- /tests/quicksort.sage: -------------------------------------------------------------------------------- 1 | datatype Pair (X:*) (Y:*) = 2 | Pcons of (x:X) (y:Y);; 3 | 4 | let LTInt (hi:Int) :* = (x:Int. (x <= hi));; 5 | 6 | let RInt (hi:Int) (lo:(LTInt hi)):* = (x:Int. (and (lo<=x) (x l2) 24 | (fn x y => SCons ub lb x (sortAppend ub mid x y l2));; 25 | 26 | let rec partition (ub:Int) (lb:(LTInt ub)) (pivot:(RInt ub lb)) 27 | (l:(RangeList ub lb)) (l1:(RangeList pivot (lb+0))) 28 | (l2:(RangeList ub pivot)): 29 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) = 30 | caseRangeList ub lb l 31 | (Pair (RangeList pivot (lb+0)) (RangeList ub pivot)) 32 | (fn u => (Pcons (RangeList pivot (lb+0)) (RangeList ub pivot) l1 l2)) 33 | (fn x y => 34 | if [(Pair (RangeList pivot (lb+0)) (RangeList ub pivot))] x >= pivot 35 | then (partition ub lb pivot y l1 (RCons ub pivot (x+0) l2)) 36 | else (partition ub lb pivot y (RCons pivot (lb+0) (x+0) l1) l2));; 37 | 38 | let rec quicksort (ub:Int) (lb:(LTInt ub)) (l:(RangeList ub lb)): 39 | (SortedList ub lb) = 40 | caseRangeList ub lb l (SortedList ub lb) 41 | (fn u1 => (SNull ub lb unit)) 42 | (fn x1 y1 => 43 | (caseRangeList ub lb y1 (SortedList ub lb) 44 | (fn u2 => (SCons ub lb x1 (SNull ub x1 unit))) 45 | (fn x2 y2 => 46 | (let pivot = x1 in 47 | (let pairLists = 48 | (partition ub lb pivot y1 49 | (RNull pivot (lb+0) unit) (RNull ub pivot unit)) in 50 | (casePair (RangeList pivot (lb+0)) (RangeList ub pivot) 51 | pairLists (SortedList ub lb) 52 | (fn x y => (sortAppend ub pivot (lb+0) 53 | (quicksort pivot (lb+0) x) 54 | (SCons ub pivot (pivot+0) (quicksort ub pivot y)))) 55 | ))))));; 56 | 57 | -------------------------------------------------------------------------------- /tests/range.sage: -------------------------------------------------------------------------------- 1 | let Rint (lo:Int) (hi:Int) :* = (x:Int. (and (lo<=x) (x list) 22 | (fn i l r => 23 | NL lo i (listify i (hi + 0) r list) 24 | );; 25 | 26 | 27 | -------------------------------------------------------------------------------- /tests/refine.sage: -------------------------------------------------------------------------------- 1 | (fn (x:Int.x=0) => x) 0;; 2 | let z = fn (x:Int.x>=1): (y:Int.y>=0) => sub x 1;; 3 | 4 | (3 as x:Int.x = 3) as Int;; 5 | -------------------------------------------------------------------------------- /tests/regexp.sage: -------------------------------------------------------------------------------- 1 | let Char :* = Int;; /* unicode */ 2 | 3 | datatype String = 4 | Null of (u:Unit) 5 | | Cons of (x:Char) (r:String) 6 | ;; 7 | 8 | datatype Regexp = 9 | AnyChar of (u:Unit) 10 | | Alphanum of (u:Unit) 11 | | Kleene of (r:Regexp) 12 | | Concat of (x:Regexp) (y:Regexp) 13 | | Or of (x:Regexp) (y:Regexp) 14 | | Empty of (u:Unit) 15 | ;; 16 | 17 | let isAlphaNum (c:Char) = (and (65 <= c) (c <= 92));; 18 | 19 | let rec isEmpty (x:Regexp) : Bool = 20 | caseRegexp x Bool 21 | /* AnyChar */ (fn u => false) 22 | /* Alphanum */ (fn u => false) 23 | /* Kleene */ (fn r => false) 24 | /* Concat */ (fn x y => false) 25 | /* Or */ (fn x y => false) 26 | /* Empty */ (fn u => true) 27 | ;; 28 | 29 | let rec match_regexp (x:Regexp) (k:Regexp) (s:String) : Bool = 30 | (caseRegexp x Bool 31 | /* AnyChar */ 32 | (fn u => 33 | caseString s Bool 34 | /* Null */ 35 | (fn u => false) 36 | (fn a d => match_regexp (Empty unit) k d)) 37 | /* Alphanum */ 38 | (fn u => 39 | caseString s Bool 40 | /* Null */ 41 | (fn u => false) 42 | (fn a d => 43 | if[Bool] (isAlphaNum a) 44 | then match_regexp (Empty unit) k d 45 | else false)) 46 | /* Kleene */ 47 | (fn r => match_regexp (Or (Empty unit) (Concat r (Kleene r))) k s) 48 | /* Concat */ 49 | (fn x y => match_regexp x (Concat y k) s) 50 | /* Or */ 51 | (fn x y => 52 | if[Bool] (match_regexp x k s) 53 | then true 54 | else match_regexp y k s) 55 | /* Empty */ 56 | (fn u => 57 | if[Bool] (isEmpty k) 58 | then (caseString s Bool 59 | (fn u => true) 60 | (fn a d => false)) 61 | else match_regexp k (Empty unit) s));; 62 | 63 | let readString (u:Unit) : String = Cons 4 (Null unit);; /* not alphanum */ 64 | 65 | let executeSQLquery(query:String) : Int = /* ... */ 0;; 66 | 67 | /********** Client Code **********************/ 68 | 69 | let valid_name_regexp = Kleene (Alphanum unit);; 70 | let isValidName (s:String) : Bool = 71 | match_regexp valid_name_regexp (Empty unit) s;; 72 | let Name = (x:String.isValidName x);; 73 | 74 | 75 | /* Following specification foils attacks such as: 76 | Attacks: 77 | user gives pwd: foo or true 78 | user gives name: admin -- (-- starts comment) 79 | */ 80 | 81 | let authenticate(username:Name) (password:Name) : Bool = 82 | let query = Null unit in 83 | /* "SELECT count(*) FROM client WHERE name ="^username^" and pwd="^password */ 84 | executeSQLquery(query) >0 85 | ;; 86 | 87 | 88 | /* 89 | let fixed_authenticate (username:String) (password:String) = 90 | if[Bool] (and (isValidName username) (isValidName password)) 91 | then authenticate username password 92 | else false 93 | ;; 94 | */ 95 | 96 | let fixed_authenticate (username:String) (password:String) = 97 | if[Bool] (isValidName username) 98 | then 99 | (if[Bool] (isValidName password) 100 | then authenticate username password 101 | else false) 102 | else false 103 | ;; 104 | 105 | let username = readString unit in 106 | let password = readString unit in 107 | fixed_authenticate username password;; 108 | 109 | 110 | 111 | /* 112 | authenticate (readString unit) (readString unit);; 113 | */ 114 | -------------------------------------------------------------------------------- /tests/sheard.sage: -------------------------------------------------------------------------------- 1 | /* From Putting Curry-Howard to Work, the Term example of sec 4, 2 | dropping the Pair constructor for simplicity. 3 | */ 4 | 5 | let rec Term (X:*) : * = 6 | R:* 7 | -> (X -> R) 8 | -> (Y:* -> (Term (Y->X)) -> (Term Y) -> R) 9 | -> R 10 | ;; 11 | 12 | let Const (X:*) (x:X) : Term X = 13 | (fn (R:*) (c:X->R) (a:(Y:* -> (Term (Y->X)) -> (Term Y) -> R)) => 14 | c x) 15 | ;; 16 | 17 | let App (X:*) (Y:*) (f:Term (Y->X)) (y:Term Y) : Term X = 18 | (fn (R:*) (c:X->R) (a:(Y:* -> (Term (Y->X)) -> (Term Y) -> R)) => 19 | a Y f y) 20 | ;; 21 | 22 | let t:Term Int = 23 | App Int Int 24 | (Const (Int->Int) (fn (x:Int) => x)) 25 | (Const Int 4) 26 | ;; 27 | 28 | let rec eval (X:*) (t:Term X) : X = 29 | t X 30 | /* Const */ 31 | (fn (x:X) => x) 32 | /* App */ 33 | (fn (Y:*) (t1:Term (Y->X)) (t2:Term Y) => 34 | (eval (Y->X) t1) (eval Y t2)) 35 | ;; 36 | 37 | eval Int t 38 | ;; 39 | -------------------------------------------------------------------------------- /tests/sugar_as.sage: -------------------------------------------------------------------------------- 1 | true as Bool;; 2 | Bool as *;; 3 | (lambda x:Bool . x) as (x:Bool -> Bool);; 4 | -------------------------------------------------------------------------------- /tests/sugar_fn.sage: -------------------------------------------------------------------------------- 1 | (fn x => x) unit;; 2 | (fn (x:Bool) => not x) false;; 3 | (fn (x:Bool) : Int => 5) true;; 4 | (fn (x:Bool) (y:Bool) => x) true false;; 5 | (fn (x:Bool.x) => not x) true;; 6 | -------------------------------------------------------------------------------- /tests/sugar_if.sage: -------------------------------------------------------------------------------- 1 | if [Int] 1 > 2 then 3 else 5;; 2 | -------------------------------------------------------------------------------- /tests/sugar_iff.sage: -------------------------------------------------------------------------------- 1 | let b = true <=> false;; 2 | -------------------------------------------------------------------------------- /tests/sugar_inteq.sage: -------------------------------------------------------------------------------- 1 | 2 | let x = 4 = 5;; 3 | 4 | (IF Int (not x) (fn u => 7) (fn u => 9)) + 1;; 5 | -------------------------------------------------------------------------------- /tests/sugar_let.sage: -------------------------------------------------------------------------------- 1 | let a = 1;; 2 | let b = 3;; 3 | let f (x:Int) = x;; 4 | let g (x:Int) = x + 1;; 5 | g (f b);; 6 | -------------------------------------------------------------------------------- /tests/sugar_letrec.sage: -------------------------------------------------------------------------------- 1 | let rec fib (x:Int) : Int = 2 | if [Int] (x <= 1) 3 | then 1 4 | else (fib (x-1)) + (fib (x-2));; 5 | 6 | fib 3;; 7 | fib 4;; 8 | fib 5;; 9 | fib 6;; 10 | fib 7;; 11 | 12 | /*let rec fib (x:Int) : Int = 13 | if [Int] (x <= 1) 14 | then (fn (x:Bool) => x) true 15 | else (fib (x-1)) + (fib (x-2));; 16 | */ 17 | -------------------------------------------------------------------------------- /tests/sugar_rec.sage: -------------------------------------------------------------------------------- 1 | rec f x => x;; 2 | (rec f x => x) 3;; 3 | (rec f (x:Int) : Int => 4 | IF Int (x = 0) (fn u => x) (fn u => x + (f (x-1)))) 3;; 5 | 6 | let fib = rec f (x:Int) : Int => 7 | if [Int] (x <= 1) then 8 | 1 9 | else 10 | (f (x-1)) + (f (x-2));; 11 | 12 | fib 3;; 13 | fib 4;; 14 | fib 5;; 15 | fib 6;; 16 | fib 7;; 17 | -------------------------------------------------------------------------------- /tests/test_harness.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | 5 | my ($infile, $expected, $type, $description); 6 | my ($outfile, $nsfile, @instat, @outstat); 7 | my ($run, $failed, $total); 8 | my $interp = "../sage"; 9 | my $flags = "-maxeval 100 -prover \"../Simplify\" -phisto -noeval"; 10 | my $nsflags = "-maxeval 100 -phisto -noeval -nosimplify"; 11 | 12 | $run = 0; 13 | $failed = 0; 14 | $total = 0; 15 | open(TESTS, ") { 17 | $total++; 18 | ($infile, $expected, $type, $description) = split; 19 | $outfile = $infile; 20 | $outfile =~ s/\.sage/\.out/; 21 | $nsfile = $infile; 22 | $nsfile =~ s/\.sage/\.nsout/; 23 | @instat = stat($infile); 24 | if((scalar @instat) != 13) { die "$infile not found\n"; } 25 | @outstat = stat($outfile); 26 | if(((scalar @outstat) != 13) or ($instat[9] > $outstat[9])) { 27 | print "Testing $infile ...\n"; 28 | `$interp $flags $infile 2>&1 > $outfile`; 29 | $run++; 30 | if(($? == 0 and $expected =~ /FAIL/i) or 31 | ($? != 0 and $expected =~ /PASS/i)) { 32 | print "******** Test $infile failed, expected $expected\n"; 33 | $failed++; 34 | } 35 | if($type eq "B") { 36 | `$interp $nsflags $infile 2>&1 > $nsfile`; 37 | } 38 | } 39 | } 40 | close(TESTS); 41 | 42 | if($run > 0) { 43 | if($failed == 0) { 44 | print "All tests successful ($run/$total)\n"; 45 | } else { 46 | print "FAILED $failed tests ($failed/$total)\n"; 47 | } 48 | } 49 | -------------------------------------------------------------------------------- /tests/testlist: -------------------------------------------------------------------------------- 1 | arith.sage PASS B Precisely-typed arithmetic operations 2 | assoc.sage PASS T Test of associativity 3 | assume.sage PASS T Test of the 'assume' construct 4 | assumefail.sage FAIL T Test of the 'assumenot' construct 5 | bst.sage PASS B Precisely-typed binary search tree 6 | cast.sage PASS T Test of the 'cast' primitive 7 | church_pairs.sage PASS T Construction of pairs without using 'datatype' 8 | commands.sage PASS T Test of top-level commands 9 | datatype1.sage PASS T Test of 'datatype' construct 10 | fail1.sage FAIL T Tests that Int->true is not a valid type 11 | fail2.sage FAIL T Tests detection of invalid function parameters 12 | fail4.sage FAIL T Tests application of non-function 13 | failrefine.sage FAIL T Tests failed refinement 14 | fib_refine.sage PASS T Fibonacci generator typed to work on positive numbers 15 | gctest2.sage PASS T Test of environment garbage collection 16 | gctest3.sage PASS T Test of environment garbage collection 17 | gctest.sage PASS T Test of environment garbage collection 18 | heap.sage PASS B Precisely-typed heap data structure 19 | if.sage PASS T Test of the different forms of 'if' 20 | mergesort.sage PASS B Precisely-typed mergesort 21 | polylist.sage PASS B OCaml's list module + more precise types 22 | polymorphic.sage PASS T Test of polymorphic functions 23 | primitives.sage PASS T Each primitive as a command, to look up types 24 | printf.sage PASS B Example of printf where type depends on args 25 | quicksort.sage PASS T Precisely-typed quicksort 26 | range.sage PASS T Tree datatype representing integer ranges 27 | redblack.sage PASS T Simply-typed red-black tree 28 | refine.sage PASS T Simple tests of refinements 29 | regexp.sage PASS B Regular expression types 30 | stlc.sage PASS B STLC type checker and interpreter 31 | stlc_norefine.sage PASS T STLC type checker and interpreter w/o refinements 32 | sugar_as.sage PASS T Test of the 'as' construct 33 | sugar_fn.sage PASS T Test of the 'fn' construct 34 | sugar_if.sage PASS T Test of the 'if' construct 35 | sugar_iff.sage PASS T Test of the 'iff' primitive 36 | sugar_inteq.sage PASS T Test of the 'inteq' primitive 37 | sugar_let.sage PASS T Test of the 'let' construct 38 | sugar_letrec.sage PASS T Test of the 'letrec' construct 39 | sugar_rec.sage PASS T Test of the 'rec' construct 40 | misc_test.sage PASS T Miscellaneous simple tests 41 | tree.sage PASS T Hand-encoded tree datatype 42 | sheard.sage PASS T Encoding of GADTs 43 | -------------------------------------------------------------------------------- /tests/tree.sage: -------------------------------------------------------------------------------- 1 | /* standard */ 2 | 3 | let Pair = fn (X:*) (Y:*) :* => (Z:*->(X->Y->Z)->Z);; 4 | 5 | let pair = fn (X:*) (Y:*) (x:X) (y:Y) : Pair X Y => fn (Z:*) (f:X->Y->Z) => f x y;; 6 | 7 | let Sum = fn (X:*) (Y:*) => (Z:*->(X->Z)->(Y->Z)->Z);; 8 | let inl = fn (X:*) (Y:*) (x:X) : (Sum X Y) => fn (Z:*) (fx:X->Z) (fy:Y->Z) => fx x;; 9 | let inr = fn (X:*) (Y:*) (y:Y) : (Sum X Y) => fn (Z:*) (fx:X->Z) (fy:Y->Z) => fy y;; 10 | 11 | /* basically a datatype declaration */ 12 | 13 | let rec Tree:* = Sum Int (Pair Tree Tree);; 14 | let Node = Pair Tree Tree;; 15 | 16 | let leaf(n:Int) = 17 | inl Int Node n;; 18 | let node(a:Tree) (b:Tree): Tree = 19 | inr Int Node (pair Tree Tree a b);; 20 | let case(t:Tree) (Z:*) (f1:Int->Z) (f2:Tree->Tree->Z) :Z = 21 | (t as (Sum Int Node)) 22 | Z 23 | f1 24 | (fn (p:Node):Z => p Z f2);; 25 | 26 | /* code to manipulate trees */ 27 | 28 | let t1 = leaf 3;; 29 | let t2 = node t1 t1;; 30 | 31 | let rec size(t:Tree):Int = 32 | (case t Int 33 | (fn n => 1) 34 | (fn c1 c2 => (size c1) + (size c2)));; 35 | 36 | (size t2);; 37 | 38 | let rec sum(t:Tree):Int = 39 | (case t Int 40 | (fn n => n) 41 | (fn c1 c2 => (sum c1) + (sum c2)));; 42 | 43 | (sum t2);; 44 | 45 | 46 | --------------------------------------------------------------------------------