1 files changed, 134 insertions, 0 deletions
diff --git a/src/Transfer/Syntax/Lex.x b/src/Transfer/Syntax/Lex.x
new file mode 100644
index 000000000..107b67345
--- /dev/null
+++ b/src/Transfer/Syntax/Lex.x
@@ -0,0 +1,134 @@
+-- -*- haskell -*-
+-- This Alex file was machine-generated by the BNF converter
+{
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+module Transfer.Syntax.Lex where
+
+
+}
+
+
+$l = [a-zA-Z\192 - \255] # [\215 \247]    -- isolatin1 letter FIXME
+$c = [A-Z\192-\221] # [\215]    -- capital isolatin1 letter FIXME
+$s = [a-z\222-\255] # [\247]    -- small isolatin1 letter FIXME
+$d = [0-9]                -- digit
+$i = [$l $d _ ']          -- identifier character
+$u = [\0-\255]          -- universal: any character
+
+@rsyms =    -- symbols and non-identifier-like reserved words
+   \; | \: | \{ | \} | \= | \| | \| \| | \: \: | \( | \) | \[ | \] | \, | \_ | \- \> | \\ | \< \- | \> \> \= | \> \> | \& \& | \= \= | \/ \= | \< | \< \= | \> | \> \= | \+ | \- | \* | \/ | \% | \. | \?
+
+:-
+"--" [.]* ; -- Toss single line comments
+"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ; 
+
+$white+ ;
+@rsyms { tok (\p s -> PT p (TS $ share s)) }
+
+$l $i*   { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
+\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \"{ tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }
+
+$d+      { tok (\p s -> PT p (TI $ share s))    }
+$d+ \. $d+ (e (\-)? $d+)? { tok (\p s -> PT p (TD $ share s)) }
+
+{
+
+tok f p s = f p s
+
+share :: String -> String
+share = id
+
+data Tok =
+   TS !String     -- reserved words and symbols
+ | TL !String     -- string literals
+ | TI !String     -- integer literals
+ | TV !String     -- identifiers
+ | TD !String     -- double precision float literals
+ | TC !String     -- character literals
+
+ deriving (Eq,Show,Ord)
+
+data Token = 
+   PT  Posn Tok
+ | Err Posn
+  deriving (Eq,Show,Ord)
+
+tokenPos (PT (Pn _ l _) _ :_) = "line " ++ show l
+tokenPos (Err (Pn _ l _) :_) = "line " ++ show l
+tokenPos _ = "end of file"
+
+posLineCol (Pn _ l c) = (l,c)
+mkPosToken t@(PT p _) = (posLineCol p, prToken t)
+
+prToken t = case t of
+  PT _ (TS s) -> s
+  PT _ (TI s) -> s
+  PT _ (TV s) -> s
+  PT _ (TD s) -> s
+  PT _ (TC s) -> s
+
+  _ -> show t
+
+data BTree = N | B String Tok BTree BTree deriving (Show)
+
+eitherResIdent :: (String -> Tok) -> String -> Tok
+eitherResIdent tv s = treeFind resWords
+  where
+  treeFind N = tv s
+  treeFind (B a t left right) | s < a  = treeFind left
+                              | s > a  = treeFind right
+                              | s == a = t
+
+resWords = b "import" (b "derive" (b "case" (b "Type" N N) (b "data" N N)) (b "else" (b "do" N N) (b "if" N N))) (b "rec" (b "let" (b "in" N N) (b "of" N N)) (b "then" (b "sig" N N) (b "where" N N)))
+   where b s = B s (TS s)
+
+unescapeInitTail :: String -> String
+unescapeInitTail = unesc . tail where
+  unesc s = case s of
+    '\\':c:cs | elem c ['\"', '\\', '\''] -> c : unesc cs
+    '\\':'n':cs  -> '\n' : unesc cs
+    '\\':'t':cs  -> '\t' : unesc cs
+    '"':[]    -> []
+    c:cs      -> c : unesc cs
+    _         -> []
+
+-------------------------------------------------------------------
+-- Alex wrapper code.
+-- A modified "posn" wrapper.
+-------------------------------------------------------------------
+
+data Posn = Pn !Int !Int !Int
+      deriving (Eq, Show,Ord)
+
+alexStartPos :: Posn
+alexStartPos = Pn 0 1 1
+
+alexMove :: Posn -> Char -> Posn
+alexMove (Pn a l c) '\t' = Pn (a+1)  l     (((c+7) `div` 8)*8+1)
+alexMove (Pn a l c) '\n' = Pn (a+1) (l+1)   1
+alexMove (Pn a l c) _    = Pn (a+1)  l     (c+1)
+
+type AlexInput = (Posn, -- current position,
+		  Char,	-- previous char
+		  String)	-- current input string
+
+tokens :: String -> [Token]
+tokens str = go (alexStartPos, '\n', str)
+    where
+      go :: (Posn, Char, String) -> [Token]
+      go inp@(pos, _, str) =
+    	  case alexScan inp 0 of
+    	    AlexEOF                -> []
+    	    AlexError (pos, _, _)  -> fail $ show pos ++ ": lexical error"
+    	    AlexSkip  inp' len     -> go inp'
+    	    AlexToken inp' len act -> act pos (take len str) : (go inp')
+
+alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
+alexGetChar (p, c, [])    = Nothing
+alexGetChar (p, _, (c:s)) =
+    let p' = alexMove p c
+     in p' `seq` Just (c, (p', c, s))
+
+alexInputPrevChar :: AlexInput -> Char
+alexInputPrevChar (p, c, s) = c
+}