builtin_syntax.icl 4.41 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
module builtin_syntax

import StdEnv
import StdMaybe

import Clean.Types
import Clean.Types.Parse
from Data.Func import mapSt, seqSt
import System.CommandLine
import System.Directory
import System.File
import System.FilePath
import System.Process
import Text

from Cloogle.API import :: SyntaxExample{..}
import Cloogle.DB
import Builtin.Syntax

DOT_SUCCESS :== "\033[0;32m.\033[0m"
DOT_FAILURE :== "\033[0;31mF\033[0m"
DOT_SKIPPED :== "\033[0;33ms\033[0m"

MSG_SUCCESS :== "\033[0;32m OK\033[0m"
MSG_FAILURE :== "\033[0;31m failed!\033[0m"

DIRECTORY :== "examples"

CLMFLAGS =:
	[ "-c"
	, "-dynamics"
	, "-IL", "Dynamics"
	, "-IL", "Platform"
	]

Start w
# (_,w) = ensureDirectoryExists DIRECTORY w
# (_,failed,w) = seqSt test builtin_syntax (0,0,w)
= case failed of
	0
		# (_,w) = recursiveDelete DIRECTORY w
		-> w
	_
		# (_,w) = fclose
			(stderr
				<<< "Some tests failed. If test numbers are given, you can check the errors with:\n"
				<<< "\tcd " <<< DIRECTORY <<< "\n"
				<<< "\tclm " <<< join " " CLMFLAGS <<< " _example<number>\n")
			w
		-> setReturnCode -1 w

test :: !SyntaxEntry !*(!Int, !Int, !*World) -> *(!Int, !Int, !*World)
test se (i,failed,w)
# err = stderr <<< "Checking syntax for '" <<< se.syntax_title <<< "': "
# (_,w) = fclose err w
# (results,(j,w)) = mapSt test_example se.syntax_examples (i,w)
# err = stderr
	<<< if (and results)
		MSG_SUCCESS
		(MSG_FAILURE +++ " (" +++ join ", " [toString (n+i) \\ n <- [0..] & False <- results] +++ ")")
	<<< "\n"
# (_,w) = fclose err w

= (j,failed + length [f \\ f=:False <- results],w)

test_example :: !SyntaxExample !*(!Int, !*World) -> *(!Bool, !*(!Int, !*World))
test_example {example,cleanjs_start,bootstrap,requires_itask_compiler} (i,w)
| requires_itask_compiler
		|| indexOf "not allowed" (toLowerCase example) >= 0 // examples that are marked as not allowed by the compiler
		|| startsWith "definition module " example // module headings
		|| startsWith "implementation module " example
		|| startsWith "system module " example
		|| startsWith "module " example
	# (_,w) = fclose (stderr <<< DOT_SKIPPED) w
	= (True, (i+1,w))
# dcl = join "\n"
	[ "definition module _example" <+ i
	: [b \\ b <- bootstrap | startsWith "import " b]
	++ case split "special" example of
		[_]
			| indexOf "(:==" example > 0
				-> [example] // abstract synonym type
				-> [l \\ l <- split "\n" example
						| startsWith "derive " l && indexOf " with " l > 0
							|| startsWith "generic " l]
		[_:_]
			-> [example]
	]
# icl = join "\n"
	[ "implementation module _example" <+ i
	: bootstrap
	++ case cleanjs_start of
		Nothing         -> complete_icl example
		Just "macro"    -> complete_icl example
		Just "rhs"      -> ["Start = " +++ example]
		Just "macrorhs" -> ["Start = " +++ example]
		Just s          -> ["unknown cleanjs_start " +++ s]
	]

# (_,w) = writeFile (DIRECTORY </> "_example" <+ i <+ ".dcl") dcl w
# (_,w) = writeFile (DIRECTORY </> "_example" <+ i <+ ".icl") icl w

# (Ok (h,_),w) = runProcessIO "clm" (CLMFLAGS ++ ["_example" <+ i]) (Just DIRECTORY) w
# (Ok r,w) = waitForProcess h w
# ok = r == 0

# (_,w) = fclose (stderr <<< if ok DOT_SUCCESS DOT_FAILURE) w
= (ok,(i+1,w))
where
	complete_icl :: !String -> [String]
	complete_icl example
	| startsWith "foreign export " example =
		[ name +++ " :: Int"
		, name +++ " = 0"
		] with name = example % (15, indexOfAfter 15 " " example)
	| indexOf "(:==" example > 0 = // abstract synonym type
		[replaceSubString "(:==" ":==" (example % (0,size example-2))]
	# example = hd (split "special" example)
	| example.[0] == '(' && indexOf ") =" example > 0 = // pattern
		[ "tempfun = " +++ (example % (0,indexOf ") =" example + 1))
		, "where"
		, "\t" +++ replaceSubString "\n" "\n\t" example
		]
	# lines = split "\n" example
	| length lines == 1
		# line = hd lines
		# line = case indexOf "//" line of
			-1 -> line
			i  -> trim (line % (0, i-1))
		# doublecolon = indexOf "::" line
		| doublecolon > 0
132
				&& not (startsWith "generic " line || startsWith "class " line || startsWith "from " line)
133 134 135 136 137 138 139 140 141 142 143 144 145 146
			// function without implementation
			= case parseType [c \\ c <-: line & i <- [0..] | i > doublecolon+2] of
				Just (Func is _ _) ->
					[ line
					, line % (0,indexOf " " line) +++ join " " ["_" \\ _ <- is] +++ " = undef"
					, "from StdMisc import undef"
					]
				_ ->
					[ line
					, line % (0,indexOf " " line) +++ " = undef"
					, "from StdMisc import undef"
					]
		= lines
	= [l \\ l <- lines | not (startsWith "derive " l && indexOf " with " l > 0)]