Commit 9b3230c2 authored by Camil Staps's avatar Camil Staps 🍃

Add toString/fromString for ABCArguments; avoid run-time errors

parent 2dacc462
...@@ -233,6 +233,9 @@ from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode ...@@ -233,6 +233,9 @@ from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
| ABCTypeReal | ABCTypeReal
| ABCTypeString | ABCTypeString
instance toString ABCArgument, ABCArgumentType
instance fromString ABCArgument, ABCArgumentType
/** /**
* Cloogle result about a common problem (see https://gitlab.science.ru.nl/cloogle/common-problems). * Cloogle result about a common problem (see https://gitlab.science.ru.nl/cloogle/common-problems).
*/ */
......
...@@ -5,6 +5,7 @@ import StdBool ...@@ -5,6 +5,7 @@ import StdBool
import StdChar import StdChar
from StdFunc import flip from StdFunc import flip
import StdInt import StdInt
import StdMisc
import StdOverloaded import StdOverloaded
import StdReal import StdReal
import StdString import StdString
...@@ -30,37 +31,9 @@ derive JSONDecode Request, Response, Result, ShortClassResult, BasicResult, ...@@ -30,37 +31,9 @@ derive JSONDecode Request, Response, Result, ShortClassResult, BasicResult,
ABCInstructionResultExtras, CleanLangReportLocation, StrUnifier ABCInstructionResultExtras, CleanLangReportLocation, StrUnifier
derive gEq FunctionKind derive gEq FunctionKind
JSONEncode{|ABCArgument|} _ (ABCArgument t r) = [JSONString (if r ("[" <+ type <+ "]") type)] JSONEncode{|ABCArgument|} _ arg = [JSONString (toString arg)]
where
type = case t of
ABCTypeLabel -> "label"
ABCTypeAStackOffset -> "A-offset"
ABCTypeBStackOffset -> "B-offset"
ABCTypeAStackSize -> "A-size"
ABCTypeBStackSize -> "B-size"
ABCTypeBool -> "bool"
ABCTypeChar -> "char"
ABCTypeInt -> "int"
ABCTypeReal -> "real"
ABCTypeString -> "string"
JSONDecode{|ABCArgument|} _ [JSONString s:r] JSONDecode{|ABCArgument|} _ [JSONString s:r] = (Just (fromString s), r)
| 0 < size s && s.[0] == '[' && s.[size s-1] == ']'
= (flip ABCArgument True <$> fromString (s % (1,size s-2)), r)
= (flip ABCArgument False <$> fromString s, r)
where
fromString s = case s of
"label" -> Just ABCTypeLabel
"A-offset" -> Just ABCTypeAStackOffset
"B-offset" -> Just ABCTypeBStackOffset
"A-size" -> Just ABCTypeAStackSize
"B-size" -> Just ABCTypeBStackSize
"bool" -> Just ABCTypeBool
"char" -> Just ABCTypeChar
"int" -> Just ABCTypeInt
"real" -> Just ABCTypeReal
"string" -> Just ABCTypeString
_ -> Nothing
JSONDecode{|ABCArgument|} _ json = (Nothing, json) JSONDecode{|ABCArgument|} _ json = (Nothing, json)
instance toInt CloogleError instance toInt CloogleError
...@@ -91,6 +64,48 @@ where ...@@ -91,6 +64,48 @@ where
fromInt 155 = QueryTooLong fromInt 155 = QueryTooLong
fromInt i = OtherCloogleError ("Unknown CloogleError " + toString i) fromInt i = OtherCloogleError ("Unknown CloogleError " + toString i)
instance toString ABCArgument
where
toString (ABCArgument type required)
| required = "[" <+ type <+ "]"
| otherwise = toString type
instance fromString ABCArgument
where
fromString s
| 0 < size s && s.[0] == '[' && s.[size s-1] == ']'
= ABCArgument (fromString (s % (1,size s-2))) True
= ABCArgument (fromString s) True
instance toString ABCArgumentType
where
toString t = case t of
ABCTypeLabel -> "label"
ABCTypeAStackOffset -> "A-offset"
ABCTypeBStackOffset -> "B-offset"
ABCTypeAStackSize -> "A-size"
ABCTypeBStackSize -> "B-size"
ABCTypeBool -> "bool"
ABCTypeChar -> "char"
ABCTypeInt -> "int"
ABCTypeReal -> "real"
ABCTypeString -> "string"
instance fromString ABCArgumentType
where
fromString s = case s of
"label" -> ABCTypeLabel
"A-offset" -> ABCTypeAStackOffset
"B-offset" -> ABCTypeBStackOffset
"A-size" -> ABCTypeAStackSize
"B-size" -> ABCTypeBStackSize
"bool" -> ABCTypeBool
"char" -> ABCTypeChar
"int" -> ABCTypeInt
"real" -> ABCTypeReal
"string" -> ABCTypeString
_ -> abort "failure in fromString of ABCArgumentType\n"
instance zero Request instance zero Request
where where
zero = zero =
...@@ -138,6 +153,9 @@ where ...@@ -138,6 +153,9 @@ where
basic (TypeResult (br,_)) = br basic (TypeResult (br,_)) = br
basic (ClassResult (br,_)) = br basic (ClassResult (br,_)) = br
basic (ModuleResult (br,_)) = br basic (ModuleResult (br,_)) = br
basic (SyntaxResult (br,_)) = br
basic (ABCInstructionResult (br,_)) = br
basic (ProblemResult _) = abort "no BasicResult for ProblemResult\n"
instance == FunctionKind where == a b = a === b instance == FunctionKind where == a b = a === b
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment