diff -r d49bf150c925 -r a6a21adf3b55 doc-src/IsarAdvanced/Codegen/Thy/Codegen.thy --- a/doc-src/IsarAdvanced/Codegen/Thy/Codegen.thy Wed Jan 09 08:04:40 2008 +0100 +++ b/doc-src/IsarAdvanced/Codegen/Thy/Codegen.thy Wed Jan 09 08:32:09 2008 +0100 @@ -111,7 +111,7 @@ We define @{text find} and @{text update} functions: *} -fun +primrec find :: "('a\linorder, 'b) searchtree \ 'a \ 'b option" where "find (Leaf key val) it = (if it = key then Some val else None)" | "find (Branch t1 key t2) it = (if it \ key then find t1 it else find t2 it)" @@ -215,7 +215,7 @@ most cases code generation proceeds without further ado: *} -fun +primrec fac :: "nat \ nat" where "fac 0 = 1" | "fac (Suc n) = Suc n * fac n" @@ -262,6 +262,7 @@ pick_some :: "'a list \ 'a" where "pick_some = hd" (*>*) + export_code pick_some in SML file "examples/fail_const.ML" text {* \noindent will fail. *} @@ -282,18 +283,16 @@ The typical @{text HOL} tools are already set up in a way that function definitions introduced by @{text "\"}, - @{text "\"}, - @{text "\"}, @{text "\"}, + @{text "\"}, @{text "\"}, + @{text "\"}, @{text "\"}, @{text "\"} are implicitly propagated to this defining equation table. Specific theorems may be selected using an attribute: \emph{code func}. As example, a weight selector function: *} -consts - pick :: "(nat \ 'a) list \ nat \ 'a" - primrec + pick :: "(nat \ 'a) list \ nat \ 'a" where "pick (x#xs) n = (let (k, v) = x in if n < k then v else pick xs (n - k))" @@ -365,9 +364,8 @@ class null = type + fixes null :: 'a -fun - head :: "'a\null list \ 'a" -where +primrec + head :: "'a\null list \ 'a" where "head [] = null" | "head (x#xs) = x" @@ -586,7 +584,7 @@ by the code generator: *} -fun +primrec collect_duplicates :: "'a list \ 'a list \ 'a list \ 'a list" where "collect_duplicates xs ys [] = xs" | "collect_duplicates xs ys (z#zs) = (if z \ set xs @@ -636,15 +634,20 @@ hide (open) const "op =" setup {* Sign.parent_path *} (*>*) -instance * :: (ord, ord) ord - less_prod_def: - "p1 < p2 \ let (x1 \ 'a\ord, y1 \ 'b\ord) = p1; (x2, y2) = p2 in - x1 < x2 \ (x1 = x2 \ y1 < y2)" - less_eq_prod_def: - "p1 \ p2 \ let (x1 \ 'a\ord, y1 \ 'b\ord) = p1; (x2, y2) = p2 in - x1 < x2 \ (x1 = x2 \ y1 \ y2)" .. +instantiation * :: (ord, ord) ord +begin + +definition + [code func del]: "p1 < p2 \ (let (x1, y1) = p1; (x2, y2) = p2 in + x1 < x2 \ (x1 = x2 \ y1 < y2))" -lemmas [code func del] = less_prod_def less_eq_prod_def +definition + [code func del]: "p1 \ p2 \ (let (x1, y1) = p1; (x2, y2) = p2 in + x1 < x2 \ (x1 = x2 \ y1 \ y2))" + +instance .. + +end lemma ord_prod [code func(*<*), code func del(*>*)]: "(x1 \ 'a\ord, y1 \ 'b\ord) < (x2, y2) \ x1 < x2 \ (x1 = x2 \ y1 < y2)" @@ -809,7 +812,7 @@ SML code: *} -fun +primrec in_interval :: "nat \ nat \ nat \ bool" where "in_interval (k, l) n \ k \ n \ n \ l" (*<*)