ref: 22dc68832db4d88b0f27442c74bcfba6b5dab81f
parent: 33ca3517205eed58a0305ee2829023c216bdb3de
author: Lennart Augustsson <lennart@augustsson.net>
date: Sat Nov 4 18:12:07 EDT 2023
Allow hex literals
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v4.1
-1414
-((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Alternative.empty"))) ((A :7 (K (noDefault "Alternative.<|>"))) ((A :8 ((S (((S' S') ((B _14) _1)) (((C' _210) ((B _12) _1)) _393))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _392))) ((A :10 (((S' P) _2) (((C' _13) _1) _1161))) ((A :11 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :12 (T (BK (BK (BK K))))) ((A :13 (T (K (BK (BK K))))) ((A :14 (T (K (K (BK K))))) ((A :15 (T (K (K (K K))))) ((A :16 (T (K (K (K A))))) ((A :17 (K (noDefault "Applicative.pure"))) ((A :18 (K (noDefault "Applicative.<*>"))) ((A :19 (((S' B) _14) (((C' _207) _12) _198))) ((A :20 (((S' B) _14) (((C' _210) _12) _199))) ((A :21 _1246) ((A :22 ((B _1287) _21)) ((A :23 (((S' _1287) _21) I)) ((A :24 _1216) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1245) ((C _197) _26))) ((A :28 (((C' _27) ((_206 _1257) _109)) ((_197 (_34 _1259)) _108))) ((A :29 ((B ((S _1287) (_34 _1259))) _24)) ((A :30 ((B (B (B C))) ((B (B C)) P))) ((A :31 (T (BK (BK K)))) ((A :32 (T (K (BK K)))) ((A :33 (T (K (K K)))) ((A :34 (T (K (K A)))) ((A :35 (K (noDefault "Monad.>>="))) ((A :36 (((C' (C' B)) _32) K)) ((A :37 ((B _13) _31)) ((A :38 (((S' (C' B)) _32) (((S' (C' B)) _32) (B' _34)))) ((A :39 P) ((A :40 (T K)) ((A :41 (T A)) ((A :42 (K _24)) ((A :43 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _392)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _393)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1161)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1161))) ((A :46 ((C _43) _198)) ((A :47 ((B _200) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _200) _48)) ((A :50 T) ((A :51 ((_205 ((B (B (_195 _50))) ((B ((C' C) _54)) (B P)))) (_209 _51))) ((A :52 (((((_11 _51) ((B (_195 _50)) P)) (_38 _53)) ((B (B (_195 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_195 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_197 _465)) _54)) ((A :56 ((B (_195 _50)) (B (P _1161)))) ((A :57 ((B (_195 _50)) (BK (P _1161)))) ((A :58 ((_195 _50) ((S P) I))) ((A :59 ((B (_195 _50)) ((C (S' P)) I))) ((A :60 ((_135 ((C ((C S') _65)) I)) (_139 _60))) ((A :61 (((_1385 (K ((P (_1394 "False")) (_1394 "True")))) (_1390 _61)) (_1391 _61))) ((A :62 ((_69 _67) _68)) ((A :63 (R _68)) ((A :64 (T _67)) ((A :65 ((P _68) _67)) ((A :66 _68) ((A :67 K) ((A :68 A) ((A :69 P) ((A :70 (T K)) ((A :71 (T A)) ((A :72 (K (noDefault "Bounded.minBound"))) ((A :73 (K (noDefault "Bounded.maxBound"))) ((A :74 ((_135 _1210) _1211)) ((A :75 ((((((((_425 _74) (_434 _75)) _1212) _1213) _1214) _1215) (_439 _75)) (_440 _75))) ((A :76 ((_135 _1220) (_139 _76))) ((A :77 ((((((((_425 _76) _1219) (((C' (C' (_136 _441))) _1219) _445)) (((C' (C' (_137 _441))) _1219) _447)) (((C' (C' (_136 _441))) _1219) _447)) (((C' (C' (_137 _441))) _1219) _447)) (_439 _77)) (_440 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1221) ((A :80 _1222) ((A :81 (((S' _64) (_1213 #97)) ((C _1213) #122))) ((A :82 (((S' _64) (_1213 #65)) ((C _1213) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1213 #48)) ((C _1213) #57))) ((A :85 (((S' _63) _83) _84)) ((A :86 (((S' _64) (_1213 #32)) ((C _1213) #126))) ((A :87 (((S' _63) ((C (_136 _74)) #32)) (((S' _63) ((C (_136 _74)) #9)) ((C (_136 _74)) #10)))) ((A :88 ((S ((S (((S' _64) (_1213 #65)) ((C _1213) #90))) (_68 (((noMatch "lib/Data/Char.hs") #72) #9)))) ((B _79) (((C' (_410 _211)) (((C' (_411 _211)) _80) (_80 #65))) (_80 #97))))) ((A :89 ((S ((S (((S' _64) (_1213 #97)) ((C _1213) #97))) (_68 (((noMatch "lib/Data/Char.hs") #76) #9)))) ((B _79) (((C' (_410 _211)) (((C' (_411 _211)) _80) (_80 #97))) (_80 #65))))) ((A :90 (((_1385 (K ((C ((S ((C ==) #39)) ((B (_197 (_1393 #39))) (((C' _197) ((B _1394) _91)) (_1393 #39))))) (_1394 "'\92&''")))) (_1390 _90)) ((B (_197 (_1393 #34))) (Y ((B (P (_1393 #34))) (((S' C) ((
\ No newline at end of file
+1418
+((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Alternative.empty"))) ((A :7 (K (noDefault "Alternative.<|>"))) ((A :8 ((S (((S' S') ((B _14) _1)) (((C' _212) ((B _12) _1)) _395))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _394))) ((A :10 (((S' P) _2) (((C' _13) _1) _1165))) ((A :11 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :12 (T (BK (BK (BK K))))) ((A :13 (T (K (BK (BK K))))) ((A :14 (T (K (K (BK K))))) ((A :15 (T (K (K (K K))))) ((A :16 (T (K (K (K A))))) ((A :17 (K (noDefault "Applicative.pure"))) ((A :18 (K (noDefault "Applicative.<*>"))) ((A :19 (((S' B) _14) (((C' _209) _12) _200))) ((A :20 (((S' B) _14) (((C' _212) _12) _201))) ((A :21 _1250) ((A :22 ((B _1291) _21)) ((A :23 (((S' _1291) _21) I)) ((A :24 _1220) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1249) ((C _199) _26))) ((A :28 (((C' _27) ((_208 _1261) _111)) ((_199 (_34 _1263)) _110))) ((A :29 ((B ((S _1291) (_34 _1263))) _24)) ((A :30 ((B (B (B C))) ((B (B C)) P))) ((A :31 (T (BK (BK K)))) ((A :32 (T (K (BK K)))) ((A :33 (T (K (K K)))) ((A :34 (T (K (K A)))) ((A :35 (K (noDefault "Monad.>>="))) ((A :36 (((C' (C' B)) _32) K)) ((A :37 ((B _13) _31)) ((A :38 (((S' (C' B)) _32) (((S' (C' B)) _32) (B' _34)))) ((A :39 P) ((A :40 (T K)) ((A :41 (T A)) ((A :42 (K _24)) ((A :43 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _394)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _395)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _1165)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _1165))) ((A :46 ((C _43) _200)) ((A :47 ((B _202) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _202) _48)) ((A :50 T) ((A :51 ((_207 ((B (B (_197 _50))) ((B ((C' C) _54)) (B P)))) (_211 _51))) ((A :52 (((((_11 _51) ((B (_197 _50)) P)) (_38 _53)) ((B (B (_197 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_197 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_199 _467)) _54)) ((A :56 ((B (_197 _50)) (B (P _1165)))) ((A :57 ((B (_197 _50)) (BK (P _1165)))) ((A :58 ((_197 _50) ((S P) I))) ((A :59 ((B (_197 _50)) ((C (S' P)) I))) ((A :60 ((_137 ((C ((C S') _65)) I)) (_141 _60))) ((A :61 (((_1389 (K ((P (_1398 "False")) (_1398 "True")))) (_1394 _61)) (_1395 _61))) ((A :62 ((_69 _67) _68)) ((A :63 (R _68)) ((A :64 (T _67)) ((A :65 ((P _68) _67)) ((A :66 _68) ((A :67 K) ((A :68 A) ((A :69 P) ((A :70 (T K)) ((A :71 (T A)) ((A :72 (K (noDefault "Bounded.minBound"))) ((A :73 (K (noDefault "Bounded.maxBound"))) ((A :74 ((_137 _1214) _1215)) ((A :75 ((((((((_427 _74) (_436 _75)) _1216) _1217) _1218) _1219) (_441 _75)) (_442 _75))) ((A :76 ((_137 _1224) (_141 _76))) ((A :77 ((((((((_427 _76) _1223) (((C' (C' (_138 _443))) _1223) _447)) (((C' (C' (_139 _443))) _1223) _449)) (((C' (C' (_138 _443))) _1223) _449)) (((C' (C' (_139 _443))) _1223) _449)) (_441 _77)) (_442 _77))) ((A :78 ((_69 (_79 #0)) (_79 #127))) ((A :79 _1225) ((A :80 _1226) ((A :81 (((S' _64) (_1217 #97)) ((C _1217) #122))) ((A :82 (((S' _64) (_1217 #65)) ((C _1217) #90))) ((A :83 (((S' _63) _81) _82)) ((A :84 (((S' _64) (_1217 #48)) ((C _1217) #57))) ((A :85 (((S' _63) _84) (((S' _63) (((S' _64) (_1217 #97)) ((C _1217) #102))) (((S' _64) (_1217 #70)) ((C _1217) #70))))) ((A :86 (((S' _63) _83) _84)) ((A :87 (((S' _64) (_1217 #32)) ((C _1217) #126))) ((A :88 (((S' _63) ((C (_138 _74)) #32)) (((S' _63) ((C (_138 _74)) #9)) ((C (_138 _74)) #10)))) ((A :89 ((S ((S (((S' _64) (_1217 #48)) ((C _1217) #57))) ((S ((S (((S' _64) (_1217 #97)) ((C _1217) #102))) ((S ((C (((S' _64) (_1217 #65)) ((C _1217) #70))) (_24 "digitToInt"))) (((C' (_413 _213)) _80) (((_413 _213) (_80 #65)) #10))))) (((C' (_413 _213)) _80) (((_413 _213) (_80 #97)) #10))))) (((C' (_413 _213)) _80) (_80 #48)))) ((A :90 ((S ((S (((S' _64) (_1217 #65)) ((C _1217) #90))) (_68 (((noMatch "lib/Data/Char.hs") #82) #9)))) ((B _79) ((
\ No newline at end of file
--- a/lib/Data/Char.hs
+++ b/lib/Data/Char.hs
@@ -5,6 +5,7 @@
module Data.Char_Type -- exports Char and String
) where
import Primitives
+import Control.Error
import Data.Bool
import Data.Bounded
import Data.Char_Type
@@ -59,6 +60,9 @@
isDigit :: Char -> Bool
isDigit c = (primCharLE '0' c) && (primCharLE c '9')
+isHexDigit :: Char -> Bool
+isHexDigit c = isDigit c || (primCharLE 'a' c && primCharLE c 'f') || (primCharLE 'F' c && primCharLE c 'F')
+
isAlphaNum :: Char -> Bool
isAlphaNum c = isAlpha c || isDigit c
@@ -67,6 +71,12 @@
isSpace :: Char -> Bool
isSpace c = c == ' ' || c == '\t' || c == '\n'
+
+digitToInt :: Char -> Int
+digitToInt c | (primCharLE '0' c) && (primCharLE c '9') = ord c - ord '0'
+ | (primCharLE 'a' c) && (primCharLE c 'f') = ord c - (ord 'a' - 10)
+ | (primCharLE 'A' c) && (primCharLE c 'F') = ord c - (ord 'A' - 10)
+ | otherwise = error "digitToInt"
toLower :: Char -> Char
toLower c | primCharLE 'A' c && primCharLE c 'Z' = chr (ord c - ord 'A' + ord 'a')
--- a/src/MicroHs/Lex.hs
+++ b/src/MicroHs/Lex.hs
@@ -87,6 +87,7 @@
case span isIdentChar cs of
(ds, rs) -> tIdent loc [] (d:ds) (lex (addCol loc $ 1 + length ds) rs)
lex loc cs@(d:_) | isUpper d = upperIdent loc loc [] cs
+lex loc ('0':x:cs) | toLower x == 'x' = hexNumber loc cs lex loc ('-':cs@(d:_)) | isDigit d = number loc "-" cslex loc cs@(d:_) | isDigit d = number loc "" cs
lex loc (d:cs) | isOperChar d =
@@ -104,7 +105,12 @@
lex loc (d:_) = [TError loc $ "Unrecognized input: " ++ xshowChar d]
lex _ [] = []
-number :: Loc -> String -> String -> [Token] -- neg=1 means negative, neg=0 means positive
+hexNumber :: Loc -> String -> [Token]
+hexNumber loc cs =
+ case span isHexDigit cs of
+ (ds, rs) -> TInt loc (readHex ds) : lex (addCol loc $ length ds + 2) rs
+
+number :: Loc -> String -> String -> [Token] -- neg="-" means negative, neg=0 means positive
number loc sign cs =
case span isDigit cs of
(ds, rs) | null rs || not (head rs == '.') || (take 2 rs) == ".." ->
@@ -221,3 +227,6 @@
layout ms (t : ts) = t : layout ms ts
layout (_ : ms) [] = TSpec (mkLoc 0 0) '}' : layout ms []
layout [] [] = []
+
+readHex :: String -> Integer
+readHex = foldl (\ r c -> r * 16 + toInteger (digitToInt c)) 0
--
⑨