Skip to content
Browse files

Prepare license to throw in hashcons library, demonstrate some bugs, …

…kick the pants of of Jakob's interpreter (never really a fair contest when up against a compiled language, but whatever)
  • Loading branch information...
1 parent ec0248e commit a3ba201638ca43967d7f63c598102b648a806ca5 @robsimmons committed May 10, 2011
View
3 LICENSE
@@ -1,5 +1,6 @@
Copyright (C) 2011 by Robert J. Simmons
-SML Heap library Copyright (C) 2011 by Tom Murphy VII
+SML Heap library also Copyright (C) 2011 by Tom Murphy VII
+SML HashCons library also Copyright (C) 2001 Bell Labes, Lucent Technologies
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
View
23 examples/bulp/cyk-buggy.l10
@@ -0,0 +1,23 @@
+// Adapted directly from Jakob's CKY Bulp example
+// https://bitbucket.org/robsimmons/bulp/src/tip/examples/cyk.sml
+
+w: world.
+
+term: string -> t -> rel @ w. // T
+nonterm: t -> t -> t -> rel @ w. // NT
+parse: t -> nat -> nat -> rel @ w. // PROD
+tok: nat -> string -> rel @ w. // IN
+
+// Generic rules of parsing
+
+term S T, tok I S -> parse T I I.
+nonterm X Y Z, parse Y I J, parse Z (J+1) K -> parse X I K.
+
+// Rules of parens grammar parsing
+
+// term "(" lParen. // lParen → "("
+// term ")" rParen. // rParen → ")"
+// nonterm s lParen rParen. // s → lParen rParen
+// nonterm s lParen sPrime. // s → lParen s'
+// nonterm s s s. // s → s s
+// nonterm sPrime s rParen. // s' → s rParen
View
23 examples/bulp/cyk.l10
@@ -0,0 +1,23 @@
+// Adapted directly from Jakob's CKY Bulp example
+// https://bitbucket.org/robsimmons/bulp/src/tip/examples/cyk.sml
+
+w: world.
+
+term: string -> t -> rel @ w. // T
+nonterm: t -> t -> t -> rel @ w. // NT
+parse: t -> nat -> nat -> rel @ w. // PROD
+tok: nat -> string -> rel @ w. // IN
+
+// Generic rules of parsing
+
+term S T, tok I S -> parse T I (I+1).
+nonterm X Y Z, parse Y I J, parse Z J K -> parse X I K.
+
+// Rules of parens grammar parsing
+
+// term "(" lParen. // lParen → "("
+// term ")" rParen. // rParen → ")"
+// nonterm s lParen rParen. // s → lParen rParen
+// nonterm s lParen sPrime. // s → lParen s'
+// nonterm s s s. // s → s s
+// nonterm sPrime s rParen. // s' → s rParen
View
76 examples/bulp/cyk.sml
@@ -0,0 +1,76 @@
+CM.make "/tmp/cyk.sources.cm";
+
+val lParen = Symbol.symbol "lParen"
+val rParen = Symbol.symbol "rParen"
+val s = Symbol.symbol "s"
+val s' = Symbol.symbol "s'"
+
+val () =
+ let in
+ CykTables.assertTerm ("(", lParen)
+ ; CykTables.assertTerm (")", rParen)
+ ; CykTables.assertNonterm (s, lParen, rParen)
+ ; CykTables.assertNonterm (s, lParen, s')
+ ; CykTables.assertNonterm (s, s, s)
+ ; CykTables.assertNonterm (s', s, rParen)
+ end
+
+fun make_input n =
+ let
+ val R = Random.rand (67, n)
+ val max = ref 0
+ fun make_input' remaining opened =
+ ((
+ if opened > (!max)
+ then max := opened
+ else ()
+ );
+ if remaining = 0
+ then ""
+ else if opened >= remaining
+ then ")" ^ (make_input' (remaining - 1) (opened - 1))
+ else
+ let
+ val r = Random.randInt R
+ in
+ if opened = 0 orelse r > 0
+ then "(" ^ (make_input' (remaining - 1) (opened + 1))
+ else ")" ^ (make_input' (remaining - 1) (opened - 1))
+ end)
+ val n' = if n mod 2 = 1 then n + 1 else n
+ val out = make_input' n' 0
+ (* val _ = TextIO.output(TextIO.stdErr, (Int.toString (!max))) *)
+ in
+ out
+ end
+
+fun mapi' n [] = []
+ | mapi' n (x :: xs) = (n, x) :: mapi' (n+1) xs
+
+fun mapi xs = mapi' 0 xs
+
+fun assert_input n =
+ let
+ val strs = mapi (map str (explode (make_input n)))
+ in
+ app (fn (i, tok) => CykTables.assertTok (IntInf.fromInt i, tok)) strs
+ end
+
+fun legal n =
+ let val ninf = IntInf.fromInt n
+ in not (null (CykTables.parse_0_lookup (!CykTables.parse_0, (s, 0, ninf))))
+ end
+
+(* Actually run the program *)
+
+(* val SIZE = 200 *)
+
+val () = assert_input SIZE
+
+val _ = CykSearch.saturateW CykTerms.MapWorld.empty
+
+val () =
+ if legal SIZE
+ then print "Legal string\n"
+ else print "Not legal string\n"
+
View
9 examples/bulp/test_cky.sh
@@ -0,0 +1,9 @@
+../../bin/elton --directory=/tmp --prefix=cyk cyk.l10
+
+for i in 10 20 50 100 200 500 1000 2000 3000 4000 5000 6000 7000 8000 9000 10000
+do
+ echo "== $i ============"
+ echo "val SIZE = $i;" > tmp
+ time cat tmp cyk.sml | sml > /dev/null
+done
+rm tmp
View
2 sml/compile-sml/tables.sml
@@ -146,7 +146,7 @@ fun emitAssertion a =
fun nameOfShape (a, shape) =
let
val shapes = mapi (rev (map #terms (IndexTab.lookup a)))
- fun find (shape, []) = raise Fail "Invariant"
+ fun find (shape, []) = raise Fail "Invariant in nameOfShape"
| find (shape, (i, shape') :: shapes) =
if shape = shape'
then (Symbol.name a ^ "_" ^ Int.toString i)
View
6 sml/compile-sml/types.sml
@@ -55,9 +55,11 @@ fun nameOfTypeExt x =
(if encoded x then (getPrefix true "" ^ "Terms.") else "") ^ nameOfType x
fun NameOfType x =
- if encoded x then embiggen (Symbol.name x) else raise Fail "Invariant"
+ if encoded x then embiggen (Symbol.name x)
+ else raise Fail ("Invariant in NameOfType (" ^ Symbol.name x ^ ")")
fun nameOfView x =
- if encoded x then Symbol.name x ^ "_view" else raise Fail "Invariant"
+ if encoded x then Symbol.name x ^ "_view"
+ else raise Fail ("Invariant in nameOfView (" ^ Symbol.name x ^ ")")
fun nameOfPrj x =
View
4 sml/frontend/elton-mlton.sml
@@ -1,6 +1,6 @@
val () =
let in
Elton.go (CommandLine.name (), CommandLine.arguments ())
- ; OS.Process.Exit OS.Process.success
- end handle Die status => OS.Process.Exit status
+ ; OS.Process.exit OS.Process.success
+ end handle Elton.Die status => OS.Process.exit status
View
2 sml/syntax/l10.lex
@@ -19,7 +19,7 @@ fun to_string yytext =
lcid = [a-z][A-Za-z0-9_\']*;
ucid = [A-Z][A-Za-z0-9_\']*;
-string = \"[A-Za-z0-9_ \'!@#$%^&*]*\";
+string = \"[A-Za-z0-9_ \'!@#$%^&*()]*\";
decnum = (0|[1-9][0-9]*);
ws = [\ \t\011\012\r];
eol = ("\013\010"|"\010"|"\013");

0 comments on commit a3ba201

Please sign in to comment.
Something went wrong with that request. Please try again.