Common.icl 2.23 KB
Newer Older
1
implementation module Clean.PrettyPrint.Common
Camil Staps's avatar
Camil Staps committed
2 3 4 5 6

import StdEnv

import syntax

7 8 9
import Clean.PrettyPrint.Util
import Clean.PrettyPrint.Definition

Camil Staps's avatar
Camil Staps committed
10 11 12 13 14 15 16
instance print Ident
where
	print _ {id_name} = lookup id_name namemap
	where
		lookup k []         = k
		lookup k [(k`,v):m] = if (k == k`) v (lookup k m)

17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
namemap =:
	[ ("_Nil",      "[]")
	, ("_nil",      "[|]")
	, ("_|Nil",     "[|]")
	, ("_#Nil",     "[#]")
	, ("_Nothing",  "?^None")
	, ("_#Nothing", "?#None")
	, ("_!Nothing", "?None")
	, ("_|Nothing", "?|None")
	, ("_Just",     "?^Just")
	, ("_#Just",    "?#Just")
	, ("_!Just",    "?Just")
	, ("_|Just",    "?|Just")
	, ("_Unit",     "()")
	]
Camil Staps's avatar
Camil Staps committed
32 33 34 35 36 37

instance print Import
where
	print st ip=:{import_symbols=ImportSymbolsOnly ids,import_qualified=NotQualified}
		= print st ("from " :+: ip.import_module :+: " import " :+: join st ", " ids)
	print st ip=:{import_symbols=ImportSymbolsOnly _}
38
		= abort "UNKNOWN: ImportSymbolsOnly with Qualified\n"
Camil Staps's avatar
Camil Staps committed
39 40 41 42 43 44 45 46 47
	print st ip=:{import_symbols=ImportSymbolsAll}
		= print st ("import " :+: q :+: ip.import_module :+: as_)
	where
		q = case ip.import_qualified of
			NotQualified = ""
			_            = "qualified "
		as_	= case ip.import_qualified of
			(QualifiedAs name) = " as " :+: name
			_                  = PrintNil
48 49
	print st ip=:{import_symbols=ImportSymbolsAllSomeQualified _}
		= abort "UNKNOWN: ImportSymbolsAllSomeQualified\n"
Camil Staps's avatar
Camil Staps committed
50 51 52 53 54 55

instance print ImportDeclaration
where
	print st (ID_Function f)
		= print st f
	print st (ID_Class c mems)
56
		= print st ("class " :+: c :+: ('(',mems,')'))
Camil Staps's avatar
Camil Staps committed
57
	print st (ID_Type t conses)
58
		= print st (":: " :+: t :+: ('(',conses,')'))
Camil Staps's avatar
Camil Staps committed
59
	print st (ID_Record t fields)
60
		= print st (":: " :+: t :+: ('{',fields,'}'))
61 62
	print st (ID_Instance cls _ ts)
		= print st (cls :+: join_start st " " ts)
63 64
	print st (ID_Generic id _)
		= print st ("generic " :+: id)
65 66 67 68 69 70 71 72 73 74 75 76

instance print (Char, ImportBelongings, Char)
where
	print st (_,IB_None,_) = ""
	print st (open,IB_Idents [],close) = {#open,'.','.',close}
	print st (open,IB_Idents is,close) = print st ({#open} :+: join st "," is :+: {#close})
	print st (open,IB_IdentsAndOptIdents is opts,close) =
		print st ({#open} :+: join st ","
			[print st (i :+: if addparens "()" "")
				\\ i <- is++opts
				 & addparens <- repeatn (length is) False++repeat True]
		:+: {#close})